Add RandR support for docks and reuse workareas

* exwm-workspace (exwm-workspace--update-struts): Add RandR support for
docks.

* exwm-workspace (exwm-workspace--workareas): New variable for storing
workareas.
(exwm-workspace--update-workareas): Update workareas and set
_NET_WORKAREA (replaces `exwm-workspace--set-workareas').
(exwm-workspace--set-fullscreen): Reuse workareas for
resizing and drop optional arguments.
(exwm-workspace--resize-minibuffer-frame)
(exwm-workspace--on-ConfigureNotify): Reuse workareas for
resizing/reposition the (optional) dedicated minibuffer frame.

* exwm-layout.el (exwm-layout-set-fullscreen): Do not use
`exwm-workspace--set-fullscreen' here.

* exwm-manage.el (exwm-manage--unmanage-window):
* exwm-randr.el (exwm-randr--refresh):
* exwm.el (exwm--update-struts-legacy, exwm--update-struts-partial):
Update workareas before resizing workspaces.

* exwm.el (exwm--update-struts-legacy, exwm--update-struts-partial):
Remove the corresponding record on receiving invalid struts.

* exwm-workspace.el (exwm-workspace--get-geometry): New utility
function for retrieving workspace geometry.
This commit is contained in:
Chris Feng 2016-07-16 14:34:57 +08:00
parent 7f12d9fc7a
commit 4ac71a7ddc
5 changed files with 170 additions and 148 deletions

View file

@ -155,8 +155,7 @@
(defvar exwm-workspace--current) (defvar exwm-workspace--current)
(defvar exwm-workspace--list) (defvar exwm-workspace--list)
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
(frame &optional no-struts container-only))
;;;###autoload ;;;###autoload
(defun exwm-layout-set-fullscreen (&optional id) (defun exwm-layout-set-fullscreen (&optional id)
@ -165,15 +164,20 @@
(with-current-buffer (if id (exwm--id->buffer id) (window-buffer)) (with-current-buffer (if id (exwm--id->buffer id) (window-buffer))
(when exwm--fullscreen (when exwm--fullscreen
(user-error "Already in full-screen mode.")) (user-error "Already in full-screen mode."))
;; Set the floating frame fullscreen first when the client is floating ;; Save the position of floating frame.
(when exwm--floating-frame (when exwm--floating-frame
(let* ((geometry (xcb:+request-unchecked+reply exwm--connection (let* ((geometry (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry (make-instance 'xcb:GetGeometry
:drawable exwm--container)))) :drawable exwm--container))))
(setq exwm--floating-frame-position (setq exwm--floating-frame-position
(vector (slot-value geometry 'x) (slot-value geometry 'y))))) (vector (slot-value geometry 'x) (slot-value geometry 'y)))))
;; Expand the workspace frame & its container to fill the whole screen. ;; Expand the workspace to fill the whole screen.
(exwm-workspace--set-fullscreen exwm--frame t t) (with-slots (x y width height) (exwm-workspace--get-geometry exwm--frame)
(exwm-layout--resize-container nil
(frame-parameter exwm--frame
'exwm-workspace)
x y width height
t))
;; Raise the workspace container (in case there are docks). ;; Raise the workspace container (in case there are docks).
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow

View file

@ -252,10 +252,8 @@ corresponding buffer.")
(defvar exwm-workspace--list) (defvar exwm-workspace--list)
(declare-function exwm-workspace--update-struts "exwm-workspace.el" ()) (declare-function exwm-workspace--update-struts "exwm-workspace.el" ())
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (declare-function exwm-workspace--update-workareas "exwm-workspace.el" ())
(frame &optional no-struts container-only)) (declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
(declare-function exwm-workspace--set-workareas "exwm-workspace.el"
(&optional workareas))
(defun exwm-manage--unmanage-window (id &optional withdraw-only) (defun exwm-manage--unmanage-window (id &optional withdraw-only)
"Unmanage window ID. "Unmanage window ID.
@ -272,9 +270,9 @@ manager is shutting down."
(setq exwm-workspace--id-struts-alist (setq exwm-workspace--id-struts-alist
(assq-delete-all id exwm-workspace--id-struts-alist)) (assq-delete-all id exwm-workspace--id-struts-alist))
(exwm-workspace--update-struts) (exwm-workspace--update-struts)
(exwm-workspace--update-workareas)
(dolist (f exwm-workspace--list) (dolist (f exwm-workspace--list)
(exwm-workspace--set-fullscreen f)) (exwm-workspace--set-fullscreen f)))
(exwm-workspace--set-workareas))
(when (buffer-live-p buffer) (when (buffer-live-p buffer)
(with-current-buffer buffer (with-current-buffer buffer
;; Flickering seems unavoidable here if the DestroyWindow request is ;; Flickering seems unavoidable here if the DestroyWindow request is

View file

@ -58,15 +58,13 @@
(defvar exwm-workspace-number) (defvar exwm-workspace-number)
(defvar exwm-workspace--list) (defvar exwm-workspace--list)
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (declare-function exwm-workspace--update-workareas "exwm-workspace.el" ())
(frame &optional no-struts container-only)) (declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
(declare-function exwm-workspace--set-workareas "exwm-workspace.el"
(&optional workareas))
(declare-function exwm-workspace--set-desktop-geometry "exwm-workspace.el" ()) (declare-function exwm-workspace--set-desktop-geometry "exwm-workspace.el" ())
(defun exwm-randr--refresh () (defun exwm-randr--refresh ()
"Refresh workspaces according to the updated RandR info." "Refresh workspaces according to the updated RandR info."
(let (output-name geometry output-plist default-geometry workareas) (let (output-name geometry output-plist default-geometry)
;; Query all outputs ;; Query all outputs
(with-slots (config-timestamp outputs) (with-slots (config-timestamp outputs)
(xcb:+request-unchecked+reply exwm--connection (xcb:+request-unchecked+reply exwm--connection
@ -96,7 +94,9 @@
(setq default-geometry geometry))))))) (setq default-geometry geometry)))))))
(exwm--log "(randr) outputs: %s" output-plist) (exwm--log "(randr) outputs: %s" output-plist)
(when output-plist (when output-plist
(setq exwm-workspace--fullscreen-frame-count 0) (when exwm-workspace--fullscreen-frame-count
;; Not all workspaces are fullscreen; reset this counter.
(setq exwm-workspace--fullscreen-frame-count 0))
(dotimes (i exwm-workspace-number) (dotimes (i exwm-workspace-number)
(let* ((output (plist-get exwm-randr-workspace-output-plist i)) (let* ((output (plist-get exwm-randr-workspace-output-plist i))
(geometry (lax-plist-get output-plist output)) (geometry (lax-plist-get output-plist output))
@ -105,14 +105,14 @@
(setq geometry default-geometry (setq geometry default-geometry
output nil)) output nil))
(set-frame-parameter frame 'exwm-randr-output output) (set-frame-parameter frame 'exwm-randr-output output)
(set-frame-parameter frame 'exwm-geometry geometry) (set-frame-parameter frame 'exwm-geometry geometry)))
(exwm-workspace--set-fullscreen frame) ;; Update workareas and set _NET_WORKAREA.
(with-slots (x y width height) geometry (exwm-workspace--update-workareas)
(setq workareas (nconc workareas (list x y width height)))))) ;; Resize workspace.
(dolist (f exwm-workspace--list)
(exwm-workspace--set-fullscreen f))
;; Set _NET_DESKTOP_GEOMETRY. ;; Set _NET_DESKTOP_GEOMETRY.
(exwm-workspace--set-desktop-geometry) (exwm-workspace--set-desktop-geometry)
;; Set _NET_WORKAREA.
(exwm-workspace--set-workareas (vconcat workareas))
(xcb:flush exwm--connection) (xcb:flush exwm--connection)
(run-hooks 'exwm-randr-refresh-hook)))) (run-hooks 'exwm-randr-refresh-hook))))

View file

@ -107,6 +107,16 @@ Value nil means to use the default position which is fixed at bottom, while
(defvar exwm-workspace--display-echo-area-timer nil (defvar exwm-workspace--display-echo-area-timer nil
"Timer for auto-hiding echo area.") "Timer for auto-hiding echo area.")
;;;###autoload
(defun exwm-workspace--get-geometry (frame)
"Return the geometry of frame FRAME."
(or (frame-parameter frame 'exwm-geometry)
(make-instance 'xcb:RECTANGLE
:x 0
:y 0
:width (x-display-pixel-width)
:height (x-display-pixel-height))))
;;;###autoload ;;;###autoload
(defun exwm-workspace--current-width () (defun exwm-workspace--current-width ()
"Return the width of current workspace." "Return the width of current workspace."
@ -133,25 +143,89 @@ Value nil means to use the default position which is fixed at bottom, while
(defun exwm-workspace--update-struts () (defun exwm-workspace--update-struts ()
"Update `exwm-workspace--struts'." "Update `exwm-workspace--struts'."
(let ((left 0) (setq exwm-workspace--struts nil)
(right 0) (let (struts struts*)
(top 0)
(bottom 0)
struts)
(dolist (pair exwm-workspace--id-struts-alist) (dolist (pair exwm-workspace--id-struts-alist)
(setq struts (cdr pair)) (setq struts (cdr pair))
(when struts (dotimes (i 4)
(when (< left (aref struts 0)) (when (/= 0 (aref struts i))
(setq left (aref struts 0))) (setq struts*
(when (< right (aref struts 1)) (vector (aref [left right top bottom] i)
(setq right (aref struts 1))) (aref struts i)
(when (< top (aref struts 2)) (when (= 12 (length struts))
(setq top (aref struts 2))) (substring struts (+ 4 (* i 2)) (+ 6 (* i 2))))))
(when (< bottom (aref struts 3)) (if (= 0 (mod i 2))
(setq bottom (aref struts 3))))) ;; Make left/top processed first.
(setq exwm-workspace--struts (vector left right top bottom)) (push struts* exwm-workspace--struts)
(when (equal exwm-workspace--struts [0 0 0 0]) (setq exwm-workspace--struts
(setq exwm-workspace--struts nil)))) (append exwm-workspace--struts (list struts*)))))))))
(defvar exwm-workspace--workareas nil "Workareas (struts excluded).")
(defun exwm-workspace--update-workareas ()
"Update `exwm-workspace--workareas' and set _NET_WORKAREA."
(let ((root-width (x-display-pixel-width))
(root-height (x-display-pixel-height))
workareas
edge width position
delta)
;; Calculate workareas with no struts.
(if (frame-parameter (car exwm-workspace--list) 'exwm-geometry)
;; Use the 'exwm-geometry' frame parameter if possible.
(dolist (f exwm-workspace--list)
(with-slots (x y width height) (frame-parameter f 'exwm-geometry)
(setq workareas (append workareas
(list (vector x y width height))))))
;; Fall back to use the screen size.
(let ((workarea (vector 0 0 root-width root-height)))
(dotimes (_ exwm-workspace-number)
(push workarea workareas))))
;; Exclude areas occupied by struts.
(dolist (struts exwm-workspace--struts)
(setq edge (aref struts 0)
width (aref struts 1)
position (aref struts 2))
(dolist (w workareas)
(pcase edge
;; Left and top are always processed first.
(`left
(setq delta (- (aref w 0) width))
(when (and (< delta 0)
(< (max (aref position 0) (aref w 1))
(min (aref position 1)
(+ (aref w 1) (aref w 3)))))
(cl-incf (aref w 2) delta)
(setf (aref w 0) width)))
(`right
(setq delta (- root-width (aref w 0) (aref w 2) width))
(when (and (< delta 0)
(< (max (aref position 0) (aref w 1))
(min (aref position 1)
(+ (aref w 1) (aref w 3)))))
(cl-incf (aref w 2) delta)))
(`top
(setq delta (- (aref w 1) width))
(when (and (< delta 0)
(< (max (aref position 0) (aref w 0))
(min (aref position 1)
(+ (aref w 0) (aref w 2)))))
(cl-incf (aref w 3) delta)
(setf (aref w 1) width)))
(`bottom
(setq delta (- root-height (aref w 1) (aref w 3) width))
(when (and (< delta 0)
(< (max (aref position 0) (aref w 0))
(min (aref position 1)
(+ (aref w 0) (aref w 2)))))
(cl-incf (aref w 3) delta))))))
;; Save the result.
(setq exwm-workspace--workareas workareas)
;; Update _NET_WORKAREA.
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WORKAREA
:window exwm--root
:data (mapconcat #'vconcat workareas [])))
(xcb:flush exwm--connection)))
(defvar exwm-workspace--fullscreen-frame-count 0 (defvar exwm-workspace--fullscreen-frame-count 0
"Count the fullscreen workspace frames.") "Count the fullscreen workspace frames.")
@ -159,69 +233,40 @@ Value nil means to use the default position which is fixed at bottom, while
(declare-function exwm-layout--resize-container "exwm-layout.el" (declare-function exwm-layout--resize-container "exwm-layout.el"
(id container x y width height &optional container-only)) (id container x y width height &optional container-only))
(defun exwm-workspace--set-fullscreen (frame &optional no-struts (defun exwm-workspace--set-fullscreen (frame)
container-only) "Make frame FRAME fullscreen according to `exwm-workspace--workareas'."
"Make frame FRAME fullscreen, with regard to its RandR output if applicable. (let ((workarea (elt exwm-workspace--workareas
(cl-position frame exwm-workspace--list)))
If NO-STRUTS is non-nil, struts are ignored. If CONTAINER-ONLY is non-nil, the
workspace frame and its container is not resized."
(let ((geometry (or (frame-parameter frame 'exwm-geometry)
(xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry
:drawable exwm--root))
(make-instance 'xcb:RECTANGLE :x 0 :y 0
:width (x-display-pixel-width)
:height (x-display-pixel-height))))
(id (frame-parameter frame 'exwm-outer-id)) (id (frame-parameter frame 'exwm-outer-id))
(container (frame-parameter frame 'exwm-container)) (container (frame-parameter frame 'exwm-container))
(workspace (frame-parameter frame 'exwm-workspace)) (workspace (frame-parameter frame 'exwm-workspace))
x* y* width* height*) x y width height)
(with-slots (x y width height) geometry (setq x (aref workarea 0)
(if (and exwm-workspace--struts (not no-struts)) y (aref workarea 1)
(setq x* (+ x (aref exwm-workspace--struts 0)) width (aref workarea 2)
y* (+ y (aref exwm-workspace--struts 2)) height (aref workarea 3))
width* (- width (aref exwm-workspace--struts 0) (when (and (eq frame exwm-workspace--current)
(aref exwm-workspace--struts 1)) (exwm-workspace--minibuffer-own-frame-p))
height* (- height (aref exwm-workspace--struts 2) (exwm-workspace--resize-minibuffer-frame))
(aref exwm-workspace--struts 3))) (exwm-layout--resize-container id container 0 0 width height)
(setq x* x (exwm-layout--resize-container nil workspace x y width height t)
y* y (xcb:flush exwm--connection))
width* width ;; This is only used for workspace initialization.
height* height)) (when exwm-workspace--fullscreen-frame-count
(when (and (eq frame exwm-workspace--current)
(exwm-workspace--minibuffer-own-frame-p)
(not container-only))
(exwm-workspace--resize-minibuffer-frame width height))
(unless container-only
(exwm-layout--resize-container id container 0 0 width* height*))
(exwm-layout--resize-container nil workspace x* y* width* height* t)
(xcb:flush exwm--connection)))
(unless container-only
(cl-incf exwm-workspace--fullscreen-frame-count))) (cl-incf exwm-workspace--fullscreen-frame-count)))
;;;###autoload (defun exwm-workspace--resize-minibuffer-frame ()
(defun exwm-workspace--resize-minibuffer-frame (&optional width height) "Resize minibuffer (and its container) to fit the size of workspace."
"Resize minibuffer (and its container) to fit the size of workspace.
If WIDTH and HEIGHT of the workspace is not specified, they're get from the
workspace frame."
(cl-assert (exwm-workspace--minibuffer-own-frame-p)) (cl-assert (exwm-workspace--minibuffer-own-frame-p))
(let ((y (if (eq exwm-workspace-minibuffer-position 'top) (let ((workarea (elt exwm-workspace--workareas exwm-workspace-current-index))
0
(- (or height (exwm-workspace--current-height))
(if exwm-workspace--struts
(+ (aref exwm-workspace--struts 2)
(aref exwm-workspace--struts 3))
0)
(frame-pixel-height exwm-workspace--minibuffer))))
(container (frame-parameter exwm-workspace--minibuffer (container (frame-parameter exwm-workspace--minibuffer
'exwm-container))) 'exwm-container))
(unless width y width)
(setq width (exwm-workspace--current-width))) (setq y (if (eq exwm-workspace-minibuffer-position 'top)
(when exwm-workspace--struts 0
(setq width (- width (- (aref workarea 3)
(aref exwm-workspace--struts 0) (frame-pixel-height exwm-workspace--minibuffer)))
(aref exwm-workspace--struts 1)))) width (aref workarea 2))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow
:window container :window container
@ -592,11 +637,9 @@ The optional FORCE option is for internal use only."
(setq value-mask xcb:ConfigWindow:Height (setq value-mask xcb:ConfigWindow:Height
y 0) y 0)
(setq value-mask (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height) (setq value-mask (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height)
y (- (exwm-workspace--current-height) y (- (aref (elt exwm-workspace--workareas
(if exwm-workspace--struts exwm-workspace-current-index)
(+ (aref exwm-workspace--struts 2) 3)
(aref exwm-workspace--struts 3))
0)
height))) height)))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow
@ -753,38 +796,6 @@ The optional FORCE option is for internal use only."
:width (x-display-pixel-width) :width (x-display-pixel-width)
:height (x-display-pixel-height)))) :height (x-display-pixel-height))))
(defun exwm-workspace--set-workareas (&optional workareas)
"Set _NET_WORKAREA."
;; Calculate workareas if not present.
(unless workareas
(if (frame-parameter (car exwm-workspace--list) 'exwm-geometry)
;; Use the 'exwm-geometry' frame parameter if possible.
(dolist (f exwm-workspace--list)
(with-slots (x y width height) (frame-parameter f 'exwm-geometry)
(setq workareas (vconcat workareas (vector x y width height)))))
(let ((workarea (vector 0 0 (x-display-pixel-width)
(x-display-pixel-height))))
(dotimes (_ exwm-workspace-number)
(setq workareas (vconcat workareas workarea))))))
;; Exclude areas occupied by struts.
;; FIXME: RandR.
(when exwm-workspace--struts
(let ((dx (aref exwm-workspace--struts 0))
(dy (aref exwm-workspace--struts 2))
(dw (- (+ (aref exwm-workspace--struts 0)
(aref exwm-workspace--struts 1))))
(dh (- (+ (aref exwm-workspace--struts 2)
(aref exwm-workspace--struts 3)))))
(dotimes (i exwm-workspace-number)
(cl-incf (aref workareas (* i 4)) dx)
(cl-incf (aref workareas (+ (* i 4))) dy)
(cl-incf (aref workareas (+ (* i 4) 2)) dw)
(cl-incf (aref workareas (+ (* i 4) 3)) dh))))
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WORKAREA
:window exwm--root :data workareas))
(xcb:flush exwm--connection))
(defvar exwm-workspace--timer nil "Timer used to track echo area changes.") (defvar exwm-workspace--timer nil "Timer used to track echo area changes.")
(defun exwm-workspace--init () (defun exwm-workspace--init ()
@ -952,8 +963,8 @@ The optional FORCE option is for internal use only."
(make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT (make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT
:window exwm--root :window exwm--root
:data (make-vector (* 2 exwm-workspace-number) 0))) :data (make-vector (* 2 exwm-workspace-number) 0)))
;; Set _NET_WORKAREA. ;; Update and set _NET_WORKAREA.
(exwm-workspace--set-workareas) (exwm-workspace--update-workareas)
;; Set _NET_VIRTUAL_ROOTS (it's currently fixed.) ;; Set _NET_VIRTUAL_ROOTS (it's currently fixed.)
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_VIRTUAL_ROOTS (make-instance 'xcb:ewmh:set-_NET_VIRTUAL_ROOTS
@ -992,7 +1003,8 @@ The optional FORCE option is for internal use only."
;; Wait until all workspace frames are resized. ;; Wait until all workspace frames are resized.
(with-timeout (1) (with-timeout (1)
(while (< exwm-workspace--fullscreen-frame-count exwm-workspace-number) (while (< exwm-workspace--fullscreen-frame-count exwm-workspace-number)
(accept-process-output nil 0.1)))) (accept-process-output nil 0.1)))
(setq exwm-workspace--fullscreen-frame-count nil))

32
exwm.el
View file

@ -237,15 +237,19 @@
:window id))) :window id)))
(when reply (when reply
(setq struts (slot-value reply 'value)) (setq struts (slot-value reply 'value))
(if pair (if struts
(setcdr pair struts) (if pair
(push (cons id struts) exwm-workspace--id-struts-alist)) (setcdr pair struts)
(push (cons id struts) exwm-workspace--id-struts-alist))
(when pair
(setq exwm-workspace--id-struts-alist
(assq-delete-all id exwm-workspace--id-struts-alist))))
(exwm-workspace--update-struts)) (exwm-workspace--update-struts))
;; Update workareas and set _NET_WORKAREA.
(exwm-workspace--update-workareas)
;; Update workspaces. ;; Update workspaces.
(dolist (f exwm-workspace--list) (dolist (f exwm-workspace--list)
(exwm-workspace--set-fullscreen f)) (exwm-workspace--set-fullscreen f)))))
;; Update _NET_WORKAREA.
(exwm-workspace--set-workareas))))
(defun exwm--update-struts-partial (id) (defun exwm--update-struts-partial (id)
"Update _NET_WM_STRUT_PARTIAL." "Update _NET_WM_STRUT_PARTIAL."
@ -256,15 +260,19 @@
(when reply (when reply
(setq struts (slot-value reply 'value) (setq struts (slot-value reply 'value)
pair (assq id exwm-workspace--id-struts-alist)) pair (assq id exwm-workspace--id-struts-alist))
(if pair (if struts
(setcdr pair struts) (if pair
(push (cons id struts) exwm-workspace--id-struts-alist)) (setcdr pair struts)
(push (cons id struts) exwm-workspace--id-struts-alist))
(when pair
(setq exwm-workspace--id-struts-alist
(assq-delete-all id exwm-workspace--id-struts-alist))))
(exwm-workspace--update-struts)) (exwm-workspace--update-struts))
;; Update workareas and set _NET_WORKAREA.
(exwm-workspace--update-workareas)
;; Update workspaces. ;; Update workspaces.
(dolist (f exwm-workspace--list) (dolist (f exwm-workspace--list)
(exwm-workspace--set-fullscreen f)) (exwm-workspace--set-fullscreen f))))
;; Update _NET_WORKAREA.
(exwm-workspace--set-workareas)))
(defun exwm--update-struts (id) (defun exwm--update-struts (id)
"Update _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT." "Update _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT."