Fix problems when dragging frames with the mouse
Re-implement 'mouse-drag-frame' via two new functions - 'mouse-drag-frame-resize' and 'mouse-drag-frame-move'. This is needed because with some toolkits the notifications for frame movement and resizing arrive asynchronously, breaking any calculations using intermediate frame sizes and positions. * lisp/mouse.el (mouse-drag-mode-line, mouse-drag-left-edge) (mouse-drag-top-left-corner, mouse-drag-top-edge) (mouse-drag-top-right-corner, mouse-drag-right-edge) (mouse-drag-bottom-right-corner, mouse-drag-bottom-edge) (mouse-drag-bottom-left-corner): Call 'mouse-drag-frame-resize' instead of 'mouse-drag-frame'. (mouse-drag-frame): Split into two new functions - 'mouse-drag-frame-move' and 'mouse-drag-frame-resize'. (mouse-drag-frame-resize, mouse-drag-frame-move): New functions to implement functionality of the removed 'mouse-drag-frame'.
This commit is contained in:
Martin Rudalics
parent
24c3fa9607
commit
981cea9b62
1 changed files with 291 additions and 233 deletions
524
lisp/mouse.el
524
lisp/mouse.el
|
|
@ -552,7 +552,7 @@ frame instead."
|
|||
(not (eq (window-frame minibuffer-window) frame))))
|
||||
;; Drag frame when the window is on the bottom of its frame and
|
||||
;; there is no minibuffer window below.
|
||||
(mouse-drag-frame start-event 'move)))))
|
||||
(mouse-drag-frame-move start-event)))))
|
||||
|
||||
(defun mouse-drag-header-line (start-event)
|
||||
"Change the height of a window by dragging on its header line.
|
||||
|
|
@ -569,7 +569,7 @@ the frame instead."
|
|||
(mouse-drag-line start-event 'header)
|
||||
(let ((frame (window-frame window)))
|
||||
(when (frame-parameter frame 'drag-with-header-line)
|
||||
(mouse-drag-frame start-event 'move))))))
|
||||
(mouse-drag-frame-move start-event))))))
|
||||
|
||||
(defun mouse-drag-vertical-line (start-event)
|
||||
"Change the width of a window by dragging on a vertical line.
|
||||
|
|
@ -577,46 +577,7 @@ START-EVENT is the starting mouse event of the drag action."
|
|||
(interactive "e")
|
||||
(mouse-drag-line start-event 'vertical))
|
||||
|
||||
(defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
|
||||
"Helper function for `mouse-drag-frame'."
|
||||
(let* ((frame-x-y (frame-position frame))
|
||||
(frame-x (car frame-x-y))
|
||||
(frame-y (cdr frame-x-y))
|
||||
alist)
|
||||
(if (> x-diff 0)
|
||||
(when x-move
|
||||
(setq x-diff (min x-diff frame-x))
|
||||
(setq x-move (- frame-x x-diff)))
|
||||
(let* ((min-width (frame-windows-min-size frame t nil t))
|
||||
(min-diff (max 0 (- (frame-inner-width frame) min-width))))
|
||||
(setq x-diff (max x-diff (- min-diff)))
|
||||
(when x-move
|
||||
(setq x-move (+ frame-x (- x-diff))))))
|
||||
|
||||
(if (> y-diff 0)
|
||||
(when y-move
|
||||
(setq y-diff (min y-diff frame-y))
|
||||
(setq y-move (- frame-y y-diff)))
|
||||
(let* ((min-height (frame-windows-min-size frame nil nil t))
|
||||
(min-diff (max 0 (- (frame-inner-height frame) min-height))))
|
||||
(setq y-diff (max y-diff (- min-diff)))
|
||||
(when y-move
|
||||
(setq y-move (+ frame-y (- y-diff))))))
|
||||
|
||||
(unless (zerop x-diff)
|
||||
(when x-move
|
||||
(push `(left . ,x-move) alist))
|
||||
(push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
|
||||
alist))
|
||||
(unless (zerop y-diff)
|
||||
(when y-move
|
||||
(push `(top . ,y-move) alist))
|
||||
(push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
|
||||
alist))
|
||||
(when alist
|
||||
(modify-frame-parameters frame alist))))
|
||||
|
||||
(defun mouse-drag-frame (start-event part)
|
||||
(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.
|
||||
|
|
@ -635,9 +596,144 @@ frame with the mouse."
|
|||
(frame (if (window-live-p window)
|
||||
(window-frame window)
|
||||
window))
|
||||
(width (frame-native-width frame))
|
||||
(height (frame-native-height frame))
|
||||
;; PARENT is the parent frame of FRAME or, if FRAME is a
|
||||
;; 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 [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))))))
|
||||
|
||||
(defun mouse-drag-frame-move (start-event)
|
||||
"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))
|
||||
(native-width (frame-native-width frame))
|
||||
(native-height (frame-native-height frame))
|
||||
;; 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))
|
||||
;; PARENT is the parent frame of FRAME or, if FRAME is a
|
||||
;; top-level frame, FRAME's workarea.
|
||||
(parent (frame-parent frame))
|
||||
(parent-edges
|
||||
|
|
@ -654,19 +750,16 @@ frame with the mouse."
|
|||
(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)))
|
||||
;; `pos-x' and `pos-y' record the x- and y-coordinates of the
|
||||
;; last sampled mouse position. Note that we sample absolute
|
||||
;; mouse positions to avoid that moving the mouse from one
|
||||
;; frame into another gets into our way. `last-x' and `last-y'
|
||||
;; records the x- and y-coordinates of the previously sampled
|
||||
;; position. The differences between `last-x' and `pos-x' as
|
||||
;; well as `last-y' and `pos-y' determine the amount the mouse
|
||||
;; has been dragged between the last two samples.
|
||||
pos-x-y pos-x pos-y
|
||||
(last-x-y (mouse-absolute-pixel-position))
|
||||
(last-x (car last-x-y))
|
||||
(last-y (cdr last-x-y))
|
||||
;; `snap-x' and `snap-y' record the x- and y-coordinates of the
|
||||
;; 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))
|
||||
;; `snap-width' (maybe also a yet to be provided `snap-height')
|
||||
;; could become floats to handle proportionality wrt PARENT.
|
||||
;; We don't do any checks on this parameter so far.
|
||||
(snap-width (frame-parameter frame 'snap-width))
|
||||
;; `snap-x' and `snap-y' record the x- and y-coordinates of the
|
||||
;; mouse position when FRAME snapped. As soon as the
|
||||
;; difference between `pos-x' and `snap-x' (or `pos-y' and
|
||||
;; `snap-y') exceeds the value of FRAME's `snap-width'
|
||||
|
|
@ -678,176 +771,141 @@ frame with the mouse."
|
|||
(lambda (event)
|
||||
(interactive "e")
|
||||
(when (consp event)
|
||||
(setq pos-x-y (mouse-absolute-pixel-position))
|
||||
(setq pos-x (car pos-x-y))
|
||||
(setq pos-y (cdr pos-x-y))
|
||||
(cond
|
||||
((eq part 'left)
|
||||
(mouse-resize-frame frame (- last-x pos-x) 0 t))
|
||||
((eq part 'top)
|
||||
(mouse-resize-frame frame 0 (- last-y pos-y) nil t))
|
||||
((eq part 'right)
|
||||
(mouse-resize-frame frame (- pos-x last-x) 0))
|
||||
((eq part 'bottom)
|
||||
(mouse-resize-frame frame 0 (- pos-y last-y)))
|
||||
((eq part 'top-left)
|
||||
(mouse-resize-frame
|
||||
frame (- last-x pos-x) (- last-y pos-y) t t))
|
||||
((eq part 'top-right)
|
||||
(mouse-resize-frame
|
||||
frame (- pos-x last-x) (- last-y pos-y) nil t))
|
||||
((eq part 'bottom-left)
|
||||
(mouse-resize-frame
|
||||
frame (- last-x pos-x) (- pos-y last-y) t))
|
||||
((eq part 'bottom-right)
|
||||
(mouse-resize-frame
|
||||
frame (- pos-x last-x) (- pos-y last-y)))
|
||||
((eq part 'move)
|
||||
(let* ((old-position (frame-position frame))
|
||||
(old-left (car old-position))
|
||||
(old-top (cdr old-position))
|
||||
(left (+ old-left (- pos-x last-x)))
|
||||
(top (+ old-top (- pos-y last-y)))
|
||||
right bottom
|
||||
;; `snap-width' (maybe also a yet to be provided
|
||||
;; `snap-height') could become floats to handle
|
||||
;; proportionality wrt PARENT. We don't do any
|
||||
;; checks on this parameter so far.
|
||||
(snap-width (frame-parameter frame 'snap-width)))
|
||||
;; Docking and constraining.
|
||||
(when (and (numberp snap-width) parent-edges)
|
||||
(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))
|
||||
right bottom)
|
||||
(setq left (+ first-left left))
|
||||
(setq top (+ first-top top))
|
||||
;; Docking and constraining.
|
||||
(when (and (numberp snap-width) parent-edges)
|
||||
(cond
|
||||
;; Docking at the left parent edge.
|
||||
((< last-x first-x)
|
||||
(cond
|
||||
;; Docking at the left parent edge.
|
||||
((< pos-x last-x)
|
||||
(cond
|
||||
((and (> left parent-left)
|
||||
(<= (- left parent-left) snap-width))
|
||||
;; Snap when the mouse moved leftward and
|
||||
;; FRAME's left edge would end up within
|
||||
;; `snap-width' pixels from PARENT's left edge.
|
||||
(setq snap-x pos-x)
|
||||
(setq left parent-left))
|
||||
((and (<= left parent-left)
|
||||
(<= (- parent-left left) snap-width)
|
||||
snap-x (<= (- snap-x pos-x) snap-width))
|
||||
;; Stay snapped when the mouse moved leftward
|
||||
;; but not more than `snap-width' pixels from
|
||||
;; the time FRAME snapped.
|
||||
(setq left parent-left))
|
||||
(t
|
||||
;; Unsnap when the mouse moved more than
|
||||
;; `snap-width' pixels leftward from the time
|
||||
;; FRAME snapped.
|
||||
(setq snap-x nil))))
|
||||
((> pos-x last-x)
|
||||
(setq right (+ left width))
|
||||
(cond
|
||||
((and (< right parent-right)
|
||||
(<= (- parent-right right) snap-width))
|
||||
;; Snap when the mouse moved rightward and
|
||||
;; FRAME's right edge would end up within
|
||||
;; `snap-width' pixels from PARENT's right edge.
|
||||
(setq snap-x pos-x)
|
||||
(setq left (- parent-right width)))
|
||||
((and (>= right parent-right)
|
||||
(<= (- right parent-right) snap-width)
|
||||
snap-x (<= (- pos-x snap-x) snap-width))
|
||||
;; Stay snapped when the mouse moved rightward
|
||||
;; but not more more than `snap-width' pixels
|
||||
;; from the time FRAME snapped.
|
||||
(setq left (- parent-right width)))
|
||||
(t
|
||||
;; Unsnap when the mouse moved rightward more
|
||||
;; than `snap-width' pixels from the time FRAME
|
||||
;; snapped.
|
||||
(setq snap-x nil)))))
|
||||
|
||||
((and (> left parent-left)
|
||||
(<= (- left parent-left) snap-width))
|
||||
;; Snap when the mouse moved leftward and FRAME's
|
||||
;; left edge would end up within `snap-width'
|
||||
;; pixels from PARENT's left edge.
|
||||
(setq snap-x last-x)
|
||||
(setq left parent-left))
|
||||
((and (<= left parent-left)
|
||||
(<= (- parent-left left) snap-width)
|
||||
snap-x (<= (- snap-x last-x) snap-width))
|
||||
;; Stay snapped when the mouse moved leftward but
|
||||
;; not more than `snap-width' pixels from the time
|
||||
;; FRAME snapped.
|
||||
(setq left parent-left))
|
||||
(t
|
||||
;; Unsnap when the mouse moved more than
|
||||
;; `snap-width' pixels leftward from the time
|
||||
;; FRAME snapped.
|
||||
(setq snap-x nil))))
|
||||
((> last-x first-x)
|
||||
(setq right (+ left native-width))
|
||||
(cond
|
||||
((< pos-y last-y)
|
||||
(cond
|
||||
((and (> top parent-top)
|
||||
(<= (- top parent-top) snap-width))
|
||||
;; Snap when the mouse moved upward and FRAME's
|
||||
;; top edge would end up within `snap-width'
|
||||
;; pixels from PARENT's top edge.
|
||||
(setq snap-y pos-y)
|
||||
(setq top parent-top))
|
||||
((and (<= top parent-top)
|
||||
(<= (- parent-top top) snap-width)
|
||||
snap-y (<= (- snap-y pos-y) snap-width))
|
||||
;; Stay snapped when the mouse moved upward but
|
||||
;; not more more than `snap-width' pixels from
|
||||
;; the time FRAME snapped.
|
||||
(setq top parent-top))
|
||||
(t
|
||||
;; Unsnap when the mouse moved upward more than
|
||||
;; `snap-width' pixels from the time FRAME
|
||||
;; snapped.
|
||||
(setq snap-y nil))))
|
||||
((> pos-y last-y)
|
||||
(setq bottom (+ top height))
|
||||
(cond
|
||||
((and (< bottom parent-bottom)
|
||||
(<= (- parent-bottom bottom) snap-width))
|
||||
;; Snap when the mouse moved downward and
|
||||
;; FRAME's bottom edge would end up within
|
||||
;; `snap-width' pixels from PARENT's bottom
|
||||
;; edge.
|
||||
(setq snap-y pos-y)
|
||||
(setq top (- parent-bottom height)))
|
||||
((and (>= bottom parent-bottom)
|
||||
(<= (- bottom parent-bottom) snap-width)
|
||||
snap-y (<= (- pos-y snap-y) snap-width))
|
||||
;; Stay snapped when the mouse moved downward
|
||||
;; but not more more than `snap-width' pixels
|
||||
;; from the time FRAME snapped.
|
||||
(setq top (- parent-bottom height)))
|
||||
(t
|
||||
;; Unsnap when the mouse moved downward more
|
||||
;; than `snap-width' pixels from the time FRAME
|
||||
;; snapped.
|
||||
(setq snap-y nil))))))
|
||||
((and (< right parent-right)
|
||||
(<= (- parent-right right) snap-width))
|
||||
;; Snap when the mouse moved rightward and FRAME's
|
||||
;; right edge would end up within `snap-width'
|
||||
;; pixels from PARENT's right edge.
|
||||
(setq snap-x last-x)
|
||||
(setq left (- parent-right native-width)))
|
||||
((and (>= right parent-right)
|
||||
(<= (- right parent-right) snap-width)
|
||||
snap-x (<= (- last-x snap-x) snap-width))
|
||||
;; Stay snapped when the mouse moved rightward but
|
||||
;; not more more than `snap-width' pixels from the
|
||||
;; time FRAME snapped.
|
||||
(setq left (- parent-right native-width)))
|
||||
(t
|
||||
;; Unsnap when the mouse moved rightward more than
|
||||
;; `snap-width' pixels from the time FRAME
|
||||
;; snapped.
|
||||
(setq snap-x nil)))))
|
||||
(cond
|
||||
((< last-y first-y)
|
||||
(cond
|
||||
((and (> top parent-top)
|
||||
(<= (- top parent-top) snap-width))
|
||||
;; Snap when the mouse moved upward and FRAME's
|
||||
;; top edge would end up within `snap-width'
|
||||
;; pixels from PARENT's top edge.
|
||||
(setq snap-y last-y)
|
||||
(setq top parent-top))
|
||||
((and (<= top parent-top)
|
||||
(<= (- parent-top top) snap-width)
|
||||
snap-y (<= (- snap-y last-y) snap-width))
|
||||
;; Stay snapped when the mouse moved upward but
|
||||
;; not more more than `snap-width' pixels from the
|
||||
;; time FRAME snapped.
|
||||
(setq top parent-top))
|
||||
(t
|
||||
;; Unsnap when the mouse moved upward more than
|
||||
;; `snap-width' pixels from the time FRAME
|
||||
;; snapped.
|
||||
(setq snap-y nil))))
|
||||
((> last-y first-y)
|
||||
(setq bottom (+ top native-height))
|
||||
(cond
|
||||
((and (< bottom parent-bottom)
|
||||
(<= (- parent-bottom bottom) snap-width))
|
||||
;; Snap when the mouse moved downward and FRAME's
|
||||
;; bottom edge would end up within `snap-width'
|
||||
;; pixels from PARENT's bottom edge.
|
||||
(setq snap-y last-y)
|
||||
(setq top (- parent-bottom native-height)))
|
||||
((and (>= bottom parent-bottom)
|
||||
(<= (- bottom parent-bottom) snap-width)
|
||||
snap-y (<= (- last-y snap-y) snap-width))
|
||||
;; Stay snapped when the mouse moved downward but
|
||||
;; not more more than `snap-width' pixels from the
|
||||
;; time FRAME snapped.
|
||||
(setq top (- parent-bottom native-height)))
|
||||
(t
|
||||
;; Unsnap when the mouse moved downward more than
|
||||
;; `snap-width' pixels from the time FRAME
|
||||
;; snapped.
|
||||
(setq snap-y nil))))))
|
||||
|
||||
;; If requested, constrain FRAME's draggable areas to
|
||||
;; PARENT's edges. The `top-visible' parameter should
|
||||
;; be set when FRAME has a draggable header-line. If
|
||||
;; set to a number, it ascertains that the top of
|
||||
;; FRAME is always constrained to the top of PARENT
|
||||
;; and that at least as many pixels of FRAME as
|
||||
;; specified by that number are visible on each of the
|
||||
;; three remaining sides of PARENT.
|
||||
;;
|
||||
;; The `bottom-visible' parameter should be set when
|
||||
;; FRAME has a draggable mode-line. If set to a
|
||||
;; number, it ascertains that the bottom of FRAME is
|
||||
;; always constrained to the bottom of PARENT and that
|
||||
;; at least as many pixels of FRAME as specified by
|
||||
;; that number are visible on each of the three
|
||||
;; remaining sides of PARENT.
|
||||
(let ((par (frame-parameter frame 'top-visible))
|
||||
bottom-visible)
|
||||
(unless par
|
||||
(setq par (frame-parameter frame 'bottom-visible))
|
||||
(setq bottom-visible t))
|
||||
(when (and (numberp par) parent-edges)
|
||||
(setq left
|
||||
(max (min (- parent-right par) left)
|
||||
(+ (- parent-left width) par)))
|
||||
(setq top
|
||||
(if bottom-visible
|
||||
(min (max top (- parent-top (- height par)))
|
||||
(- parent-bottom height))
|
||||
(min (max top parent-top)
|
||||
(- parent-bottom par))))))
|
||||
|
||||
;; Use `modify-frame-parameters' since `left' and
|
||||
;; `top' may want to move FRAME out of its PARENT.
|
||||
(modify-frame-parameters
|
||||
frame
|
||||
`((left . (+ ,left)) (top . (+ ,top)))))))
|
||||
(setq last-x pos-x)
|
||||
(setq last-y pos-y))))
|
||||
(old-track-mouse track-mouse))
|
||||
;; If requested, constrain FRAME's draggable areas to
|
||||
;; PARENT's edges. The `top-visible' parameter should
|
||||
;; be set when FRAME has a draggable header-line. If
|
||||
;; set to a number, it ascertains that the top of FRAME
|
||||
;; is always constrained to the top of PARENT and that
|
||||
;; at least as many pixels of FRAME as specified by that
|
||||
;; number are visible on each of the three remaining
|
||||
;; sides of PARENT.
|
||||
;;
|
||||
;; The `bottom-visible' parameter should be set when
|
||||
;; FRAME has a draggable mode-line. If set to a number,
|
||||
;; it ascertains that the bottom of FRAME is always
|
||||
;; constrained to the bottom of PARENT and that at least
|
||||
;; as many pixels of FRAME as specified by that number
|
||||
;; are visible on each of the three remaining sides of
|
||||
;; PARENT.
|
||||
(let ((par (frame-parameter frame 'top-visible))
|
||||
bottom-visible)
|
||||
(unless par
|
||||
(setq par (frame-parameter frame 'bottom-visible))
|
||||
(setq bottom-visible t))
|
||||
(when (and (numberp par) parent-edges)
|
||||
(setq left
|
||||
(max (min (- parent-right par) left)
|
||||
(+ (- parent-left native-width) par)))
|
||||
(setq top
|
||||
(if bottom-visible
|
||||
(min (max top (- parent-top (- native-height par)))
|
||||
(- parent-bottom native-height))
|
||||
(min (max top parent-top)
|
||||
(- parent-bottom par))))))
|
||||
;; Use `modify-frame-parameters' since `left' and `top'
|
||||
;; may want to move FRAME out of its PARENT.
|
||||
(modify-frame-parameters frame `((left . (+ ,left)) (top . (+ ,top))))))))
|
||||
(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.
|
||||
|
|
@ -879,49 +937,49 @@ frame with the mouse."
|
|||
"Drag left edge of a frame with the mouse.
|
||||
START-EVENT is the starting mouse event of the drag action."
|
||||
(interactive "e")
|
||||
(mouse-drag-frame start-event 'left))
|
||||
(mouse-drag-frame-resize start-event 'left))
|
||||
|
||||
(defun mouse-drag-top-left-corner (start-event)
|
||||
"Drag top left corner of a frame with the mouse.
|
||||
START-EVENT is the starting mouse event of the drag action."
|
||||
(interactive "e")
|
||||
(mouse-drag-frame start-event 'top-left))
|
||||
(mouse-drag-frame-resize start-event 'top-left))
|
||||
|
||||
(defun mouse-drag-top-edge (start-event)
|
||||
"Drag top edge of a frame with the mouse.
|
||||
START-EVENT is the starting mouse event of the drag action."
|
||||
(interactive "e")
|
||||
(mouse-drag-frame start-event 'top))
|
||||
(mouse-drag-frame-resize start-event 'top))
|
||||
|
||||
(defun mouse-drag-top-right-corner (start-event)
|
||||
"Drag top right corner of a frame with the mouse.
|
||||
START-EVENT is the starting mouse event of the drag action."
|
||||
(interactive "e")
|
||||
(mouse-drag-frame start-event 'top-right))
|
||||
(mouse-drag-frame-resize start-event 'top-right))
|
||||
|
||||
(defun mouse-drag-right-edge (start-event)
|
||||
"Drag right edge of a frame with the mouse.
|
||||
START-EVENT is the starting mouse event of the drag action."
|
||||
(interactive "e")
|
||||
(mouse-drag-frame start-event 'right))
|
||||
(mouse-drag-frame-resize start-event 'right))
|
||||
|
||||
(defun mouse-drag-bottom-right-corner (start-event)
|
||||
"Drag bottom right corner of a frame with the mouse.
|
||||
START-EVENT is the starting mouse event of the drag action."
|
||||
(interactive "e")
|
||||
(mouse-drag-frame start-event 'bottom-right))
|
||||
(mouse-drag-frame-resize start-event 'bottom-right))
|
||||
|
||||
(defun mouse-drag-bottom-edge (start-event)
|
||||
"Drag bottom edge of a frame with the mouse.
|
||||
START-EVENT is the starting mouse event of the drag action."
|
||||
(interactive "e")
|
||||
(mouse-drag-frame start-event 'bottom))
|
||||
(mouse-drag-frame-resize start-event 'bottom))
|
||||
|
||||
(defun mouse-drag-bottom-left-corner (start-event)
|
||||
"Drag bottom left corner of a frame with the mouse.
|
||||
START-EVENT is the starting mouse event of the drag action."
|
||||
(interactive "e")
|
||||
(mouse-drag-frame start-event 'bottom-left))
|
||||
(mouse-drag-frame-resize start-event 'bottom-left))
|
||||
|
||||
(defcustom mouse-select-region-move-to-beginning nil
|
||||
"Effect of selecting a region extending backward from double click.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue