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--list)
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el"
(frame &optional no-struts container-only))
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
;;;###autoload
(defun exwm-layout-set-fullscreen (&optional id)
@ -165,15 +164,20 @@
(with-current-buffer (if id (exwm--id->buffer id) (window-buffer))
(when exwm--fullscreen
(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
(let* ((geometry (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry
:drawable exwm--container))))
(setq exwm--floating-frame-position
(vector (slot-value geometry 'x) (slot-value geometry 'y)))))
;; Expand the workspace frame & its container to fill the whole screen.
(exwm-workspace--set-fullscreen exwm--frame t t)
;; Expand the workspace to fill the whole screen.
(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).
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow

View file

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

View file

@ -58,15 +58,13 @@
(defvar exwm-workspace-number)
(defvar exwm-workspace--list)
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el"
(frame &optional no-struts container-only))
(declare-function exwm-workspace--set-workareas "exwm-workspace.el"
(&optional workareas))
(declare-function exwm-workspace--update-workareas "exwm-workspace.el" ())
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
(declare-function exwm-workspace--set-desktop-geometry "exwm-workspace.el" ())
(defun exwm-randr--refresh ()
"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
(with-slots (config-timestamp outputs)
(xcb:+request-unchecked+reply exwm--connection
@ -96,7 +94,9 @@
(setq default-geometry geometry)))))))
(exwm--log "(randr) outputs: %s" 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)
(let* ((output (plist-get exwm-randr-workspace-output-plist i))
(geometry (lax-plist-get output-plist output))
@ -105,14 +105,14 @@
(setq geometry default-geometry
output nil))
(set-frame-parameter frame 'exwm-randr-output output)
(set-frame-parameter frame 'exwm-geometry geometry)
(exwm-workspace--set-fullscreen frame)
(with-slots (x y width height) geometry
(setq workareas (nconc workareas (list x y width height))))))
(set-frame-parameter frame 'exwm-geometry geometry)))
;; Update workareas and set _NET_WORKAREA.
(exwm-workspace--update-workareas)
;; Resize workspace.
(dolist (f exwm-workspace--list)
(exwm-workspace--set-fullscreen f))
;; Set _NET_DESKTOP_GEOMETRY.
(exwm-workspace--set-desktop-geometry)
;; Set _NET_WORKAREA.
(exwm-workspace--set-workareas (vconcat workareas))
(xcb:flush exwm--connection)
(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
"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
(defun exwm-workspace--current-width ()
"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 ()
"Update `exwm-workspace--struts'."
(let ((left 0)
(right 0)
(top 0)
(bottom 0)
struts)
(setq exwm-workspace--struts nil)
(let (struts struts*)
(dolist (pair exwm-workspace--id-struts-alist)
(setq struts (cdr pair))
(when struts
(when (< left (aref struts 0))
(setq left (aref struts 0)))
(when (< right (aref struts 1))
(setq right (aref struts 1)))
(when (< top (aref struts 2))
(setq top (aref struts 2)))
(when (< bottom (aref struts 3))
(setq bottom (aref struts 3)))))
(setq exwm-workspace--struts (vector left right top bottom))
(when (equal exwm-workspace--struts [0 0 0 0])
(setq exwm-workspace--struts nil))))
(dotimes (i 4)
(when (/= 0 (aref struts i))
(setq struts*
(vector (aref [left right top bottom] i)
(aref struts i)
(when (= 12 (length struts))
(substring struts (+ 4 (* i 2)) (+ 6 (* i 2))))))
(if (= 0 (mod i 2))
;; Make left/top processed first.
(push struts* exwm-workspace--struts)
(setq exwm-workspace--struts
(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
"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"
(id container x y width height &optional container-only))
(defun exwm-workspace--set-fullscreen (frame &optional no-struts
container-only)
"Make frame FRAME fullscreen, with regard to its RandR output if applicable.
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))))
(defun exwm-workspace--set-fullscreen (frame)
"Make frame FRAME fullscreen according to `exwm-workspace--workareas'."
(let ((workarea (elt exwm-workspace--workareas
(cl-position frame exwm-workspace--list)))
(id (frame-parameter frame 'exwm-outer-id))
(container (frame-parameter frame 'exwm-container))
(workspace (frame-parameter frame 'exwm-workspace))
x* y* width* height*)
(with-slots (x y width height) geometry
(if (and exwm-workspace--struts (not no-struts))
(setq x* (+ x (aref exwm-workspace--struts 0))
y* (+ y (aref exwm-workspace--struts 2))
width* (- width (aref exwm-workspace--struts 0)
(aref exwm-workspace--struts 1))
height* (- height (aref exwm-workspace--struts 2)
(aref exwm-workspace--struts 3)))
(setq x* x
y* y
width* width
height* height))
(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
x y width height)
(setq x (aref workarea 0)
y (aref workarea 1)
width (aref workarea 2)
height (aref workarea 3))
(when (and (eq frame exwm-workspace--current)
(exwm-workspace--minibuffer-own-frame-p))
(exwm-workspace--resize-minibuffer-frame))
(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))
;; This is only used for workspace initialization.
(when exwm-workspace--fullscreen-frame-count
(cl-incf exwm-workspace--fullscreen-frame-count)))
;;;###autoload
(defun exwm-workspace--resize-minibuffer-frame (&optional width height)
"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."
(defun exwm-workspace--resize-minibuffer-frame ()
"Resize minibuffer (and its container) to fit the size of workspace."
(cl-assert (exwm-workspace--minibuffer-own-frame-p))
(let ((y (if (eq exwm-workspace-minibuffer-position 'top)
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))))
(let ((workarea (elt exwm-workspace--workareas exwm-workspace-current-index))
(container (frame-parameter exwm-workspace--minibuffer
'exwm-container)))
(unless width
(setq width (exwm-workspace--current-width)))
(when exwm-workspace--struts
(setq width (- width
(aref exwm-workspace--struts 0)
(aref exwm-workspace--struts 1))))
'exwm-container))
y width)
(setq y (if (eq exwm-workspace-minibuffer-position 'top)
0
(- (aref workarea 3)
(frame-pixel-height exwm-workspace--minibuffer)))
width (aref workarea 2))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window container
@ -592,11 +637,9 @@ The optional FORCE option is for internal use only."
(setq value-mask xcb:ConfigWindow:Height
y 0)
(setq value-mask (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height)
y (- (exwm-workspace--current-height)
(if exwm-workspace--struts
(+ (aref exwm-workspace--struts 2)
(aref exwm-workspace--struts 3))
0)
y (- (aref (elt exwm-workspace--workareas
exwm-workspace-current-index)
3)
height)))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
@ -753,38 +796,6 @@ The optional FORCE option is for internal use only."
:width (x-display-pixel-width)
: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.")
(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
:window exwm--root
:data (make-vector (* 2 exwm-workspace-number) 0)))
;; Set _NET_WORKAREA.
(exwm-workspace--set-workareas)
;; Update and set _NET_WORKAREA.
(exwm-workspace--update-workareas)
;; Set _NET_VIRTUAL_ROOTS (it's currently fixed.)
(xcb:+request exwm--connection
(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.
(with-timeout (1)
(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)))
(when reply
(setq struts (slot-value reply 'value))
(if pair
(setcdr pair struts)
(push (cons id struts) exwm-workspace--id-struts-alist))
(if struts
(if pair
(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))
;; Update workareas and set _NET_WORKAREA.
(exwm-workspace--update-workareas)
;; Update workspaces.
(dolist (f exwm-workspace--list)
(exwm-workspace--set-fullscreen f))
;; Update _NET_WORKAREA.
(exwm-workspace--set-workareas))))
(exwm-workspace--set-fullscreen f)))))
(defun exwm--update-struts-partial (id)
"Update _NET_WM_STRUT_PARTIAL."
@ -256,15 +260,19 @@
(when reply
(setq struts (slot-value reply 'value)
pair (assq id exwm-workspace--id-struts-alist))
(if pair
(setcdr pair struts)
(push (cons id struts) exwm-workspace--id-struts-alist))
(if struts
(if pair
(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))
;; Update workareas and set _NET_WORKAREA.
(exwm-workspace--update-workareas)
;; Update workspaces.
(dolist (f exwm-workspace--list)
(exwm-workspace--set-fullscreen f))
;; Update _NET_WORKAREA.
(exwm-workspace--set-workareas)))
(exwm-workspace--set-fullscreen f))))
(defun exwm--update-struts (id)
"Update _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT."