Function: mouse-drag-region-rectangle

mouse-drag-region-rectangle is an interactive and byte-compiled function defined in mouse.el.gz.

Signature

(mouse-drag-region-rectangle START-EVENT)

Documentation

Set the region to the rectangle that the mouse is dragged over.

This must be bound to a button-down mouse event.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/mouse.el.gz
(defun mouse-drag-region-rectangle (start-event)
  "Set the region to the rectangle that the mouse is dragged over.
This must be bound to a button-down mouse event."
  (interactive "e")
  (let* ((scroll-margin 0)
         (start-pos (event-start start-event))
         (start-posn (event-start start-event))
         (start-point (posn-point start-posn))
         (start-window (posn-window start-posn))
         (start-hscroll (window-hscroll start-window))
         (start-col (+ (car (posn-col-row start-pos)) start-hscroll))
         (bounds (window-edges start-window))
         (top (nth 1 bounds))
         (bottom (if (window-minibuffer-p start-window)
                     (nth 3 bounds)
                   (1- (nth 3 bounds))))
         (extra-margin (round (line-number-display-width 'columns)))
         (dragged nil)
         (old-track-mouse track-mouse)
         (old-mouse-fine-grained-tracking mouse-fine-grained-tracking)
         ;; For right-to-left text, columns are counted from the right margin;
         ;; translate from mouse events, which always count from the left.
         (adjusted-col (lambda (col)
                         (if (eq (current-bidi-paragraph-direction)
                                 'right-to-left)
                             (- (window-width) col extra-margin
                                (if mouse--rectangle-track-cursor 1 -1))
                           (- col extra-margin))))
         (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")
        (unless dragged
          ;; This is actually a drag.
          (setq dragged t)
          (mouse-minibuffer-check start-event)
          (deactivate-mark)
          (setq-local transient-mark-mode
                      (if (eq transient-mark-mode 'lambda)
                          '(only)
                        (cons 'only transient-mark-mode)))
          (posn-set-point start-pos)
          (rectangle-mark-mode)
          ;; Only tell rectangle about the exact column if we are possibly
          ;; beyond end-of-line or in a tab, since the column we got from
          ;; the mouse position isn't necessarily accurate for use in
          ;; specifying a rectangle (which uses the `move-to-column'
          ;; measure).
          (when (or (eolp) (eq (following-char) ?\t))
            (let ((col (funcall adjusted-col start-col)))
              (rectangle--col-pos col 'mark)
              (rectangle--col-pos col 'point))))

        (let* ((posn (event-end event))
               (window (posn-window posn))
               (hscroll (if (window-live-p window)
                            (window-hscroll window)
                          0))
               (mouse-row (cddr (mouse-position)))
               (mouse-col (+ (car (posn-col-row posn)) hscroll
                             (if mouse--rectangle-track-cursor 0 1)))
               (set-col (lambda ()
                          (if (or (eolp) (eq (following-char) ?\t))
                              (rectangle--col-pos
                               (funcall adjusted-col mouse-col) 'point)
                            (unless mouse--rectangle-track-cursor
                              (forward-char))
                            (rectangle--reset-point-crutches))))
               (scroll-adjust (lambda ()
                                (move-to-column
                                 (funcall adjusted-col mouse-col))
                                (funcall set-col))))
          (if (and (eq window start-window)
                   mouse-row
                   (<= top mouse-row (1- bottom)))
              ;; Drag inside the same window.
              (progn
                (posn-set-point posn)
                (funcall set-col))
            ;; Drag outside the window: scroll.
            (cond
             ((null mouse-row))
             ((< mouse-row top)
              (mouse-scroll-subr
               start-window (- mouse-row top) nil start-point
               scroll-adjust))
             ((>= mouse-row bottom)
              (mouse-scroll-subr
               start-window (1+ (- mouse-row bottom)) nil start-point
               scroll-adjust)))))))
    (condition-case err
        (progn
          (setq track-mouse t)
          (setq mouse-fine-grained-tracking t)
          (set-transient-map
           map t
           (lambda ()
             (setq track-mouse old-track-mouse)
             (setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking)
             (when (or (not dragged)
                       (not (mark))
                       (equal (rectangle-dimensions (mark) (point)) '(0 . 1)))
               ;; No nontrivial region selected; deactivate rectangle mode.
               (deactivate-mark)))))
      ;; Clean up in case something went wrong.
      (error (setq track-mouse old-track-mouse)
             (setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking)
             (signal (car err) (cdr err))))))