Implement the XSETTINGS protocol

Users can use this to configure system-wide themes, icons, fonts, etc.

* exwm-xsettings.el: Implement the XSETTINGS protocol (fixes
https://github.com/ch11ng/exwm/issues/876)

1 files changed, 400 insertions, 0 deletions

diff --git a/exwm-xsettings.el b/exwm-xsettings.el
new file mode 100644
index 000000000000..4eac557b9aa6
--- /dev/null
+++ b/exwm-xsettings.el
@@ -0,0 +1,400 @@
+;;; exwm-xsettings.el --- XSETTINGS Module for EXWM -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022-2024 Free Software Foundation, Inc.
+
+;; Author: Steven Allen <steven@stebalien.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Implements the XSETTINGS protocol, allowing Emacs to manage the system theme,
+;; fonts, icons, etc.
+;;
+;; This package can be configured as follows:
+;;
+;;   (require 'exwm-xsettings)
+;;   (setq exwm-xsettings-theme '("Adwaita" . "Adwaita-dark") ;; light/dark
+;;         exwm-xsettings `(("Xft/HintStyle" . "hintslight")
+;;                          ("Xft/RGBA" . "rgb")
+;;                          ("Xft/lcdfilter" . "lcddefault")
+;;                          ("Xft/Antialias" . 1)
+;;                          ;; DPI is in 1024ths of an inch, so this is a DPI of
+;;                          ;; 144, equivalent to ;; a scaling factor of 1.5
+;;                          ;; (144 = 1.5 * 96).
+;;                          ("Xft/DPI" . ,(* 144 1024))
+;;                          ("Xft/Hinting" . 1)))
+;;   (exwm-xsettings-enable)
+;;
+;; To modify these settings at runtime, customize them with
+;; `custom-set-variables' or `setopt' (Emacs 29+). E.g., the following will
+;; immediately change the icon theme to "Papirus" at runtime, even in running
+;; applications:
+;;
+;;   (setopt exwm-xsettings-icon-theme "Papirus")
+
+;;; Code:
+
+(require 'xcb-ewmh)
+(require 'xcb-icccm)
+
+(require 'exwm-core)
+
+(defvar exwm-xsettings--connection nil)
+(defvar exwm-xsettings--XSETTINGS_SETTINGS-atom nil)
+(defvar exwm-xsettings--XSETTINGS_S0-atom nil)
+(defvar exwm-xsettings--selection-owner-window nil)
+
+(defun exwm-xsettings--rgba-match (_widget value)
+  "Return t if VALUE is a valid RGBA color."
+  (and (numberp value) (<= 0 value 1)))
+
+(defun exwm-xsettings--custom-set (symbol value)
+  "Setter used by `exwm-xsettings' customization options.
+
+SYMBOL is the setting being updated and VALUE is the new value."
+  (set-default-toplevel-value symbol value)
+  (exwm-xsettings--update-settings))
+
+(defcustom exwm-xsettings nil
+  "Custom XSETTINGS.
+These settings take precedence over `exwm-xsettings-theme' and
+`exwm-xsettings-icon-theme'."
+  :group 'exwm
+  :type '(alist :key-type (string :tag "Name")
+                :value-type (choice :tag "Value"
+                              (string :tag "String")
+                              (integer :tag "Integer")
+                              (list :tag "Color"
+                                (number :tag "Red"
+                                        :type-error
+                                        "This field should contain a number between 0 and 1."
+                                       :match exwm-xsettings--rgba-match)
+                                (number :tag "Green"
+                                        :type-error
+                                        "This field should contain a number between 0 and 1."
+                                       :match exwm-xsettings--rgba-match)
+                                (number :tag "Blue"
+                                        :type-error
+                                        "This field should contain a number between 0 and 1."
+                                       :match exwm-xsettings--rgba-match)
+                                (number :tag "Alpha"
+                                        :type-error
+                                        "This field should contain a number between 0 and 1."
+                                       :match exwm-xsettings--rgba-match
+                                       :value 1.0))))
+  :initialize #'custom-initialize-default
+  :set #'exwm-xsettings--custom-set)
+
+(defcustom exwm-xsettings-theme nil
+  "The system-wide theme."
+  :group 'exwm
+  :type '(choice (string :tag "Theme")
+                 (cons (string :tag "Light Theme")
+                       (string :tag "Dark Theme")))
+  :initialize #'custom-initialize-default
+  :set #'exwm-xsettings--custom-set)
+
+(defcustom exwm-xsettings-icon-theme nil
+  "The system-wide icon theme."
+  :group 'exwm
+  :type '(choice (string :tag "Icon Theme")
+                 (cons (string :tag "Light Icon Theme")
+                       (string :tag "Dark Icon Theme")))
+  :initialize #'custom-initialize-default
+  :set #'exwm-xsettings--custom-set)
+
+(defvar exwm-xsettings--serial 0)
+
+(defconst xcb:xsettings:-Type:Integer 0)
+(defconst xcb:xsettings:-Type:String 1)
+(defconst xcb:xsettings:-Type:Color 2)
+
+(defclass xcb:xsettings:-Settings
+  (xcb:-struct)
+  ((byte-order :initarg :byte-order :type xcb:CARD8)
+   (pad~0 :initform 3 :type xcb:-pad)
+   (serial :initarg :serial :type xcb:CARD32)
+   (settings-len :initarg :settings-len :type xcb:CARD32)
+   (settings~ :initform
+     '(name settings type xcb:xsettings:-SETTING size
+            (xcb:-fieldref 'settings-len))
+     :type xcb:-list)
+   (settings :initarg :settings :type xcb:-ignore)))
+
+(defclass xcb:xsettings:-SETTING
+  (xcb:-struct)
+  ((type :initarg :type :type xcb:CARD8)
+   (pad~0 :initform 1 :type xcb:-pad)
+   (name-len :initarg :name-len :type xcb:CARD16)
+   (name~ :initform
+     '(name name type xcb:char size
+            (xcb:-fieldref 'name-len))
+     :type xcb:-list)
+   (name :initarg :name :type xcb:-ignore)
+   (pad~1 :initform 4 :type xcb:-pad-align)
+   (last-change-serial :initarg :last-change-serial :type xcb:CARD32)))
+
+(defclass xcb:xsettings:-SETTING_INTEGER
+  (xcb:xsettings:-SETTING)
+  ((type :initform 'xcb:xsettings:-Type:Integer)
+   (value :initarg :value :type xcb:INT32)))
+
+(defclass xcb:xsettings:-SETTING_STRING
+  (xcb:xsettings:-SETTING)
+  ((type :initform 'xcb:xsettings:-Type:String)
+   (value-len :initarg :value-len :type xcb:CARD32)
+   (value~ :initform
+     '(name value type xcb:char size
+            (xcb:-fieldref 'value-len))
+     :type xcb:-list)
+   (value :initarg :value :type xcb:-ignore)
+   (pad~2 :initform 4 :type xcb:-pad-align)))
+
+(defclass xcb:xsettings:-SETTING_COLOR
+  (xcb:xsettings:-SETTING)
+  ((type :initform 'xcb:xsettings:-Type:Color)
+   (red :initarg :red :type xcb:CARD16)
+   (green :initarg :green :type xcb:CARD16)
+   (blue :initarg :blue :type xcb:CARD16)
+   (alpha :initarg :alpha :initform #xffff :type xcb:CARD16)))
+
+(defclass xcb:xsettings:-ClientMessage
+  (xcb:icccm:--ClientMessage xcb:ClientMessage)
+  ((format :initform 32)
+   (type :initform 'xcb:Atom:MANAGER)
+   (time :initarg :time :type xcb:TIMESTAMP)      ;new slot
+   (selection :initarg :selection :type xcb:ATOM) ;new slot
+   (owner :initarg :owner :type xcb:WINDOW))      ;new slot
+  :documentation "An XSETTINGS client message.")
+
+(defalias 'exwm-xsettings--color-dark-p
+  (if (eval-when-compile (< emacs-major-version 29))
+      ;; Borrowed from Emacs 29.
+      (lambda (rgb)
+        "Whether RGB is more readable against white than black."
+        (unless (<= 0 (apply #'min rgb) (apply #'max rgb) 1)
+          (error "RGB components %S not in [0,1]" rgb))
+        (let* ((r (expt (nth 0 rgb) 2.2))
+               (g (expt (nth 1 rgb) 2.2))
+               (b (expt (nth 2 rgb) 2.2))
+               (y (+ (* r 0.2126) (* g 0.7152) (* b 0.0722))))
+          (< y 0.325)))
+    'color-dark-p))
+
+(defun exwm-xsettings--pick-theme (theme)
+  "Pick a light or dark theme from the given THEME.
+If THEME is a string, it's returned directly.
+If THEME is a cons of (LIGHT . DARK), the appropriate theme is picked based on
+the default face's background color."
+  (pcase theme
+    ((cl-type string) theme)
+    (`(,(cl-type string) . ,(cl-type string))
+     (if (exwm-xsettings--color-dark-p (color-name-to-rgb (face-background 'default)))
+         (cdr theme) (car theme)))
+    (_ (error "Expected theme to be a string or a pair of strings"))))
+
+(defun exwm-xsettings--get-settings ()
+  "Get the current settings.
+Combines `exwm-xsettings', `exwm-xsettings-theme' (if set), and
+`exwm-xsettings-icon-theme' (if set)."
+  (cl-remove-duplicates
+   (append
+    exwm-xsettings
+    (when exwm-xsettings-theme
+      (list (cons "Net/ThemeName" (exwm-xsettings--pick-theme exwm-xsettings-theme))))
+    (when exwm-xsettings-icon-theme
+      (list (cons "Net/IconThemeName" (exwm-xsettings--pick-theme exwm-xsettings-icon-theme)))))
+   :key 'car
+   :test 'string=))
+
+(defun exwm-xsettings--make-settings (settings serial)
+  "Construct a new settings object.
+SETTINGS is an alist of key/value pairs.
+SERIAL is a sequence number."
+  (make-instance 'xcb:xsettings:-Settings
+                 :byte-order (if xcb:lsb 0 1)
+                 :serial serial
+                 :settings-len (length settings)
+                 :settings
+                 (mapcar
+                  (lambda (prop)
+                    (let* ((name (car prop))
+                           (value (cdr prop))
+                           (common (list :name name
+                                         :name-len (length name)
+                                         :last-change-serial serial)))
+                      (pcase value
+                        ((cl-type string)
+                         (apply #'make-instance 'xcb:xsettings:-SETTING_STRING
+                                :value-len (length value)
+                                :value value
+                                common))
+                        ((cl-type integer)
+                         (apply #'make-instance 'xcb:xsettings:-SETTING_INTEGER
+                                :value value common))
+                        ((and (cl-type list) (app length (or 3 4)))
+                         ;; Convert from RGB(A) to 16bit integers.
+                         (setq value (mapcar (lambda (x) (round (* x #xffff))) value))
+                         (apply #'make-instance 'xcb:xsettings:-SETTING_COLOR
+                                :red (pop value)
+                                :green (pop value)
+                                :blue (pop value)
+                                :alpha (or (pop value) #xffff)))
+                        (_ (error "Setting value must be a string, integer, or length 3-4 list")))))
+                  settings)))
+
+(defun exwm-xsettings--update-settings ()
+  "Update the xsettings."
+  (when exwm-xsettings--connection
+    (setq exwm-xsettings--serial (1+ exwm-xsettings--serial))
+    (let* ((settings (exwm-xsettings--get-settings))
+           (bytes (xcb:marshal (exwm-xsettings--make-settings settings exwm-xsettings--serial))))
+      (xcb:+request exwm-xsettings--connection
+          (make-instance 'xcb:ChangeProperty
+                         :mode xcb:PropMode:Replace
+                         :window exwm-xsettings--selection-owner-window
+                         :property exwm-xsettings--XSETTINGS_SETTINGS-atom
+                         :type exwm-xsettings--XSETTINGS_SETTINGS-atom
+                         :format 8
+                         :data-len (length bytes)
+                         :data bytes)))
+    (xcb:flush exwm-xsettings--connection)))
+
+(defun exwm-xsettings--on-theme-change (&rest _)
+  "Called when the Emacs theme is changed."
+  ;; We only bother updating the xsettings if changing the theme could effect
+  ;; the settings.
+  (when (or (consp exwm-xsettings-theme) (consp exwm-xsettings-icon-theme))
+    (exwm-xsettings--update-settings)))
+
+(defun exwm-xsettings--on-SelectionClear (_data _synthetic)
+  "Called when another xsettings daemon takes over."
+  (exwm--log "XSETTINGS manager has been replaced.")
+  (exwm-xsettings--exit))
+
+(cl-defun exwm-xsettings--init ()
+  "Initialize the XSETTINGS module."
+  (exwm--log)
+
+  (cl-assert (not exwm-xsettings--connection))
+
+  ;; Connect
+  (setq exwm-xsettings--connection (xcb:connect))
+  (set-process-query-on-exit-flag (slot-value exwm-xsettings--connection
+                                              'process)
+                                  nil)
+
+  ;; Intern the atoms.
+  (setq exwm-xsettings--XSETTINGS_SETTINGS-atom
+        (exwm--intern-atom "_XSETTINGS_SETTINGS" exwm-xsettings--connection)
+
+        exwm-xsettings--XSETTINGS_S0-atom
+        (exwm--intern-atom "_XSETTINGS_S0" exwm-xsettings--connection))
+
+  ;; Detect running XSETTINGS managers.
+  (with-slots (owner)
+      (xcb:+request-unchecked+reply exwm-xsettings--connection
+          (make-instance 'xcb:GetSelectionOwner
+                         :selection exwm-xsettings--XSETTINGS_S0-atom))
+    (when (/= owner xcb:Window:None)
+      (xcb:disconnect exwm-xsettings--connection)
+      (setq exwm-xsettings--connection nil)
+      (warn "[EXWM] Other XSETTINGS manager detected")
+      (cl-return-from exwm-xsettings--init)))
+
+
+  (let ((id(xcb:generate-id exwm-xsettings--connection)))
+    (setq exwm-xsettings--selection-owner-window id)
+
+    ;; Create a settings window.
+    (xcb:+request exwm-xsettings--connection
+        (make-instance 'xcb:CreateWindow
+                       :wid id
+                       :parent exwm--root
+                       :class xcb:WindowClass:InputOnly
+                       :x 0
+                       :y 0
+                       :width 1
+                       :height 1
+                       :border-width 0
+                       :depth 0
+                       :visual 0
+                       :value-mask xcb:CW:OverrideRedirect
+                       :override-redirect 1))
+
+    ;; Set _NET_WM_NAME.
+    (xcb:+request exwm-xsettings--connection
+        (make-instance 'xcb:ewmh:set-_NET_WM_NAME
+                       :window id
+                       :data "EXWM: exwm-xsettings--selection-owner-window"))
+
+    ;; Apply the XSETTINGS properties.
+    (exwm-xsettings--update-settings)
+
+    ;; Take ownership and notify.
+    (xcb:+request exwm-xsettings--connection
+        (make-instance 'xcb:SetSelectionOwner
+                       :owner id
+                       :selection exwm-xsettings--XSETTINGS_S0-atom
+                       :time xcb:Time:CurrentTime))
+    (xcb:+request exwm-xsettings--connection
+        (make-instance 'xcb:SendEvent
+                       :propagate 0
+                       :destination exwm--root
+                       :event-mask xcb:EventMask:StructureNotify
+                       :event (xcb:marshal
+                               (make-instance 'xcb:xsettings:-ClientMessage
+                                              :window exwm--root
+                                              :time xcb:Time:CurrentTime
+                                              :selection exwm-xsettings--XSETTINGS_S0-atom
+                                              :owner id)
+                               exwm-xsettings--connection)))
+
+    ;; Detect loss of XSETTINGS ownership.
+    (xcb:+event exwm-xsettings--connection 'xcb:SelectionClear
+                #'exwm-xsettings--on-SelectionClear)
+
+    (xcb:flush exwm-xsettings--connection))
+
+  ;; Update the xsettings if/when the theme changes.
+  (add-hook 'enable-theme-functions #'exwm-xsettings--on-theme-change)
+  (add-hook 'disable-theme-functions #'exwm-xsettings--on-theme-change))
+
+(defun exwm-xsettings--exit ()
+  "Exit the XSETTINGS module."
+  (exwm--log)
+
+  (when exwm-xsettings--connection
+    (remove-hook 'enable-theme-functions #'exwm-xsettings--on-theme-change)
+    (remove-hook 'disable-theme-functions #'exwm-xsettings--on-theme-change)
+
+    (xcb:disconnect exwm-xsettings--connection)
+
+    (setq exwm-xsettings--connection nil
+          exwm-xsettings--XSETTINGS_SETTINGS-atom nil
+          exwm-xsettings--XSETTINGS_S0-atom nil
+          exwm-xsettings--selection-owner-window nil)))
+
+(defun exwm-xsettings-enable ()
+  "Enable xsettings support for EXWM."
+  (exwm--log)
+  (add-hook 'exwm-init-hook #'exwm-xsettings--init)
+  (add-hook 'exwm-exit-hook #'exwm-xsettings--exit))
+
+(provide 'exwm-xsettings)
+
+;;; exwm-xsettings.el ends here