From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: martin rudalics Newsgroups: gmane.emacs.devel Subject: Re: Emacs's set-frame-size can not work well with gnome-shell? Date: Fri, 31 Jan 2020 16:44:07 +0100 Message-ID: <44010781-43f0-3bc3-06ed-475c526dee36@gmx.at> References: <2056a194.3971.16f8d4dd4c5.Coremail.tumashu@163.com> <729d39eb-d0b4-2cc5-cac3-e129a3effa87@yandex.ru> <06c6b6fb-ce6f-456b-6a22-c5a26a0ab297@gmx.at> <50912835-37d2-f15b-8fd1-b6619893d1ce@yandex.ru> <4a424bf3-ee08-b114-73ef-287bde14003b@gmx.at> <5dd35cdd-2914-0b91-a6fd-e8764feecfb0@gmx.at> <9839e101-a25d-8875-4eee-2e6772249afe@yandex.ru> <728856fd-dab1-eade-54f5-6ba2c299373a@gmx.at> <6c775e15-1113-8406-5583-97c259305a7d@yandex.ru> <0fe2d245-9ac1-3528-e710-38462441f8aa@gmx.at> <9bac54df-8cd3-303d-910e-07e161ff1f3e@gmx.at> <414ade05-1ae6-75c2-9af1-e1eee42799a0@yandex.ru> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------56CE75D89369109CCD6E706E" Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="42664"; mail-complaints-to="usenet@ciao.gmane.io" Cc: "emacs-devel@gnu.org" To: Dmitry Gutov , tumashu Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Fri Jan 31 17:33:49 2020 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ixZEq-000Avv-01 for ged-emacs-devel@m.gmane-mx.org; Fri, 31 Jan 2020 17:33:48 +0100 Original-Received: from localhost ([::1]:55918 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ixZEo-00076N-AP for ged-emacs-devel@m.gmane-mx.org; Fri, 31 Jan 2020 11:33:46 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:55035) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ixYTU-0006PJ-Cx for emacs-devel@gnu.org; Fri, 31 Jan 2020 10:44:56 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ixYTQ-0005YT-9S for emacs-devel@gnu.org; Fri, 31 Jan 2020 10:44:52 -0500 Original-Received: from mout.gmx.net ([212.227.17.22]:41825) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ixYTP-0005N2-AZ for emacs-devel@gnu.org; Fri, 31 Jan 2020 10:44:48 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1580485449; bh=Fmqa92F7ZXBZeUYiwV3yqRKo9ugq0qmkatfEbzcUig0=; h=X-UI-Sender-Class:Subject:To:Cc:References:From:Date:In-Reply-To; b=EwNuWAiFRA6uHmAXw12ub1ns9Q1EwtRO/MgVHwg9S5mD8bPBZPbfIblC+fC0FyqIs KhBD0c2Mu0yGs8KR7bDc5U5mECEO1ChpiyFZJQhBz1nvFJeIA5F6KlDspWKupt/4I3 fsogC0inILLzQmbETJCOw4V/hLwKft0+rHECyMvo= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Original-Received: from [192.168.1.101] ([212.95.5.7]) by mail.gmx.com (mrgmx104 [212.227.17.168]) with ESMTPSA (Nemesis) id 1MlNtF-1jPUlZ2qez-00lqVA; Fri, 31 Jan 2020 16:44:08 +0100 In-Reply-To: <414ade05-1ae6-75c2-9af1-e1eee42799a0@yandex.ru> Content-Language: en-US X-Provags-ID: V03:K1:2/zLCcfM/wiQu496vDiqGsqHWxDDkTTsij4GZv27RVKWbmpqQyN PDIptGplsWp041B1eTvaxO29ayGTVI6jz08bj5XQEFT8M5F9adPgwtEopuqLKnWZFpK6XiD QaONDh9Ycu/Xc8xLGcKZqpCpXNvD9jGJz5mPMtVzJjq1kpEynienwAGTsmJbNse0Uxaz2VN BOMzzIn6HasI4J2KrcKlg== X-UI-Out-Filterresults: notjunk:1;V03:K0:xsV1kYFgtl4=:w62+3fcWZaDTd/5l1zQuRO NVULHh3pNl81ILhFZHHkKLxnWLc4168SJuw+VOc4EfNeXytTnxN2eY6axNOgcHscwyapKQ7fh wRbYpMRcE9XhO+39MW5DcV1agpMPdGMEaF84HpzvErkGxSBv5IZcsMj2mJ7ycRlf31wG/6jPF B6P5bDY6apxTSLUUBkI7yUqOS0t4HdyCVvPdA6WOOpiCp6du3XpjuMxAHQhRDd9KGjRins7Vw lNc0yUuK/y0DnTARUp/Kt29yJoGAfRMBKQQ5IwG9uQ5bbOpwhaSBG0StHeK6jJ7x05fdg3Lt7 BMuSQKlVUW2XFkl8pWGu8IbB1ERDbLNVZtdXZbbk2cZFcEJ24HGeYPUYaZT1LxoGzb5dojmd+ N7AxfsSGSczQxT3JaPyyMBNvlrZAN+mjhwmOr7uvc+qTIiXPH8H//SxMS+pvivckmysCJV/SO EhaWgn88ujStCAR3q+tExpWfttTjVcmwWMsa8gcopI+Cbfqhx9m0YcFMQMtQXcCccYwO2BBqv 7BH/BAW3laqGsy3YcEtj5+Q+E1fNp1ragesydVZdT1B7ItxwK0nUT6ORPrM+vpvjKl2iI9xmy J97D64b+U6HQrkzulBzg3dRIKksHkK75RYgyjaqQix7bG2z6FFmKypoIgK8IKvFiyVHf6nLyn 7z25/LpbdqENu1J5qhKZwEK2tJj/G8nWxx/z3Xh4hzDRpIVxSqOlehC16cyUrSw5klbpqvTkz Ib+a7VV4H7FIiO6eiHpCtnglSTwkaQudvY7p7SDtUF5dK0mKfopSSQ0rIG8TvsZCN2iYKWTj X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 212.227.17.22 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:244794 Archived-At: This is a multi-part message in MIME format. --------------56CE75D89369109CCD6E706E Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit > Considering scaling was only a problem for GTK, that doesn't sound > like success. Anyway, resizing normal undecorated frames in GTK seems > to work just as well now. Resizing child frame (with scaling on) is > still broken (but looks a bit different, no jumping around, at least). Presumably resizing child frames is still broken with scaling off too. > With GTK build frame resizing also doesn't honor non-pixelwise > resizing. When frame-resize-pixelwise is nil, resizing routinely eats > into internal borders (right and bottom ones). Right. I'll attach a patch that fixes it. Maybe we'll have to investigate the size hints issue next. The whole emacsgtkfixed.c stuff (which I do not understand) troubles me considerably. Could you try building with GTK 2? >> > - tumashu's child frame moving test scenario is still slow. >> > >> > E.g. >> > >> > (benchmark 1 `(set-frame-position ,test-frame 50 50)) >> > => 0.5s >> >> Nothing changed in this regard. But here >> >> (benchmark 1 `(x-set-frame-size-and-position ,test-frame nil nil 50 50)) >> >> => 0.100523s > > Seems like a possible improvement, but still much slower than set-frame-position with the GTK build. Neither of these benchmarks seems meaningful in the first place. What would it measure? Maybe tumashu can check with a version that uses 'x-set-frame-size-and-position' whether it's still too slow on non-GTK builds. martin --------------56CE75D89369109CCD6E706E Content-Type: text/x-patch; name="mouse+xfns.diff" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="mouse+xfns.diff" 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))))) =20 (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)))))) =20 (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)) =0C -(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-di= ff))) - 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 (>=3D last-x parent-left) + (>=3D (- first-width left) min-text-wid= th)) + (setq x-left (max (+ first-left left) 0)) + (setq x-width (- first-width left))) + (when (and drag-top (>=3D last-y parent-top) + (>=3D (- first-height top) min-text-hei= ght)) + (setq x-top (max 0 (+ first-top top))) + (setq x-height (- first-height top))) + (when (and drag-right (<=3D last-x parent-right) + (>=3D (+ first-width left) min-text-wid= th)) + (setq x-width (+ first-width left))) + (when (and drag-bottom (<=3D last-y parent-bottom) + (>=3D (+ first-height top) min-text-hei= ght)) + (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 (>=3D last-x parent-left) + (>=3D (- 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 (>=3D last-y parent-top) + (>=3D (- 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 (<=3D last-x parent-right) + (>=3D (+ first-width left) min-text-width))= + (push `(width . (text-pixels . ,(+ first-width left))) + alist)) + (when (and drag-bottom (<=3D last-y parent-bottom) + (>=3D (+ 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 othe= r 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 ..= =2E + (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) - (<=3D (- 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 (<=3D left parent-left) - (<=3D (- parent-left left) snap-width) - snap-x (<=3D (- 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) - (<=3D (- 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 (>=3D right parent-right) - (<=3D (- right parent-right) snap-width) - snap-x (<=3D (- 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) + (<=3D (- 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 (<=3D left parent-left) + (<=3D (- parent-left left) snap-width) + snap-x (<=3D (- 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) - (<=3D (- 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 (<=3D top parent-top) - (<=3D (- parent-top top) snap-width) - snap-y (<=3D (- 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) - (<=3D (- 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 (>=3D bottom parent-bottom) - (<=3D (- bottom parent-bottom) snap-width) - snap-y (<=3D (- 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 pa= r))) - (- 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) + (<=3D (- 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 (>=3D right parent-right) + (<=3D (- right parent-right) snap-width) + snap-x (<=3D (- 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) + (<=3D (- 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 (<=3D top parent-top) + (<=3D (- parent-top top) snap-width) + snap-y (<=3D (- 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) + (<=3D (- 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 (>=3D bottom parent-bottom) + (<=3D (- bottom parent-bottom) snap-width) + snap-y (<=3D (- 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-heig= ht 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)) (t= op . (+ ,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)) =20 (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)) =20 (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)) =20 (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)) =20 (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)) =20 (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)) =20 (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)) =20 (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)) =20 (defcustom mouse-select-region-move-to-beginning nil "Effect of selecting a region extending backward from double click. diff --git a/src/xfns.c b/src/xfns.c index 276ea1c393..d8387f66bf 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4203,6 +4203,231 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_crea= te_frame, return unbind_to (count, frame); } =20 + +static void +x_set_frame_size_and_position (struct frame *f, int width, int height, i= nt left, int top) +{ + int unit_width =3D FRAME_COLUMN_WIDTH (f); + int unit_height =3D FRAME_LINE_HEIGHT (f); + int old_pixel_width =3D FRAME_PIXEL_WIDTH (f); + int old_pixel_height =3D FRAME_PIXEL_HEIGHT (f); + int old_cols =3D FRAME_COLS (f); + int old_lines =3D FRAME_LINES (f); + int new_pixel_width =3D FRAME_TEXT_TO_PIXEL_WIDTH (f, width); + int new_pixel_height =3D FRAME_TEXT_TO_PIXEL_HEIGHT (f, height); + struct window *r =3D XWINDOW (FRAME_ROOT_WINDOW (f)); + int old_windows_width =3D WINDOW_PIXEL_WIDTH (r); + int old_windows_height + =3D (WINDOW_PIXEL_HEIGHT (r) + + ((FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f)) + ? WINDOW_PIXEL_HEIGHT (XWINDOW (FRAME_MINIBUF_WINDOW (f))) + : 0)); + int new_windows_width, new_windows_height; + int new_cols, new_lines; + Lisp_Object frame; + bool old_frame_resize_pixelwise =3D frame_resize_pixelwise; +#ifdef USE_GTK + int scale =3D xg_get_scale (f); +#endif + + XSETFRAME (frame, f); + + frame_size_history_add + (f, Qx_set_frame_size_and_position_1, new_pixel_width, + new_pixel_height, Qnil); + + new_windows_width =3D new_pixel_width - 2 * FRAME_INTERNAL_BORDER_WIDT= H (f); + new_windows_height =3D (new_pixel_height + - FRAME_TOP_MARGIN_HEIGHT (f) + - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + new_cols =3D width / unit_width; + new_lines =3D height / unit_height; + + if (FRAME_WINDOW_P (f) && f->can_set_window_size) + { + block_input (); + +#ifdef USE_GTK + GdkWindow *window =3D gtk_widget_get_window (FRAME_GTK_OUTER_WIDGE= T (f)); + + frame_resize_pixelwise =3D true; + x_wm_set_size_hint (f, 0, true); + frame_resize_pixelwise =3D old_frame_resize_pixelwise; + gdk_window_move_resize + (window, left / scale, top / scale, new_pixel_width / scale, + new_pixel_height / scale); + SET_FRAME_GARBAGED (f); + cancel_mouse_face (f); + + 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 =3D NorthWestGravity; + frame_resize_pixelwise =3D true; + x_wm_set_size_hint (f, 0, true); + frame_resize_pixelwise =3D 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); + + 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 =3D true; + + block_input (); + } + + if (new_windows_width !=3D old_windows_width) + { + resize_frame_windows (f, new_windows_width, true); + if (WINDOWP (f->tab_bar_window)) + { + XWINDOW (f->tab_bar_window)->pixel_width =3D new_windows_width; + XWINDOW (f->tab_bar_window)->total_cols + =3D new_windows_width / unit_width; + } + +#if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_TOOL_BAR) + if (WINDOWP (f->tool_bar_window)) + { + XWINDOW (f->tool_bar_window)->pixel_width =3D new_windows_width; + XWINDOW (f->tool_bar_window)->total_cols + =3D new_windows_width / unit_width; + } +#endif + } + else if (new_cols !=3D old_cols) + call2 (Qwindow__pixel_to_total, frame, Qt); + + if (new_windows_height !=3D old_windows_height + || WINDOW_TOP_PIXEL_EDGE (r) !=3D FRAME_TOP_MARGIN_HEIGHT (f)) + resize_frame_windows (f, new_windows_height, false); + else if (new_lines !=3D old_lines) + call2 (Qwindow__pixel_to_total, frame, Qnil); + + frame_size_history_add + (f, Qx_set_frame_size_and_position_3, width, height, Qnil); + + /* Assign new sizes. */ + FRAME_TEXT_WIDTH (f) =3D width; + FRAME_TEXT_HEIGHT (f) =3D height; + FRAME_PIXEL_WIDTH (f) =3D new_pixel_width; + FRAME_PIXEL_HEIGHT (f) =3D new_pixel_height; + SET_FRAME_COLS (f, new_cols); + SET_FRAME_LINES (f, new_lines); + SET_FRAME_COLS (f, new_cols); + SET_FRAME_LINES (f, new_lines); + + { + struct window *w =3D XWINDOW (FRAME_SELECTED_WINDOW (f)); + int text_area_x, text_area_y, text_area_width, text_area_height; + + window_box (w, TEXT_AREA, &text_area_x, &text_area_y, &text_area_wid= th, + &text_area_height); + if (w->cursor.x >=3D text_area_x + text_area_width) + w->cursor.hpos =3D w->cursor.x =3D 0; + if (w->cursor.y >=3D text_area_y + text_area_height) + w->cursor.vpos =3D w->cursor.y =3D 0; + } + + /* Sanitize window sizes. */ + sanitize_window_sizes (Qt); + sanitize_window_sizes (Qnil); + + adjust_frame_glyphs (f); + calculate_costs (f); + SET_FRAME_GARBAGED (f); + + /* A frame was "resized" if one of its pixelsizes changed, even if its= + X window wasn't resized at all. */ + f->resized_p =3D (new_pixel_width !=3D old_pixel_width + || new_pixel_height !=3D old_pixel_height); + + unblock_input (); +} + + +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 =3D decode_live_frame (frame); + int text_width, text_height, outer_left, outer_top; + + if (EQ (width, Qnil)) + text_width =3D FRAME_TEXT_WIDTH (f); + else + { + CHECK_TYPE_RANGED_INTEGER (int, width); + text_width =3D XFIXNUM (width); + } + + if (EQ (height, Qnil)) + text_height =3D FRAME_TEXT_HEIGHT (f); + else + { + CHECK_TYPE_RANGED_INTEGER (int, height); + text_height =3D XFIXNUM (height); + } + + if (EQ (left, Qnil)) + outer_left =3D f->left_pos; + else + { + CHECK_TYPE_RANGED_INTEGER (int, left); + outer_left =3D XFIXNUM (left); + } + + if (EQ (top, Qnil)) + outer_top =3D f->top_pos; + else + { + CHECK_TYPE_RANGED_INTEGER (int, top); + outer_top =3D XFIXNUM (top); + } + + x_set_frame_size_and_position + (f, text_width, text_height, outer_left, outer_top); + + return Qnil; +} =0C DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1= , 2, 0, doc: /* Internal function called by `color-defined-p'. @@ -7810,6 +8035,9 @@ syms_of_xfns (void) DEFSYM (Qfont_parameter, "font-parameter"); DEFSYM (Qmono, "mono"); DEFSYM (Qassq_delete_all, "assq-delete-all"); + DEFSYM (Qx_set_frame_size_and_position_1, "x-set-frame-size-and-positi= on-1"); + DEFSYM (Qx_set_frame_size_and_position_2, "x-set-frame-size-and-positi= on-2"); + DEFSYM (Qx_set_frame_size_and_position_3, "x-set-frame-size-and-positi= on-3"); =20 #ifdef USE_CAIRO DEFSYM (Qpdf, "pdf"); @@ -8065,6 +8293,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); --------------56CE75D89369109CCD6E706E--