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 line, header line, 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, or vertical.

Source Code

;; Defined in /usr/src/emacs/lisp/mouse.el.gz
(defun mouse-drag-line (start-event line)
  "Drag a mode line, header line, 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', or `vertical'."
  ;; Give temporary modes such as isearch a chance to turn off.
  (run-hooks 'mouse-leave-buffer-hook)
  (let* ((echo-keystrokes 0)
	 (start (event-start start-event))
	 (window (posn-window start))
	 (frame (window-frame window))
	 ;; `position' records the x- or y-coordinate of the last
	 ;; sampled position.
	 (position (if (eq line 'vertical)
		       (+ (window-pixel-left window)
			  (car (posn-x-y start)))
		     (+ (window-pixel-top window)
			(cdr (posn-x-y start)))))
	 ;; `last-position' records 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)
	 posn-window growth dragged)
    ;; Decide on whether we are allowed to track at all and whose
    ;; window's edge we drag.
    (cond
     ((eq line 'header)
      ;; Drag bottom edge of window above the header line.
      (setq window (window-in-direction 'above window t)))
     ((eq line 'mode))
     ((eq line 'vertical)
      (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))))))
    (let* ((exitfun nil)
           (move
	    (lambda (event) (interactive "e")
	      (cond
	       ((not (consp event))
		nil)
	       ((eq line 'vertical)
		;; Drag right edge of `window'.
		(setq start (event-start event))
		(setq position (car (posn-x-y start)))
		;; Set `posn-window' to the window where `event' was recorded.
		;; This can be `window' or the window on the left or right of
		;; `window'.
		(when (window-live-p (setq posn-window (posn-window start)))
		  ;; Add left edge of `posn-window' to `position'.
		  (setq position (+ (window-pixel-left posn-window) position))
		  (unless (posn-area start)
		    ;; Add width of objects on the left of the text area to
		    ;; `position'.
		    (when (eq (window-current-scroll-bars posn-window) 'left)
		      (setq position (+ (window-scroll-bar-width posn-window)
					position)))
		    (setq position (+ (car (window-fringes posn-window))
				      (or (car (window-margins posn-window)) 0)
				      position))))
		;; When the cursor overshoots after shrinking a window to its
		;; minimum size and the dragging direction changes, have the
		;; cursor first catch up with the window edge.
		(unless (or (zerop (setq growth (- position last-position)))
			    (and (> growth 0)
				 (< position (+ (window-pixel-left window)
						(window-pixel-width window))))
			    (and (< growth 0)
				 (> position (+ (window-pixel-left window)
						(window-pixel-width window)))))
		  (setq dragged t)
		  (adjust-window-trailing-edge window growth t t))
		(setq last-position position))
	       (t
		;; Drag bottom edge of `window'.
		(setq start (event-start event))
		;; Set `posn-window' to the window where `event' was recorded.
		;; This can be either `window' or the window above or below of
		;; `window'.
		(setq posn-window (posn-window start))
		(setq position (cdr (posn-x-y start)))
		(when (window-live-p posn-window)
		  ;; Add top edge of `posn-window' to `position'.
		  (setq position (+ (window-pixel-top posn-window) position))
		  ;; If necessary, add height of header line to `position'
		  (when (memq (posn-area start)
			      '(nil left-fringe right-fringe left-margin right-margin))
		    (setq position (+ (window-header-line-height posn-window) position))))
		;; When the cursor overshoots after shrinking a window to its
		;; minimum size and the dragging direction changes, have the
		;; cursor first catch up with the window edge.
		(unless (or (zerop (setq growth (- position last-position)))
			    (and (> growth 0)
				 (< position (+ (window-pixel-top window)
						(window-pixel-height window))))
			    (and (< growth 0)
				 (> position (+ (window-pixel-top window)
						(window-pixel-height window)))))
		  (setq dragged t)
		  (adjust-window-trailing-edge window growth nil t))
		(setq last-position position)))))
           (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)
      ;; Loop reading events and sampling the position of the mouse.
      (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 [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)))))))