Function: mouse-drag-line
mouse-drag-line is a byte-compiled function defined in mouse.el.gz.
Signature
(mouse-drag-line START-EVENT LINE)
Documentation
Drag a mode, header, tab or vertical line with the mouse.
START-EVENT is the starting mouse event of the drag action. LINE
must be one of the symbols header, mode, tab or vertical.
Source Code
;; Defined in /usr/src/emacs/lisp/mouse.el.gz
(defun mouse-drag-line (start-event line)
"Drag a mode, header, tab or vertical line with the mouse.
START-EVENT is the starting mouse event of the drag action. LINE
must be one of the symbols `header', `mode', `tab' or `vertical'."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
;; The earlier version of this was based on using the position of the
;; start event for each sampled mouse movement. That approach had the
;; disadvantage that when, for example, dragging the mode line down,
;; the 'posn-window' of that event was usually the window below the
;; mode line and its coordinates were relative to that window. So we
;; had to add position and height of the window above the mode line in
;; order to get a meaningful value for comparing the old and current
;; mouse position. However, when a user changed the direction during
;; dragging, the mouse moved into the window above the mode line and
;; the relative position changed to one of that window too. Since
;; keeping track of these changes was tricky, we now simply use
;; absolute mouse positions and do not care about the window at the
;; mouse position any more.
(let* ((echo-keystrokes 0)
(start (event-start start-event))
(window (posn-window start))
(frame (window-frame window))
;; tty is needed because `mouse-absolute-pixel-position' does
;; not return a meaningful value on ttys so there we have to
;; use `mouse-position-in-root-frame'.
(tty (tty-type frame))
;; 'charwise' means to drag by character sizes on graphical
;; displays.
(charwise (not (or window-resize-pixelwise tty)))
;; The initial absolute position of the mouse. We
;; intentionally do not use the value of 'posn-x-y' of
;; START-EVENT here because that would give us coordinates for
;; 'posn-window' of that event and we don't want that (see the
;; comment above).
(position-x-y (mouse-position-for-drag-line tty))
;; 'position' records the x- (for vertical dragging) or y- (for
;; mode, header and tab line dragging) coordinate of the
;; current mouse position
(position (if (eq line 'vertical)
(car position-x-y)
(cdr position-x-y)))
;; 'last-position' records the the x- or y-coordinate of the
;; previously sampled position. The difference of 'position'
;; and 'last-position' determines the size change of WINDOW.
(last-position position)
;; The next two bindings are used for characterwise dragging
;; only. 'residue' is the remainder of the difference between
;; 'position' and 'last-position' divided by the frame's
;; character size and will be considered in the next difference
;; calculation.
(residue 0)
;; 'forward' indicates the current dragging direction and is
;; non-nil when dragging to the right or down. Its purpose is
;; to detect changes in the dragging direction in order to keep
;; the mouse cursor nearer to the dragged line.
(forward t)
;; 'char-size' is the frame's character width) for vertical
;; dragging) or character height (for mode, header, tab line
;; dragging).
char-size
;; 'growth' is the position change of the mouse in pixels if
;; 'charwise' is nil, in characters if 'charwise' is non-nil.
growth
;; `dragged' is initially nil and sticks to non-nil after the
;; first time growth has become non-nil. Its purpose is to
;; give characterwise dragging a head start to avoid that the
;; mouse cursor moves to far away from the line to drag.
dragged)
;; Set up the window whose edge to drag.
(cond
((memq line '(header tab))
;; LINE is a header or tab line. Drag the bottom edge of the
;; window above it.
(setq window (window-in-direction 'above window t))
(when charwise
(setq char-size (frame-char-height frame))))
((eq line 'mode)
;; LINE is a mode line or a bottom window divider. Drag the bottom edge
;; of its window.
(when charwise
(setq char-size (frame-char-height frame))))
((eq line 'vertical)
;; LINE is a window divider on the right. Drag the right edge of
;; the window on its left.
(let ((divider-width (frame-right-divider-width frame)))
(when (and (or (not (numberp divider-width))
(zerop divider-width))
(eq (frame-parameter frame 'vertical-scroll-bars) 'left))
(setq window (window-in-direction 'left window t))))
(when charwise
(setq char-size (frame-char-width frame)))))
(let* ((exitfun nil)
(move
(lambda (event) (interactive "e")
(cond
((not (consp event))
nil)
((eq line 'vertical)
;; Drag right edge of 'window'.
(setq position (car (mouse-position-for-drag-line tty)))
(unless (zerop (setq growth (- position last-position)))
;; When we drag characterwise and we either drag for
;; the first time or the dragging direction changes,
;; try to keep in synch cursor and dragged line.
(when (and charwise
(or (not dragged)
(if forward
(< growth 0)
(> growth 0))))
(setq forward (> growth 0))
(setq growth
(if (> growth 0)
(+ growth (/ char-size 2))
(- growth (/ char-size 2)))))
(setq dragged t)
(when charwise
(setq residue (% growth char-size))
(setq growth (/ growth char-size)))
(unless (zerop growth)
(adjust-window-trailing-edge window growth t (not charwise)))
(setq last-position (- position residue))
;; ;; Debugging code.
;; (message "last %s pos %s growth %s residue %s char-size %s"
;; last-position position growth residue char-size)
))
(t
;; Drag bottom edge of 'window'.
(setq position (cdr (mouse-position-for-drag-line tty)))
(unless (zerop (setq growth (- position last-position)))
;; When we drag characterwise and we either drag for
;; the first time or the dragging direction changes,
;; try to keep in synch cursor and dragged line.
(when (and charwise
(or (not dragged)
(if forward
(< growth 0)
(> growth 0))))
(setq forward (> growth 0))
(setq growth
(if (> growth 0)
(+ growth (/ char-size 2))
(- growth (/ char-size 2)))))
(setq dragged t)
(when charwise
(setq residue (% growth char-size))
(setq growth (/ growth char-size)))
(unless (zerop growth)
(adjust-window-trailing-edge window growth nil (not charwise)))
(setq last-position (- position residue))
;; ;; Debugging code.
;; (message "last %s pos %s growth %s residue %s char-size %s"
;; last-position position growth residue char-size)
)))))
(old-track-mouse track-mouse))
;; Start tracking. The special value 'dragging' signals the
;; display engine to freeze the mouse pointer shape for as long
;; as we drag.
(setq track-mouse 'dragging)
(setq exitfun
(set-transient-map
(let ((map (make-sparse-keymap)))
(define-key map [switch-frame] #'ignore)
(define-key map [select-window] #'ignore)
(define-key map [scroll-bar-movement] #'ignore)
(define-key map [mouse-movement] move)
;; Swallow drag-mouse-1 events to avoid selecting some other window.
(define-key map [drag-mouse-1]
(lambda () (interactive) (funcall exitfun)))
;; For vertical line dragging swallow also a mouse-1
;; event (but only if we dragged at least once to allow mouse-1
;; clicks to get through).
(when (eq line 'vertical)
(define-key map [mouse-1]
`(menu-item "" ,(lambda () (interactive) (funcall exitfun))
:filter ,(lambda (cmd) (if dragged cmd)))))
;; Some of the events will of course end up looked up
;; with a mode-line, header-line or vertical-line prefix ...
(define-key map [mode-line] map)
(define-key map [header-line] map)
(define-key map [tab-line] map)
(define-key map [vertical-line] map)
;; ... and some maybe even with a right- or bottom-divider
;; or left- or right-margin prefix ...
(define-key map [right-divider] map)
(define-key map [bottom-divider] map)
(define-key map [left-margin] map)
(define-key map [right-margin] map)
map)
t (lambda () (setq track-mouse old-track-mouse)))))))