From 4ac71a7ddc78d1485a7fca7a8dbf4c4f6b4016f2 Mon Sep 17 00:00:00 2001
From: Chris Feng <chris.w.feng@gmail.com>
Date: Sat, 16 Jul 2016 14:34:57 +0800
Subject: 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-workspace.el | 238 ++++++++++++++++++++++++++++--------------------------
 1 file changed, 125 insertions(+), 113 deletions(-)

(limited to 'exwm-workspace.el')

diff --git a/exwm-workspace.el b/exwm-workspace.el
index cfbe02afd2..6228d99bbd 100644
--- a/exwm-workspace.el
+++ b/exwm-workspace.el
@@ -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))
 
 
 
-- 
cgit 1.4.1