Add initial support for dock (panel) applications

* exwm-layout.el (exwm-layout--fullscreen-frame-count) (exwm-layout--set-frame-fullscreen): Moved to workspace module. * exwm-workspace.el (exwm-workspace--fullscreen-frame-count) (exwm-workspace--set-fullscreen): Moved from layout module. * exwm-manage.el (exwm-manage--manage-window): Update struts for dock applications. * exwm-workspace.el (exwm-workspace--strut) (exwm-workspace--strut-is-partial): New variables for storing struts. (exwm-workspace--resize-minibuffer-frame) (exwm-workspace--on-ConfigureNotify): Take struts into consideration. * exwm.el (exwm--update-strut-legacy, exwm--update-strut-partial) (exwm--update-strut): New functions for updating _NET_WM_STRUT or _NET_WM_STRUT_PARTIAL. (exwm--on-PropertyNotify): Update struts on corresponding event. (exwm--init-icccm-ewmh): Declare _NET_WM_STRUT and _NET_WM_STRUT_PARTIAL as supported. * exwm-workspace.el (exwm-workspace--update-workareas): Dedicated function for updating _NET_WORKAREA. * exwm-randr.el (exwm-randr--refresh): * exwm-workspace.el (exwm-workspace--init): Use `exwm-workspace--update-workareas'. * exwm.el (exwm--init-icccm-ewmh): Do not set _NET_WORKAREA here.
2016-07-12 18:35:51 +08:00 · 2016-07-12 18:35:51 +08:00 · 650ed0013c
commit 650ed0013c
parent 0863f41490
5 changed files with 163 additions and 61 deletions
--- a/exwm-layout.el
+++ b/exwm-layout.el
@ -213,34 +213,6 @@
    (setq exwm--fullscreen nil)
    (call-interactively #'exwm-input-grab-keyboard)))

-(defvar exwm-layout--fullscreen-frame-count 0
-  "Count the fullscreen workspace frames.")
-
-;; This function is superficially similar to `exwm-layout-set-fullscreen', but
-;; they do very different things: `exwm-layout--set-frame-fullscreen' resizes a
-;; frame to the actual monitor size, `exwm-layout-set-fullscreen' resizes an X
-;; window to the frame size.
-(defun exwm-layout--set-frame-fullscreen (frame)
-  "Make frame FRAME fullscreen, with regard to its RandR output if applicable."
-  (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))
-        (container (frame-parameter frame 'exwm-container))
-        (workspace (frame-parameter frame 'exwm-workspace)))
-    (with-slots (x y width height) geometry
-      (when (and (eq frame exwm-workspace--current)
-                 (exwm-workspace--minibuffer-own-frame-p))
-        (exwm-workspace--resize-minibuffer-frame width height))
-      (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)))
-  (cl-incf exwm-layout--fullscreen-frame-count))
-
 (defvar exwm-layout--other-buffer-exclude-exwm-mode-buffers nil
  "When non-nil, prevent EXWM buffers from being selected by `other-buffer'.")

--- a/exwm-manage.el
+++ b/exwm-manage.el
@ -79,6 +79,7 @@ corresponding buffer.")
 (declare-function exwm--update-hints "exwm.el" (id &optional force))
 (declare-function exwm--update-protocols "exwm.el" (id &optional force))
 (declare-function exwm--update-state "exwm.el" (id &optional force))
+(declare-function exwm--update-strut "exwm.el" (id))
 (declare-function exwm-floating--set-floating "exwm-floating.el" (id))
 (declare-function exwm-floating--unset-floating "exwm-floating.el" (id))

@ -120,11 +121,19 @@ corresponding buffer.")
                      (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG
                            exwm-window-type))))
        (exwm--log "No need to manage #x%x" id)
