[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/exwm ff4edaab89 3/5: Implement the XSETTINGS protocol
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/exwm ff4edaab89 3/5: Implement the XSETTINGS protocol |
|
Date: |
Sat, 13 Jan 2024 16:11:00 -0500 (EST) |
branch: externals/exwm
commit ff4edaab89311281fd78725b98a751e15b6a2ec1
Author: Steven Allen <steven@stebalien.com>
Commit: Daniel Mendler <mail@daniel-mendler.de>
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)
---
exwm-xsettings.el | 400 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 400 insertions(+)
diff --git a/exwm-xsettings.el b/exwm-xsettings.el
new file mode 100644
index 0000000000..4eac557b9a
--- /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