[elpa] externals/exwm b8d621041a 1/7: Use default visual, depth and colormap in systray embedder window

[Adrián Medraño Calvo]

branch: externals/exwm
commit b8d621041ade27480124c920d38673a21491e8a4
Author: Adrián Medraño Calvo <adrian@medranocalvo.com>
Commit: Adrián Medraño Calvo <adrian@medranocalvo.com>

    Use default visual, depth and colormap in systray embedder window
    
    We were using the Emacs' frame's depth, but not the visual nor colormap.
    This failed with Emacs 29 and its support for 32-bit depths.
    
    We now use the default screen's visual: using a non-default visual in
    the system tray requires support for embedding icons with different
    visuals, which is not implemented.  We restrict our limited transparency
    support to Emacs frames with depth equal to the default visual's detph.
    
    * exwm-core.el (exwm--get-visual-depth-colormap): New function.
    * exwm-systemtray.el (exwm-systemtray--init): Use root window's
    visual, depth and colormap. Reset all attributes that refer
    (perhaps due to defaults) to the parent window, as it might have a
    different visual, depth or colormap.
    (exwm-systemtray--init): Set _NET_SYSTEM_TRAY_VISUAL.
    (exwm-systemtray-background-color): Emit a warning when
    transparency is selected but not supported.
    (exwm-systemtray--set-background-color): New function to set
    embedder window background.
    (exwm-systemtray--embedder-window-depth): Add variable.
    (exwm-systemtray--transparency-supported-p): New function to check
    whether transparency is supported.
---
 exwm-systemtray.el | 159 ++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 116 insertions(+), 43 deletions(-)

diff --git a/exwm-systemtray.el b/exwm-systemtray.el
index 43b3e1eaef..776aced4c4 100644
--- a/exwm-systemtray.el
+++ b/exwm-systemtray.el
@@ -67,44 +67,51 @@ You shall use the default value if using auto-hide 
minibuffer."
   "Gap between icons."
   :type 'integer)
 
+(defvar exwm-systemtray--connection nil "The X connection.")
+
 (defvar exwm-systemtray--embedder-window nil "The embedder window.")
+(defvar exwm-systemtray--embedder-window-depth nil
+  "The embedder window's depth.")
 