+        ;; Update struts.
+        (when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK exwm-window-type)
+          (exwm--update-strut id))
        ;; Remove all events
        (xcb:+request exwm--connection
            (make-instance 'xcb:ChangeWindowAttributes
                           :window id :value-mask xcb:CW:EventMask
-                           :event-mask xcb:EventMask:NoEvent))
+                           :event-mask
+                           (if (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK
+                                     exwm-window-type)
+                               ;; Listen for change of struts property of dock.
+                               xcb:EventMask:PropertyChange
+                             xcb:EventMask:NoEvent)))
        ;; The window needs to be mapped
        (xcb:+request exwm--connection
            (make-instance 'xcb:MapWindow :window id))
--- a/exwm-randr.el
+++ b/exwm-randr.el
@ -54,16 +54,18 @@
 (defvar exwm-randr-refresh-hook nil
  "Normal hook run when the RandR module just refreshed.")

-(defvar exwm-layout--fullscreen-frame-count)
+(defvar exwm-workspace--fullscreen-frame-count)
 (defvar exwm-workspace-number)
 (defvar exwm-workspace--list)

-(declare-function exwm-layout--set-frame-fullscreen "exwm-layout.el" (frame))
+(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
+(declare-function exwm-workspace--update-workareas "exwm-workspace.el"
+                  (&optional workareas))

 (defun exwm-randr--refresh ()
  "Refresh workspaces according to the updated RandR info."
  (let (output-name geometry output-plist default-geometry workareas
-                    workarea-offset viewports)
+                    viewports)
    ;; Query all outputs
    (with-slots (config-timestamp outputs)
        (xcb:+request-unchecked+reply exwm--connection
@ -93,10 +95,7 @@
                (setq default-geometry geometry)))))))
    (exwm--log "(randr) outputs: %s" output-plist)
    (when output-plist
-      (setq workarea-offset (if (exwm-workspace--minibuffer-own-frame-p)
-                                0
-                              (window-pixel-height (minibuffer-window))))
-      (setq exwm-layout--fullscreen-frame-count 0)
+      (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))
@ -106,16 +105,13 @@
                  output nil))
          (set-frame-parameter frame 'exwm-randr-output output)
          (set-frame-parameter frame 'exwm-geometry geometry)
-          (exwm-layout--set-frame-fullscreen frame)
+          (exwm-workspace--set-fullscreen frame)
          (with-slots (x y width height) geometry
            (setq workareas
-                  (nconc workareas (list x y width (- height
-                                                      workarea-offset)))
+                  (nconc workareas (list x y width height))
                  viewports (nconc viewports (list x y))))))
      ;; Update _NET_WORKAREA
