Function: mouse-drag-frame-resize
mouse-drag-frame-resize is a byte-compiled function defined in
mouse.el.gz.
Signature
(mouse-drag-frame-resize START-EVENT PART)
Documentation
Drag a frame or one of its edges with the mouse.
START-EVENT is the starting mouse event of the drag action. Its position window denotes the frame that will be dragged.
PART specifies the part that has been dragged and must be one of
the symbols left, top, right, bottom, top-left,
top-right, bottom-left, bottom-right to drag an internal
border or edge. If PART equals move, this means to move the
frame with the mouse.
Source Code
;; Defined in /usr/src/emacs/lisp/mouse.el.gz
(defun mouse-drag-frame-resize (start-event part)
"Drag a frame or one of its edges with the mouse.
START-EVENT is the starting mouse event of the drag action. Its
position window denotes the frame that will be dragged.
PART specifies the part that has been dragged and must be one of
the symbols `left', `top', `right', `bottom', `top-left',
`top-right', `bottom-left', `bottom-right' to drag an internal
border or edge. If PART equals `move', this means to move the
frame with the mouse."
;; 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 is the frame to drag.
(frame (if (window-live-p window)
(window-frame window)
window))
;; Initial "first" frame position and size. While dragging we
;; base all calculations against that size and position.
(first-pos (frame-position frame))
(first-left (car first-pos))
(first-top (cdr first-pos))
(first-width (frame-text-width frame))
(first-height (frame-text-height frame))
;; Don't let FRAME become less large than the size needed to
;; fit all of its windows.
(min-text-width
(+ (frame-windows-min-size frame t nil t)
(- (frame-inner-width frame) first-width)))
(min-text-height
(+ (frame-windows-min-size frame nil nil t)
(- (frame-inner-height frame) first-height)))
;; PARENT is the parent frame of FRAME or, if FRAME is a
;; top-level frame, FRAME's workarea.
(parent (frame-parent frame))
(parent-edges
(if parent
(frame-edges parent)
(let* ((attributes
(car (display-monitor-attributes-list)))
(workarea (assq 'workarea attributes)))
(and workarea
`(,(nth 1 workarea) ,(nth 2 workarea)
,(+ (nth 1 workarea) (nth 3 workarea))
,(+ (nth 2 workarea) (nth 4 workarea)))))))
(parent-left (and parent-edges (nth 0 parent-edges)))
(parent-top (and parent-edges (nth 1 parent-edges)))
(parent-right (and parent-edges (nth 2 parent-edges)))
(parent-bottom (and parent-edges (nth 3 parent-edges)))
;; Drag types. drag-left/drag-right and drag-top/drag-bottom
;; are mutually exclusive.
(drag-left (memq part '(bottom-left left top-left)))
(drag-top (memq part '(top-left top top-right)))
(drag-right (memq part '(top-right right bottom-right)))
(drag-bottom (memq part '(bottom-right bottom bottom-left)))
;; Initial "first" mouse position. While dragging we base all
;; calculations against that position.
(first-x-y (mouse-absolute-pixel-position))
(first-x (car first-x-y))
(first-y (cdr first-x-y))
(exitfun nil)
(move
(lambda (event)
(interactive "e")
(when (consp event)
(let* ((last-x-y (mouse-absolute-pixel-position))
(last-x (car last-x-y))
(last-y (cdr last-x-y))
(left (- last-x first-x))
(top (- last-y first-y))
alist)
;; We never want to warp the mouse position here. When
;; moving the mouse leftward or upward, then with a wide
;; border the calculated left or top position of the
;; frame could drop to a value less than zero depending
;; on where precisely the mouse within the border. We
;; guard against this by never allowing the frame to
;; move to a position less than zero here. No such
;; precautions are used for the right and bottom borders
;; so with a large internal border parts of that border
;; may disappear.
(when (and drag-left (>= last-x parent-left)
(>= (- first-width left) min-text-width))
(push `(left . ,(max (+ first-left left) 0)) alist)
(push `(width . (text-pixels . ,(- first-width left)))
alist))
(when (and drag-top (>= last-y parent-top)
(>= (- first-height top) min-text-height))
(push `(top . ,(max 0 (+ first-top top))) alist)
(push `(height . (text-pixels . ,(- first-height top)))
alist))
(when (and drag-right (<= last-x parent-right)
(>= (+ first-width left) min-text-width))
(push `(width . (text-pixels . ,(+ first-width left)))
alist))
(when (and drag-bottom (<= last-y parent-bottom)
(>= (+ first-height top) min-text-height))
(push `(height . (text-pixels . ,(+ first-height top)))
alist))
(modify-frame-parameters frame alist)))))
(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)))
;; 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
;; prefix.
(define-key map [right-divider] map)
(define-key map [bottom-divider] map)
map)
t (lambda () (setq track-mouse old-track-mouse))))))