-(defcustom exwm-systemtray-background-color nil
+(defcustom exwm-systemtray-background-color
+  (if (exwm-systemtray--transparency-supported-p)
+      "black"
+    'transparent)
   "Background color of systemtray.
-
-This should be a color, or nil for transparent background."
-  :type '(choice (const :tag "Transparent" nil)
+This should be a color, the symbol `workspace-background' for the background
+color of current workspace frame, or the symbol `transparent' for transparent
+background.
+
+Transparent background is not yet supported when Emacs uses 32-bit depth
+visual, as reported by `x-display-planes'.  The X resource \"Emacs.visualClass:
+TrueColor-24\" can be used to force Emacs to use 24-bit depth."
+  :type '(choice (const :tag "Transparent" 'transparent)
                  (color))
   :initialize #'custom-initialize-default
   :set (lambda (symbol value)
+         (when (and (eq value 'transparent)
+                    (not (exwm-systemtray--transparency-supported-p)))
+           (display-warning 'exwm-systemtray
+                            "Transparent background is not supported yet when \
+using 32-bit depth.  Using black instead.")
+           (setq value "black"))
          (set-default symbol value)
-         ;; Change the background color for embedder.
-         (when (and exwm--connection
+         (when (and exwm-systemtray--connection
                     exwm-systemtray--embedder-window)
-           (let ((background-pixel (exwm--color->pixel value)))
-             (xcb:+request exwm--connection
-                 (make-instance 'xcb:ChangeWindowAttributes
-                                :window exwm-systemtray--embedder-window
-                                :value-mask (logior xcb:CW:BackPixmap
-                                                    (if background-pixel
-                                                        xcb:CW:BackPixel 0))
-                                :background-pixmap
-                                xcb:BackPixmap:ParentRelative
-                                :background-pixel background-pixel))
-             ;; Unmap & map to take effect immediately.
-             (xcb:+request exwm--connection
-                 (make-instance 'xcb:UnmapWindow
-                                :window exwm-systemtray--embedder-window))
-             (xcb:+request exwm--connection
-                 (make-instance 'xcb:MapWindow
-                                :window exwm-systemtray--embedder-window))
-             (xcb:flush exwm--connection)))))
+           ;; Change the background color for embedder.
+           (exwm-systemtray--set-background-color)
+           ;; Unmap & map to take effect immediately.
+           (xcb:+request exwm-systemtray--connection
+                         (make-instance 'xcb:UnmapWindow
+                                        :window 
exwm-systemtray--embedder-window))
+           (xcb:+request exwm-systemtray--connection
+                         (make-instance 'xcb:MapWindow
+                                        :window 
exwm-systemtray--embedder-window))
+           (xcb:flush exwm-systemtray--connection))))
 
 ;; GTK icons require at least 16 pixels to show normally.
 (defconst exwm-systemtray--icon-min-size 16 "Minimum icon size.")
 
-(defvar exwm-systemtray--connection nil "The X connection.")
-
 (defvar exwm-systemtray--list nil "The icon list.")
 
 (defvar exwm-systemtray--selection-owner-window nil
@@ -249,6 +256,61 @@ This should be a color, or nil for transparent background."
                          :window exwm-systemtray--embedder-window))))
   (xcb:flush exwm-systemtray--connection))
 
+(defun exwm-systemtray--set-background-color ()
+  "Change the background color of the embedder.
+The color is set according to `exwm-systemtray-background-color'.
+
+Note that this function does not change the current contents of the embedder
+window; unmap & map are necessary for the background color to take effect."
+  (when (and exwm-systemtray--connection
+             exwm-systemtray--embedder-window)
+    (let* ((color (cl-case exwm-systemtray-background-color
+                    ((transparent nil) ; nil means transparent as well
+                     (if (exwm-systemtray--transparency-supported-p)
+                         nil
+                       (message "%s" "[EXWM] system tray does not support 
transparent background; using black instead")
+                       "black"))
+                    (t exwm-systemtray-background-color)))
+           (background-pixel (exwm--color->pixel color)))
+      (xcb:+request exwm-systemtray--connection
+                    (make-instance 'xcb:ChangeWindowAttributes
+                                   :window exwm-systemtray--embedder-window
+                                   ;; Either-or.  A `background-pixel' of nil
+                                   ;; means simulate transparency.  We use
+                                   ;; `xcb:CW:BackPixmap' together with
+                                   ;; `xcb:BackPixmap:ParentRelative' do that,
+                                   ;; but this only works when the parent
+                                   ;; window's visual (Emacs') has the same
+                                   ;; visual depth.
+                                   :value-mask (if background-pixel
+                                                   xcb:CW:BackPixel
+                                                 xcb:CW:BackPixmap)
+                                   ;; Due to the :value-mask above,
+                                   ;; :background-pixmap only takes effect when
+                                   ;; `transparent' is requested and supported
+                                   ;; (visual depth of Emacs and of system tray
+                                   ;; are equal).  Setting
+                                   ;; `xcb:BackPixmap:ParentRelative' when
+                                   ;; that's not the case would produce an
+                                   ;; `xcb:Match' error.
+                                   :background-pixmap 
xcb:BackPixmap:ParentRelative
+                                   :background-pixel background-pixel)))))
+
+(defun exwm-systemtray--transparency-supported-p ()
+  "Check whether transparent background is supported.
+EXWM system tray supports transparency when the visual depth of the system tray
+window matches that of Emacs.  The visual depth of the system tray window is 
the
+default visual depth of the display.
+
+Sections \"Visual and background pixmap handling\" and
+\"_NET_SYSTEM_TRAY_VISUAL\" of the System Tray Protocol Specification
+\(https://specifications.freedesktop.org/systemtray-spec/systemtray-spec-latest.html#visuals)
+indicate how to support actual transparency."
+  (let ((planes (x-display-planes)))
+    (if exwm-systemtray--embedder-window-depth
+        (= planes exwm-systemtray--embedder-window-depth)
+      (<= planes 24))))
+
 (defun exwm-systemtray--on-DestroyNotify (data _synthetic)
   "Unembed icons on DestroyNotify."
   (exwm--log)
@@ -469,8 +531,7 @@ This should be a color, or nil for transparent background."
                        :data xcb:systemtray:ORIENTATION:HORZ)))
   ;; Create the embedder.
   (let ((id (xcb:generate-id exwm-systemtray--connection))
-        (background-pixel (exwm--color->pixel 
exwm-systemtray-background-color))
-        frame parent depth y)
+        frame parent embedder-depth embedder-visual embedder-colormap y)
     (setq exwm-systemtray--embedder-window id)
     (if (exwm-workspace--minibuffer-own-frame-p)
         (setq frame exwm-workspace--minibuffer
@@ -487,15 +548,21 @@ This should be a color, or nil for transparent 
background."
                       3)
                  exwm-workspace--frame-y-offset
                  exwm-systemtray-height)))
