[elpa] externals/exwm 4ac71a7: Add RandR support for docks and reuse workareas

[Chris Feng]

branch: externals/exwm
commit 4ac71a7ddc78d1485a7fca7a8dbf4c4f6b4016f2
Author: Chris Feng <address@hidden>
Commit: Chris Feng <address@hidden>

    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.
---
 exwm-layout.el    |   14 ++--
 exwm-manage.el    |   10 +--
 exwm-randr.el     |   24 +++---
 exwm-workspace.el |  238 ++++++++++++++++++++++++++++-------------------------
 exwm.el           |   32 ++++---
 5 files changed, 170 insertions(+), 148 deletions(-)

diff --git a/exwm-layout.el b/exwm-layout.el
index b79e42e..85e186f 100644
--- a/exwm-layout.el
+++ b/exwm-layout.el
@@ -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
diff --git a/exwm-manage.el b/exwm-manage.el
index 3597822..18a6795 100644
--- a/exwm-manage.el
+++ b/exwm-manage.el
@@ -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
diff --git a/exwm-randr.el b/exwm-randr.el
index 9f6be78..85daff2 100644
--- a/exwm-randr.el
+++ b/exwm-randr.el
@@ -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))))
 
diff --git a/exwm-workspace.el b/exwm-workspace.el
index cfbe02a..6228d99 100644
--- a/exwm-workspace.el
+++ b/exwm-workspace.el
@@ -108,6 +108,16 @@ Value nil means to use the default position which is fixed 
at bottom, while
   "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."
   (let ((geometry (frame-parameter exwm-workspace--current 'exwm-geometry)))
@@ -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))
 
 
 
diff --git a/exwm.el b/exwm.el
index 59f4313..814104a 100644
--- a/exwm.el
+++ b/exwm.el
@@ -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."