diff --git a/lisp/mouse.el b/lisp/mouse.el index e58a2e6da1..9a0e2b28e4 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -552,7 +552,7 @@ mouse-drag-mode-line (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 @@ mouse-drag-header-line (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 @@ mouse-drag-vertical-line (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,168 @@ mouse-drag-frame (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)) + (x-left first-left) + (first-top (cdr first-pos)) + (x-top first-top) + (first-width (frame-text-width frame)) + (x-width first-width) + (first-height (frame-text-height frame)) + (x-height first-height) + ;; 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. + (if (fboundp 'x-set-frame-size-and-position) + (progn + (when (and drag-left (>= last-x parent-left) + (>= (- first-width left) min-text-width)) + (setq x-left (max (+ first-left left) 0)) + (setq x-width (- first-width left))) + (when (and drag-top (>= last-y parent-top) + (>= (- first-height top) min-text-height)) + (setq x-top (max 0 (+ first-top top))) + (setq x-height (- first-height top))) + (when (and drag-right (<= last-x parent-right) + (>= (+ first-width left) min-text-width)) + (setq x-width (+ first-width left))) + (when (and drag-bottom (<= last-y parent-bottom) + (>= (+ first-height top) min-text-height)) + (setq x-height (+ first-height top))) + (x-set-frame-size-and-position + frame x-width x-height x-left x-top)) + (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)) + (first-width (frame-text-width frame)) + (first-height (frame-text-height frame)) + ;; 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 +774,16 @@ mouse-drag-frame (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 +795,144 @@ mouse-drag-frame (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)))))) - - ;; 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)) + ((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 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)))))) + (if (fboundp 'x-set-frame-size-and-position) + (x-set-frame-size-and-position + frame first-width first-height left top) + ;; 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 +964,49 @@ mouse-drag-left-edge "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. diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c index ea9465d553..cc04596837 100644 --- a/src/emacsgtkfixed.c +++ b/src/emacsgtkfixed.c @@ -242,6 +242,21 @@ XSetWMSizeHints (Display *d, XChangeProperty (d, w, prop, XA_WM_SIZE_HINTS, 32, PropModeReplace, (unsigned char *) data, 18); + + if (f && FRAME_PARENT_FRAME (f)) + frame_size_history_add + (f, Quser_size, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + listn (10, + make_fixnum (hints->base_width), + make_fixnum (hints->base_height), + make_fixnum (hints->width_inc), + make_fixnum (hints->height_inc), + make_fixnum (hints->min_width), + make_fixnum (hints->min_height), + make_fixnum (f->output_data.x->size_hints.min_width), + make_fixnum (f->output_data.x->size_hints.min_height), + make_fixnum (hints->max_width), + make_fixnum (hints->max_height))); } /* Override this X11 function. diff --git a/src/frame.c b/src/frame.c index 88d6f22fc0..7cc9399b31 100644 --- a/src/frame.c +++ b/src/frame.c @@ -374,7 +374,7 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size, * additionally limit the minimum frame height to a value large enough * to support the menu bar, the mode line, and the echo area. */ -static int +int frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, Lisp_Object ignore, Lisp_Object pixelwise) { diff --git a/src/frame.h b/src/frame.h index 6ab690c0ff..42acd92418 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1647,6 +1647,7 @@ #define EMACS_CLASS "Emacs" extern void free_frame_menubar (struct frame *); extern bool frame_ancestor_p (struct frame *af, struct frame *df); extern enum internal_border_part frame_internal_border_part (struct frame *f, int x, int y); +extern int frame_windows_min_size (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); #if defined HAVE_X_WINDOWS extern void x_wm_set_icon_position (struct frame *, int, int); diff --git a/src/gtkutil.c b/src/gtkutil.c index 6308c38f16..d85107448d 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1401,8 +1401,7 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) to a race condition. See the thread at https://lists.gnu.org/r/emacs-devel/2008-10/msg00033.html */ if (NILP (Vafter_init_time) - || !FRAME_GTK_OUTER_WIDGET (f) - || FRAME_PARENT_FRAME (f)) + || !FRAME_GTK_OUTER_WIDGET (f)) return; XSETFRAME (frame, f); @@ -1429,7 +1428,7 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) size_hints = f->output_data.x->size_hints; hint_flags = f->output_data.x->hint_flags; - hint_flags |= GDK_HINT_RESIZE_INC | GDK_HINT_MIN_SIZE; + hint_flags |= GDK_HINT_RESIZE_INC | GDK_HINT_MIN_SIZE | GDK_HINT_MAX_SIZE; size_hints.width_inc = frame_resize_pixelwise ? 1 : FRAME_COLUMN_WIDTH (f); size_hints.height_inc = frame_resize_pixelwise ? 1 : FRAME_LINE_HEIGHT (f); @@ -1445,6 +1444,8 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) size_hints.base_height = base_height; size_hints.min_width = base_width; size_hints.min_height = base_height; + size_hints.max_width = 10000; + size_hints.max_height = 10000; /* These currently have a one to one mapping with the X values, but I don't think we should rely on that. */ diff --git a/src/xfns.c b/src/xfns.c index 276ea1c393..5a43797d25 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4203,6 +4203,163 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, return unbind_to (count, frame); } + +static void +x_window_move_resize (struct frame *f, int width, int height, int left, int top) +{ + int old_pixel_width = FRAME_PIXEL_WIDTH (f); + int old_pixel_height = FRAME_PIXEL_HEIGHT (f); + int new_pixel_width, new_pixel_height; + int min_windows_width, min_windows_height; + Lisp_Object frame; + bool inhibit_horizontal, inhibit_vertical; + bool old_frame_resize_pixelwise = frame_resize_pixelwise; +#ifdef USE_GTK + int scale = xg_get_scale (f); +#endif + + XSETFRAME (frame, f); + + frame_size_history_add (f, Qx_move_resize_1, width, height, Qnil); + + min_windows_width = frame_windows_min_size (frame, Qt, Qnil, Qt); + min_windows_height = frame_windows_min_size (frame, Qnil, Qnil, Qt); + + inhibit_horizontal = frame_inhibit_resize (f, true, Qnil); + inhibit_vertical = frame_inhibit_resize (f, false, Qnil); + + new_pixel_width = (inhibit_horizontal + ? old_pixel_width + : max (FRAME_TEXT_TO_PIXEL_WIDTH (f, width), + min_windows_width + + 2 * FRAME_INTERNAL_BORDER_WIDTH (f))); + new_pixel_height = (inhibit_vertical + ? old_pixel_height + : max (FRAME_TEXT_TO_PIXEL_HEIGHT (f, height), + min_windows_height + + FRAME_TOP_MARGIN_HEIGHT (f) + + 2 * FRAME_INTERNAL_BORDER_WIDTH (f))); + + if (FRAME_WINDOW_P (f) && f->can_set_window_size) + { + block_input (); + +#ifdef USE_GTK + GdkWindow *window = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); + + frame_resize_pixelwise = true; + x_wm_set_size_hint (f, 0, true); + frame_resize_pixelwise = old_frame_resize_pixelwise; + FRAME_RIF (f)->clear_under_internal_border (f); + + gdk_window_move_resize + (window, left / scale, top / scale, new_pixel_width / scale, + new_pixel_height / scale); + + SET_FRAME_GARBAGED (f); + + frame_size_history_add (f, Qx_move_resize_2, width, height, Qnil); + + if (FRAME_VISIBLE_P (f)) + { + /* Must call this to flush out events */ + (void)gtk_events_pending (); + gdk_flush (); + x_wait_for_event (f, ConfigureNotify); + } + else + { + change_frame_size (f, new_pixel_width, new_pixel_height, + false, true, false, true); + x_sync (f); + } +#else + f->win_gravity = NorthWestGravity; + frame_resize_pixelwise = true; + x_wm_set_size_hint (f, 0, true); + frame_resize_pixelwise = old_frame_resize_pixelwise; + + XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), + left, top, new_pixel_width, + new_pixel_height + FRAME_MENUBAR_HEIGHT (f)); + + SET_FRAME_GARBAGED (f); + + frame_size_history_add (f, Qx_move_resize_2, width, height, Qnil); + + if (FRAME_VISIBLE_P (f)) + x_wait_for_event (f, ConfigureNotify); + else + { + change_frame_size (f,new_pixel_width, new_pixel_height, + false, true, false, true); + x_sync (f); + } + + x_clear_under_internal_border (f); +#endif + + mark_window_cursors_off (XWINDOW (f->root_window)); + cancel_mouse_face (f); + unblock_input (); + + do_pending_window_change (false); + f->resized_p = true; + + frame_size_history_add (f, Qx_move_resize_3, width, height, Qnil); + } +} + + +DEFUN ("x-set-frame-size-and-position", Fx_set_frame_size_and_position, + Sx_set_frame_size_and_position, 0, 5, 0, + doc: /* Set position of FRAME to (LEFT, TOP) and size to (WIDTH, HEIGHT). +FRAME must be a live frame and defaults to the selected one. The +remaining values must be either nil (which means to not change the +respective size or position) or specify a pixel value. */) + (Lisp_Object frame, Lisp_Object width, Lisp_Object height, + Lisp_Object left, Lisp_Object top) +{ + struct frame *f = decode_live_frame (frame); + int text_width, text_height, outer_left, outer_top; + + if (EQ (width, Qnil)) + text_width = FRAME_TEXT_WIDTH (f); + else + { + CHECK_TYPE_RANGED_INTEGER (int, width); + text_width = XFIXNUM (width); + } + + if (EQ (height, Qnil)) + text_height = FRAME_TEXT_HEIGHT (f); + else + { + CHECK_TYPE_RANGED_INTEGER (int, height); + text_height = XFIXNUM (height); + } + + if (EQ (left, Qnil)) + outer_left = f->left_pos; + else + { + CHECK_TYPE_RANGED_INTEGER (int, left); + outer_left = XFIXNUM (left); + } + + if (EQ (top, Qnil)) + outer_top = f->top_pos; + else + { + CHECK_TYPE_RANGED_INTEGER (int, top); + outer_top = XFIXNUM (top); + } + + x_window_move_resize + (f, text_width, text_height, outer_left, outer_top); + + return Qnil; +} DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, doc: /* Internal function called by `color-defined-p'. @@ -7742,6 +7899,20 @@ frames (each of which corresponds to one page). Each frame should be #endif /* USE_GTK */ #endif /* USE_CAIRO */ +#ifdef USE_GTK +DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, + doc: /* Toggle interactive GTK debugging. */) + (Lisp_Object enable) +{ + gboolean enable_debug = !NILP (enable); + + block_input (); + gtk_window_set_interactive_debugging (enable_debug); + unblock_input (); + + return NILP (enable) ? Qnil : Qt; +} +#endif /* USE_GTK */ /*********************************************************************** Initialization @@ -7810,6 +7981,9 @@ syms_of_xfns (void) DEFSYM (Qfont_parameter, "font-parameter"); DEFSYM (Qmono, "mono"); DEFSYM (Qassq_delete_all, "assq-delete-all"); + DEFSYM (Qx_move_resize_1, "x-move-resize-1"); + DEFSYM (Qx_move_resize_2, "x-move-resize-2"); + DEFSYM (Qx_move_resize_3, "x-move-resize-3"); #ifdef USE_CAIRO DEFSYM (Qpdf, "pdf"); @@ -8065,6 +8239,7 @@ syms_of_xfns (void) defsubr (&Sx_set_mouse_absolute_pixel_position); defsubr (&Sx_wm_set_size_hint); defsubr (&Sx_create_frame); + defsubr (&Sx_set_frame_size_and_position); defsubr (&Sx_open_connection); defsubr (&Sx_close_connection); defsubr (&Sx_display_list); @@ -8101,4 +8276,7 @@ syms_of_xfns (void) defsubr (&Sx_print_frames_dialog); #endif #endif +#ifdef USE_GTK + defsubr (&Sx_gtk_debug); +#endif }