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: Wed, 5 Feb 2020 10:15:26 +0100 Message-ID: <8a485c09-535a-97e6-9817-31e6d2f93adb@gmx.at> References: <2056a194.3971.16f8d4dd4c5.Coremail.tumashu@163.com> <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> <44010781-43f0-3bc3-06ed-475c526dee36@gmx.at> <70813591-8c24-cb30-8ecf-0c413a51f472@gmx.at> <81215100-3476-9d2c-f535-f57fbd18fd8b@yandex.ru> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------08F735DD7D46E5CF338BAEFC" Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="4159"; 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 Wed Feb 05 10:20:30 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 1izGrG-0000tj-2t for ged-emacs-devel@m.gmane-mx.org; Wed, 05 Feb 2020 10:20:30 +0100 Original-Received: from localhost ([::1]:43314 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1izGrE-0003ki-Uz for ged-emacs-devel@m.gmane-mx.org; Wed, 05 Feb 2020 04:20:29 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:36657) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1izGn6-0002fr-VA for emacs-devel@gnu.org; Wed, 05 Feb 2020 04:16:20 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1izGn1-0002lj-D4 for emacs-devel@gnu.org; Wed, 05 Feb 2020 04:16:12 -0500 Original-Received: from mout.gmx.net ([212.227.15.19]:53877) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1izGn0-0002Jz-Kq for emacs-devel@gnu.org; Wed, 05 Feb 2020 04:16:07 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1580894127; bh=6YOuhhrhIoYNer01Zlf4L3N1LndP20LWv/DB2gvcoeg=; h=X-UI-Sender-Class:Subject:To:Cc:References:From:Date:In-Reply-To; b=N/nbaU3fRdXdEEC/6wTlTSgvJhrxnFx4Zw4MshcXhbEjWaN74HVqLlndB7rcd43EC PQkx7vMBqtP5jiUa1ut8ubm6tvVdOF7QuBAR5qXdzDQeUQOEzSZrAUY7bGnc06y+BE 98bSRVHj+6iNsZL9q4GI7n10YJPHbW1PkLwwUATc= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Original-Received: from [192.168.1.101] ([212.95.5.200]) by mail.gmx.com (mrgmx004 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MVNAr-1j8zQO24Yh-00SRIS; Wed, 05 Feb 2020 10:15:27 +0100 In-Reply-To: <81215100-3476-9d2c-f535-f57fbd18fd8b@yandex.ru> Content-Language: en-US X-Provags-ID: V03:K1:3eU1bICPgdxTTu3zEcoZK1tC3zXZPSN+i2q+ReENEo6VKuPFlxe rBaZbwyDplYkODwNUVglIZb+NpRceoWCtXX0aTVtPGA7ZiRKw1/fFP/XI7W7kdjYloNZn3v wryg6A8awA/Hie1/r4rXylJsLvlTY0gjbzPss55lHpP2QIjdRs2+KwPojw7coGOJWNRBOZO 1eZPNlOvcloO3B8PzlXrw== X-UI-Out-Filterresults: notjunk:1;V03:K0:Y5ubxLHSV80=:EkwedbslbLWjNb3MTecLC3 dqwG4bY9wW6m/KXKR3fseMstfje08/4lCI95mAZavixFkIcGEaENstMPmZ63rL4NuMUhBX4M7 nEoYjBzSNdF63feMyygxPsq8TZHQmUOoOvTYnQNrQKyEId+lawuoSP37DuOqtJAWuTn1Sgbr8 cHhHPonFjy+2YbQi/u8LFCV35EY6h2V4STHzHjz2feYHQw4D+MfO0DIUgWfQdIU3FCLwXF0K5 J5em73cgZfY/Z+cx8/Ic9P/Vjd/vDxuA+17l0GtgW9aKCYbDZXyjfQKTuJPcNBHQkQXWJ5w9J 74VZOGSuh6TU4eLNdTaKp1XspJVvbYEZE9IH6vhNWgoCvgyA4bWU09aBQngtm7Cg89oL1Tec7 m12yiC8cgm79hToVjPGTuY3Tdx7e3VkI4UhuhwAX7w87RLNzIRMuKcP1TFiJKGo0NsJ6wOTah Nfyrx0F5oh+WgW+2VxAH7NwtEzfHi1uKeeh8o3NMJDXO+Nd+olr+X6ds9qnSi68Kt0uuDgZ6u s5C74E4kxddsYFNVDVv2ge284/z89p+d1P+wj3MvI3Gy0VPm812ZwiN77IVIW8sA223OX7KK3 n7tcQzpH2IKCci10fmyiTukUtkgbJ35F/IWNTfKo8XnTWzNmrFipmQ/8M5UXNGaigKFmWmREu Puu1GKo4OEs6iDvBSm1XCVanYga+wrzPWRYXGNZFOvMs2dKWWlJy6JL9axrtcGjvcAPCyALDC wM+vgdGbqhCei6odAhRLA/y+MtEC1iikk+kQ5KVMSdCIH+MC/Ea80OVZY+AhJWU9H/5+RhiA X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 212.227.15.19 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:244859 Archived-At: This is a multi-part message in MIME format. --------------08F735DD7D46E5CF338BAEFC Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit >> Does making the initial child frame very large >> give you more room to move? > > Yes, as per the above. So you could make the initial child frame 10000 pixel wide and high and resizing would never fail? >> (1) Pursue the previous idea to use X calls instead of gtk calls for >> resizing child frames. For this purpose, on top of mouse+xfns.diff >> please change the >> >> gdk_window_move_resize >> (window, left / scale, top / scale, new_pixel_width / scale, >> new_pixel_height / scale); >> >> call to >> >> if (FRAME_PARENT_FRAME (f)) >> XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), >> left / scale, top / scale, new_pixel_width / scale, >> new_pixel_height / scale); >> else >> gdk_window_move_resize >> (window, left / scale, top / scale, new_pixel_width / scale, >> new_pixel_height / scale); >> >> If this works but gives problem with scaling, then drop all " / scale" >> instances in the XMoveResizeWindow call. > > Didn't help. The patch, as-is, introduced a scaling problem. And > dropping "/ scale" instances Which ones did you drop - all? The ones in the gdk_window_move_resize call should remain, only the ones from the XMoveResizeWindow call should be dropped. > made it go back to the previous stage of affairs (resizing is limited by the original child frame bounds). > >> (2) Look into the size hints issue. I suspect that what we see here is >> Bug#8919 raising its ugly head again. To fix that bug, Jan has >> rewritten XSetWMNormalHints to use his XSetWMSizeHints from >> emacsgtkfixed.c, which is a gross hack in a dual sense: It (i) replaces >> an X function (ii) for the purpose of fixing the behavior of a gtk >> function. >> >> Let's try the following. Apply the attached frame-size-history.diff >> from a pristine repository. Then start with 'test-frame' created, eval >> the following forms (positions and sizes may need adapting) >> >> (setq frame-size-history '(100)) >> (x-set-frame-size-and-position test-frame 400 200 100 50) >> (frame--size-history test-frame) >> (display-buffer "*frame-size-history*") >> >> and post the history here (unless your Emacs crashed before). > > No crash. Does this look right? > > Frame size history of # > x-set-frame-size-and-position-1 (720 360 448 200) nil > x-set-frame-size-and-position-3 (720 360 400 200) nil > > The child frame got resized to a smaller size, though. > > Should I try a bigger width and height? The history looks pretty much the same in that case. No. You apparently don't get anything from the XSetWMSizeHints calls. I meanwhile installed mutter here. Debian apparently doesn't resolve the dependencies well so I had to manually install some additional gnomish features. The whole thing still looks incomplete though. The frame positioning behavior of mutter is a pain for me and renders my usual Emacs frame setup practically unusable. It's possibly a consequence of making borders invisible and having the frame minimize and maximize when it's pushed against the bottom or top edge of the display. Visible child frames never resize, I cannot even shrink them. Also, I can't get vertical scroll bars for them. In one case I was told Window manager warning: Window 0x4a0003d (Terminal) sets an MWM hint indicating it isn't resizable, but sets min size 1 x 1 and max size 2147483647 x 2147483647; this doesn't make much sense. but I'm not even sure whether these resulted from an Emacs frame - the max size values are not ours AFAICT. Also we set MWM hints only from within non-GTK builds, maybe I've been running one of them. Anyway, I meanwhile further rewrote the code for mouse dragging and 'x-set-frame-size-and-position', patch attached. I also added an interface to the gtk inspector, you can enable it via (when (fboundp 'x-gtk-debug) (x-gtk-debug t)) Maybe you can derive something from running it. At least here, when under "visual" turning on "graphics actualizations", I can clearly see that GTK processes and passes on the resize requests for child frames (by turning the frame red) and that they are later apparently dismissed by mutter. martin --------------08F735DD7D46E5CF338BAEFC 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/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, =20 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))); } =20 /* 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_s= ize, * 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 fram= e *f, int x, int y); +extern int frame_windows_min_size (Lisp_Object, Lisp_Object, Lisp_Object= , Lisp_Object); =20 #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; =20 XSETFRAME (frame, f); @@ -1429,7 +1428,7 @@ x_wm_set_size_hint (struct frame *f, long int flags= , bool user_position) size_hints =3D f->output_data.x->size_hints; hint_flags =3D f->output_data.x->hint_flags; =20 - hint_flags |=3D GDK_HINT_RESIZE_INC | GDK_HINT_MIN_SIZE; + hint_flags |=3D GDK_HINT_RESIZE_INC | GDK_HINT_MIN_SIZE | GDK_HINT_MAX= _SIZE; size_hints.width_inc =3D frame_resize_pixelwise ? 1 : FRAME_COLUMN_WID= TH (f); size_hints.height_inc =3D frame_resize_pixelwise ? 1 : FRAME_LINE_HEIG= HT (f); =20 @@ -1445,6 +1444,8 @@ x_wm_set_size_hint (struct frame *f, long int flags= , bool user_position) size_hints.base_height =3D base_height; size_hints.min_width =3D base_width; size_hints.min_height =3D base_height; + size_hints.max_width =3D 10000; + size_hints.max_height =3D 10000; =20 /* 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_crea= te_frame, return unbind_to (count, frame); } =20 + +static void +x_window_move_resize (struct frame *f, int width, int height, int left, = int top) +{ + int old_pixel_width =3D FRAME_PIXEL_WIDTH (f); + int old_pixel_height =3D 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 =3D frame_resize_pixelwise; +#ifdef USE_GTK + int scale =3D xg_get_scale (f); +#endif + + XSETFRAME (frame, f); + + frame_size_history_add (f, Qx_move_resize_1, width, height, Qnil); + + min_windows_width =3D frame_windows_min_size (frame, Qt, Qnil, Qt); + min_windows_height =3D frame_windows_min_size (frame, Qnil, Qnil, Qt);= + + inhibit_horizontal =3D frame_inhibit_resize (f, true, Qnil); + inhibit_vertical =3D frame_inhibit_resize (f, false, Qnil); + + new_pixel_width =3D (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 =3D (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 =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; + 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 =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); + + 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 =3D 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 =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_window_move_resize + (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'. @@ -7742,6 +7899,20 @@ frames (each of which corresponds to one page). E= ach frame should be #endif /* USE_GTK */ #endif /* USE_CAIRO */ =20 +#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 =3D !NILP (enable); + + block_input (); + gtk_window_set_interactive_debugging (enable_debug); + unblock_input (); + + return NILP (enable) ? Qnil : Qt; +} +#endif /* USE_GTK */ =0C /***********************************************************************= 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"); =20 #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 } --------------08F735DD7D46E5CF338BAEFC--