-    (setq parent (string-to-number (frame-parameter frame 'window-id))
-          depth (slot-value (xcb:+request-unchecked+reply
-                                exwm-systemtray--connection
-                                (make-instance 'xcb:GetGeometry
-                                               :drawable parent))
-                            'depth))
+    (setq parent (string-to-number (frame-parameter frame 'window-id)))
+    ;; Use default depth, visual and colormap (from root window), instead of
+    ;; Emacs frame's.  See Section "Visual and background pixmap handling" in
+    ;; "System Tray Protocol Specification 0.3".
+    (let* ((vdc (exwm--get-visual-depth-colormap exwm-systemtray--connection
+                                                 exwm--root)))
+      (setq embedder-visual (car vdc))
+      (setq embedder-depth (cadr vdc))
+      (setq embedder-colormap (caddr vdc)))
+    ;; Note down the embedder window's depth.  It will be used to check whether
+    ;; we can use xcb:BackPixmap:ParentRelative to emulate transparency.
+    (setq exwm-systemtray--embedder-window-depth embedder-depth)
     (xcb:+request exwm-systemtray--connection
         (make-instance 'xcb:CreateWindow
-                       :depth depth
+                       :depth embedder-depth
                        :wid id
                        :parent parent
                        :x 0
@@ -504,19 +571,24 @@ This should be a color, or nil for transparent 
background."
                        :height exwm-systemtray-height
                        :border-width 0
                        :class xcb:WindowClass:InputOutput
-                       :visual 0
-                       :value-mask (logior xcb:CW:BackPixmap
-                                           (if background-pixel
-                                               xcb:CW:BackPixel 0)
+                       :visual embedder-visual
+                       :colormap embedder-colormap
+                       :value-mask (logior xcb:CW:BorderPixel
+                                           xcb:CW:Colormap
                                            xcb:CW:EventMask)
-                       :background-pixmap xcb:BackPixmap:ParentRelative
-                       :background-pixel background-pixel
+                       :border-pixel 0
                        :event-mask xcb:EventMask:SubstructureNotify))
+    (exwm-systemtray--set-background-color)
     ;; Set _NET_WM_NAME.
     (xcb:+request exwm-systemtray--connection
         (make-instance 'xcb:ewmh:set-_NET_WM_NAME
                        :window id
-                       :data "EXWM: exwm-systemtray--embedder-window")))
+                       :data "EXWM: exwm-systemtray--embedder-window"))
+    ;; Set _NET_SYSTEM_TRAY_VISUAL.
+    (xcb:+request exwm-systemtray--connection
+        (make-instance 'xcb:xembed:set-_NET_SYSTEM_TRAY_VISUAL
+                       :window exwm-systemtray--selection-owner-window
+                       :data embedder-visual)))
   (xcb:flush exwm-systemtray--connection)
   ;; Attach event listeners.
   (xcb:+event exwm-systemtray--connection 'xcb:DestroyNotify
@@ -564,7 +636,8 @@ This should be a color, or nil for transparent background."
     (setq exwm-systemtray--connection nil
           exwm-systemtray--list nil
           exwm-systemtray--selection-owner-window nil
-          exwm-systemtray--embedder-window nil)
+          exwm-systemtray--embedder-window nil
+          exwm-systemtray--embedder-window-depth nil)
     (remove-hook 'exwm-workspace-switch-hook
                  #'exwm-systemtray--on-workspace-switch)
     (remove-hook 'exwm-workspace--update-workareas-hook