about summary refs log tree commit diff
path: root/exwm-systemtray.el
diff options
context:
space:
mode:
Diffstat (limited to 'exwm-systemtray.el')
-rw-r--r--exwm-systemtray.el159
1 files changed, 116 insertions, 43 deletions
diff --git a/exwm-systemtray.el b/exwm-systemtray.el
index 43b3e1eaef41..776aced4c4f9 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