-      (xcb:+request exwm--connection
-          (make-instance 'xcb:ewmh:set-_NET_WORKAREA
-                         :window exwm--root :data (vconcat workareas)))
+      (exwm-workspace--update-workareas (vconcat workareas))
      ;; Update _NET_DESKTOP_VIEWPORT
      (xcb:+request exwm--connection
          (make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT
--- a/exwm-workspace.el
+++ b/exwm-workspace.el
@ -128,6 +128,50 @@ Value nil means to use the default position which is fixed at bottom, while
  "Reports whether the minibuffer is displayed in its own frame."
  (memq exwm-workspace-minibuffer-position '(top bottom)))

+;; FIXME: RandR and multiple docks.
+(defvar exwm-workspace--strut nil "Areas occupied by struts.")
+(defvar exwm-workspace--strut-is-partial nil
+  "Whether the struts are from _NET_WM_STRUT_PARTIAL.")
+
+(defvar exwm-workspace--fullscreen-frame-count 0
+  "Count the fullscreen workspace frames.")
+
+(declare-function exwm-layout--resize-container "exwm-layout.el"
+                  (id container x y width height &optional container-only))
+
+(defun exwm-workspace--set-fullscreen (frame)
+  "Make frame FRAME fullscreen, with regard to its RandR output if applicable."
+  (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))
+        (container (frame-parameter frame 'exwm-container))
+        (workspace (frame-parameter frame 'exwm-workspace))
+        x* y* width* height*)
+    (with-slots (x y width height) geometry
+      (if exwm-workspace--strut
+          (setq x* (+ x (aref exwm-workspace--strut 0))
+                y* (+ y (aref exwm-workspace--strut 2))
+                width* (- width (aref exwm-workspace--strut 0)
+                          (aref exwm-workspace--strut 1))
+                height* (- height (aref exwm-workspace--strut 2)
+                           (aref exwm-workspace--strut 3)))
+        (setq x* x
+              y* y
+              width* width
+              height* height))
+      (when (and (eq frame exwm-workspace--current)
+                 (exwm-workspace--minibuffer-own-frame-p))
+        (exwm-workspace--resize-minibuffer-frame width* height*))
+      (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)))
+  (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.
@ -138,10 +182,19 @@ workspace frame."
  (let ((y (if (eq exwm-workspace-minibuffer-position 'top)
               0
             (- (or height (exwm-workspace--current-height))
+                (if exwm-workspace--strut
+                    (+ (aref exwm-workspace--strut 2)
+                       (aref exwm-workspace--strut 3))
+                  0)
                (frame-pixel-height exwm-workspace--minibuffer))))
-        (width (or width (exwm-workspace--current-width)))
        (container (frame-parameter exwm-workspace--minibuffer
                                    'exwm-container)))
+    (unless width
+      (setq width (exwm-workspace--current-width)))
+    (when exwm-workspace--strut
+      (setq width (- width
+                     (aref exwm-workspace--strut 0)
+                     (aref exwm-workspace--strut 1))))
    (xcb:+request exwm--connection
        (make-instance 'xcb:ConfigureWindow
                       :window container
@ -491,7 +544,12 @@ 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) height)))
+                y (- (exwm-workspace--current-height)
+                     (if exwm-workspace--strut
+                         (+ (aref exwm-workspace--strut 2)
+                            (aref exwm-workspace--strut 3))
+                       0)
+                     height)))
        (xcb:+request exwm--connection
            (make-instance 'xcb:ConfigureWindow
                           :window (frame-parameter exwm-workspace--minibuffer
@ -638,6 +696,38 @@ The optional FORCE option is for internal use only."
      (server-save-buffers-kill-terminal nil)
      nil)))

+(defun exwm-workspace--update-workareas (&optional workareas)
+  "Update _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--strut
+    (let ((dx (aref exwm-workspace--strut 0))
+          (dy (aref exwm-workspace--strut 2))
+          (dw (- (+ (aref exwm-workspace--strut 0)
+                    (aref exwm-workspace--strut 1))))
+          (dh (- (+ (aref exwm-workspace--strut 2)
+                    (aref exwm-workspace--strut 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 ()
@ -794,6 +884,8 @@ The optional FORCE option is for internal use only."
  (xcb:flush exwm--connection)
  ;; We have to advice `x-create-frame' or every call to it would hang EXWM
  (advice-add 'x-create-frame :around #'exwm-workspace--x-create-frame)
+  ;; Set _NET_WORKAREA.
+  (exwm-workspace--update-workareas)
  ;; Set _NET_VIRTUAL_ROOTS
  (xcb:+request exwm--connection
      (make-instance 'xcb:ewmh:set-_NET_VIRTUAL_ROOTS
@ -824,8 +916,6 @@ The optional FORCE option is for internal use only."
  (remove-hook 'focus-in-hook #'exwm-workspace--on-focus-in)
  (advice-remove 'x-create-frame #'exwm-workspace--x-create-frame))

-(defvar exwm-layout--fullscreen-frame-count)
-
 (defun exwm-workspace--post-init ()
  "The second stage in the initialization of the workspace module."
  ;; Make the workspaces fullscreen.
@ -833,7 +923,7 @@ The optional FORCE option is for internal use only."
    (set-frame-parameter i 'fullscreen 'fullboth))
  ;; Wait until all workspace frames are resized.
  (with-timeout (1)
-    (while (< exwm-layout--fullscreen-frame-count exwm-workspace-number)
+    (while (< exwm-workspace--fullscreen-frame-count exwm-workspace-number)
      (accept-process-output nil 0.1))))


--- a/exwm.el
+++ b/exwm.el
@ -236,6 +236,46 @@
                               ;; Default to normal state
                               xcb:icccm:WM_STATE:NormalState)))))))

+(defun exwm--update-strut-legacy (id)
+  "Update _NET_WM_STRUT."
+  (unless exwm-workspace--strut-is-partial
+    (let ((reply (xcb:+request-unchecked+reply exwm--connection
+                     (make-instance 'xcb:ewmh:get-_NET_WM_STRUT
+                                    :window id))))
+      (setq exwm-workspace--strut (when reply (slot-value reply 'value)))
+      ;; Update workspaces.
+      (dolist (f exwm-workspace--list)
+        (exwm-workspace--set-fullscreen f))
+      ;; Resize the minibuffer frame.
+      (when (exwm-workspace--minibuffer-own-frame-p)
+        (exwm-workspace--resize-minibuffer-frame))
+      ;; Update _NET_WORKAREA.
+      (exwm-workspace--update-workareas))))
+
+(defun exwm--update-strut-partial (id)
+  "Update _NET_WM_STRUT_PARTIAL."
+  (let ((reply (xcb:+request-unchecked+reply exwm--connection
+                   (make-instance 'xcb:ewmh:get-_NET_WM_STRUT_PARTIAL
+                                  :window id))))
+    (setq exwm-workspace--strut (when reply (slot-value reply 'value)))
+    (if (not exwm-workspace--strut)
+        (setq exwm-workspace--strut-is-partial nil)
+      (setq exwm-workspace--strut (substring exwm-workspace--strut 0 4))
+      (setq exwm-workspace--strut-is-partial t))
+    ;; Update workspaces.
+    (dolist (f exwm-workspace--list)
+      (exwm-workspace--set-fullscreen f))
+    ;; Resize the minibuffer frame.
+    (when (exwm-workspace--minibuffer-own-frame-p)
+      (exwm-workspace--resize-minibuffer-frame))
+    ;; Update _NET_WORKAREA.
+    (exwm-workspace--update-workareas)))
+
+(defun exwm--update-strut (id)
+  "Update _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT."
+  (exwm--update-strut-partial id)
+  (exwm--update-strut-legacy id))
+
 (defun exwm--on-PropertyNotify (data _synthetic)
  "Handle PropertyNotify event."
  (let ((obj (make-instance 'xcb:PropertyNotify))
@ -245,7 +285,12 @@
          atom (slot-value obj 'atom)
          exwm-input--timestamp (slot-value obj 'time))
    (setq buffer (exwm--id->buffer id))
-    (when (buffer-live-p buffer)
+    (if (not (buffer-live-p buffer))
+        ;; Properties of unmanaged X windows.
+        (cond ((= atom xcb:Atom:_NET_WM_STRUT)
+               (exwm--update-strut-legacy id))
+              ((= atom xcb:Atom:_NET_WM_STRUT_PARTIAL)
+               (exwm--update-strut-partial id)))
      (with-current-buffer buffer
        (cond ((= atom xcb:Atom:_NET_WM_WINDOW_TYPE)
               (exwm--update-window-type id t))
@ -326,7 +371,7 @@
                   (= action xcb:ewmh:_NET_WM_STATE_ADD))
          (dolist (f exwm-workspace--list)
            (when (equal (frame-parameter f 'exwm-outer-id) id)
-              (exwm-layout--set-frame-fullscreen f)
+              (exwm-workspace--set-fullscreen f)
              (xcb:+request
                  exwm--connection
                  (make-instance 'xcb:ewmh:set-_NET_WM_STATE
@ -410,6 +455,8 @@
                                   xcb:Atom:_NET_REQUEST_FRAME_EXTENTS
                                   xcb:Atom:_NET_FRAME_EXTENTS
                                   xcb:Atom:_NET_WM_NAME
+                                   xcb:Atom:_NET_WM_STRUT
+                                   xcb:Atom:_NET_WM_STRUT_PARTIAL
                                   ;;
                                   xcb:Atom:_NET_WM_WINDOW_TYPE
                                   xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLBAR
@ -458,18 +505,6 @@
      (make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT
                     :window exwm--root
                     :data (make-vector (* 2 exwm-workspace-number) 0)))
-  ;; Set _NET_WORKAREA (with minibuffer excluded)
-  (let* ((workareas
-          (vector 0 0 (x-display-pixel-width)
-                  (- (x-display-pixel-height)
-                     (if (exwm-workspace--minibuffer-own-frame-p)
-                         0
-                       (window-pixel-height (minibuffer-window))))))
-         (workareas (mapconcat (lambda (_) workareas)
-                               (make-list exwm-workspace-number 0) [])))
-    (xcb:+request exwm--connection
-        (make-instance 'xcb:ewmh:set-_NET_WORKAREA
-                       :window exwm--root :data workareas)))
  (xcb:flush exwm--connection))

 (defvar exwm-init-hook nil