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)
This commit is contained in:
Steven Allen
Daniel Mendler
parent
c573ff143a
commit
ff4edaab89
1 changed files with 400 additions and 0 deletions
400
exwm-xsettings.el
Normal file
400
exwm-xsettings.el
Normal file
|
|
@ -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
|
||||||
Loading…
Add table
Add a link
Reference in a new issue