;;; 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
