diff options
Diffstat (limited to 'third_party/exwm')
| -rw-r--r-- | third_party/exwm/.elpaignore | 1 | ||||
| -rw-r--r-- | third_party/exwm/default.nix | 14 | ||||
| -rw-r--r-- | third_party/exwm/exwm-background.el | 199 | ||||
| -rw-r--r-- | third_party/exwm/exwm-cm.el | 50 | ||||
| -rw-r--r-- | third_party/exwm/exwm-config.el | 2 | ||||
| -rw-r--r-- | third_party/exwm/exwm-core.el | 47 | ||||
| -rw-r--r-- | third_party/exwm/exwm-floating.el | 23 | ||||
| -rw-r--r-- | third_party/exwm/exwm-input.el | 245 | ||||
| -rw-r--r-- | third_party/exwm/exwm-layout.el | 63 | ||||
| -rw-r--r-- | third_party/exwm/exwm-manage.el | 115 | ||||
| -rw-r--r-- | third_party/exwm/exwm-randr.el | 12 | ||||
| -rw-r--r-- | third_party/exwm/exwm-systemtray.el | 276 | ||||
| -rw-r--r-- | third_party/exwm/exwm-workspace.el | 460 | ||||
| -rw-r--r-- | third_party/exwm/exwm-xim.el | 11 | ||||
| -rw-r--r-- | third_party/exwm/exwm-xsettings.el | 336 | ||||
| -rw-r--r-- | third_party/exwm/exwm.el | 194 |
16 files changed, 1403 insertions, 645 deletions
diff --git a/third_party/exwm/.elpaignore b/third_party/exwm/.elpaignore index b43bf86b50..f0f644ee08 100644 --- a/third_party/exwm/.elpaignore +++ b/third_party/exwm/.elpaignore @@ -1 +1,2 @@ +LICENSE README.md diff --git a/third_party/exwm/default.nix b/third_party/exwm/default.nix new file mode 100644 index 0000000000..6daee882fe --- /dev/null +++ b/third_party/exwm/default.nix @@ -0,0 +1,14 @@ +{ depot, pkgs, lib, ... }: + +# special dance for overriding this into the fixed-point of emacs +# packages, but having it be separately buildable. + +pkgs.emacsPackages.callPackage + ({ trivialBuild, xelb }: trivialBuild { + pname = "depot-exwm"; + version = "canon"; + src = ./.; + + packageRequires = [ xelb ]; + }) +{ } diff --git a/third_party/exwm/exwm-background.el b/third_party/exwm/exwm-background.el new file mode 100644 index 0000000000..fa663d8fe6 --- /dev/null +++ b/third_party/exwm/exwm-background.el @@ -0,0 +1,199 @@ +;;; exwm-background.el --- X Background 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: + +;; This module adds X background color setting support to EXWM. + +;; To use this module, load and enable it as follows: +;; (require 'exwm-background) +;; (exwm-background-enable) +;; +;; By default, this will apply the theme's background color. However, that +;; color can be customized via the `exwm-background-color' setting. + +;;; Code: + +(require 'exwm-core) + +(defcustom exwm-background-color nil + "Background color for Xorg." + :type '(choice + (color :tag "Background Color") + (const :tag "Default" nil)) + :group 'exwm + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (set-default-toplevel-value symbol value) + (exwm-background--update))) + +(defconst exwm-background--properties '("_XROOTPMAP_ID" "_XSETROOT_ID" "ESETROOT_PMAP_ID") + "The background properties to set. +We can't need to set these so that compositing window managers +can correctly display the background color.") + +(defvar exwm-background--connection nil + "The X connection used for setting the background. +We use a separate connection as other background-setting tools +may kill this connection when they replace it.") + +(defvar exwm-background--pixmap nil + "Cached background pixmap.") + +(defvar exwm-background--atoms nil + "Cached background atoms.") + +(defun exwm-background--update (&rest _) + "Update the EXWM background." + + ;; Always reconnect as any tool that sets the background may have disconnected us (to force X to + ;; free resources). + (exwm-background--connect) + + (let ((gc (xcb:generate-id exwm-background--connection)) + (color (exwm--color->pixel (or exwm-background-color + (face-background 'default))))) + ;; Fill the pixmap. + (xcb:+request exwm-background--connection + (make-instance 'xcb:CreateGC + :cid gc :drawable exwm-background--pixmap + :value-mask (logior xcb:GC:Foreground + xcb:GC:GraphicsExposures) + :foreground color + :graphics-exposures 0)) + + (xcb:+request exwm-background--connection + (make-instance 'xcb:PolyFillRectangle + :gc gc :drawable exwm-background--pixmap + :rectangles + (list + (make-instance + 'xcb:RECTANGLE + :x 0 :y 0 :width 1 :height 1)))) + (xcb:+request exwm-background--connection (make-instance 'xcb:FreeGC :gc gc))) + + ;; Reapply it to force an update (also clobber anyone else who may have set it). + (xcb:+request exwm-background--connection + (make-instance 'xcb:ChangeWindowAttributes + :window exwm--root + :value-mask xcb:CW:BackPixmap + :background-pixmap exwm-background--pixmap)) + + (let (old) + ;; Collect old pixmaps so we can kill other background clients (all the background setting tools + ;; seem to do this). + (dolist (atom exwm-background--atoms) + (when-let* ((reply (xcb:+request-unchecked+reply exwm-background--connection + (make-instance 'xcb:GetProperty + :delete 0 + :window exwm--root + :property atom + :type xcb:Atom:PIXMAP + :long-offset 0 + :long-length 1))) + (value (vconcat (slot-value reply 'value))) + ((length= value 4)) + (pixmap (funcall (if xcb:lsb #'xcb:-unpack-u4-lsb #'xcb:-unpack-u4) + value 0)) + ((not (or (= pixmap exwm-background--pixmap) + (member pixmap old))))) + (push pixmap old))) + + ;; Change the background. + (dolist (atom exwm-background--atoms) + (xcb:+request exwm-background--connection + (make-instance 'xcb:ChangeProperty + :window exwm--root + :property atom + :type xcb:Atom:PIXMAP + :format 32 + :mode xcb:PropMode:Replace + :data-len 1 + :data + (funcall (if xcb:lsb + #'xcb:-pack-u4-lsb + #'xcb:-pack-u4) + exwm-background--pixmap)))) + + ;; Kill the old background clients. + (dolist (pixmap old) + (xcb:+request exwm-background--connection + (make-instance 'xcb:KillClient :resource pixmap)))) + + (xcb:flush exwm-background--connection)) + +(defun exwm-background--connected-p () + (and exwm-background--connection + (process-live-p (slot-value exwm-background--connection 'process)))) + +(defun exwm-background--connect () + (unless (exwm-background--connected-p) + (setq exwm-background--connection (xcb:connect)) + ;;prevent query message on exit + (set-process-query-on-exit-flag (slot-value exwm-background--connection 'process) nil) + + ;; Intern the background property atoms. + (setq exwm-background--atoms + (mapcar + (lambda (prop) (exwm--intern-atom prop exwm-background--connection)) + exwm-background--properties)) + + ;; Create the pixmap. + (setq exwm-background--pixmap (xcb:generate-id exwm-background--connection)) + (xcb:+request exwm-background--connection + (make-instance 'xcb:CreatePixmap + :depth + (slot-value + (xcb:+request-unchecked+reply exwm-background--connection + (make-instance 'xcb:GetGeometry :drawable exwm--root)) + 'depth) + :pid exwm-background--pixmap + :drawable exwm--root + :width 1 :height 1)))) + +(defun exwm-background--init () + "Initialize background module." + (exwm--log) + (add-hook 'enable-theme-functions 'exwm-background--update) + (add-hook 'disable-theme-functions 'exwm-background--update) + (exwm-background--update)) + +(defun exwm-background--exit () + "Uninitialize the background module." + (exwm--log) + (remove-hook 'enable-theme-functions 'exwm-background--update) + (remove-hook 'disable-theme-functions 'exwm-background--update) + (when (and exwm-background--connection + (slot-value exwm-background--connection 'connected)) + (xcb:disconnect exwm-background--connection)) + (setq exwm-background--pixmap nil + exwm-background--connection nil + exwm-background--atoms nil)) + +(defun exwm-background-enable () + "Enable background support for EXWM." + (exwm--log) + (add-hook 'exwm-init-hook #'exwm-background--init) + (add-hook 'exwm-exit-hook #'exwm-background--exit)) + +(provide 'exwm-background) + +;;; exwm-background.el ends here diff --git a/third_party/exwm/exwm-cm.el b/third_party/exwm/exwm-cm.el deleted file mode 100644 index 8a45010030..0000000000 --- a/third_party/exwm/exwm-cm.el +++ /dev/null @@ -1,50 +0,0 @@ -;;; exwm-cm.el --- Compositing Manager for EXWM -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2021 Free Software Foundation, Inc. - -;; Author: Chris Feng <chris.w.feng@gmail.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: - -;; This module is obsolete since EXWM now supports third-party compositors. - -;;; Code: - -(make-obsolete-variable 'exwm-cm-opacity - "This variable should no longer be used." "26") - -(defun exwm-cm-set-opacity (&rest _args) - (declare (obsolete nil "26"))) - -(defun exwm-cm-enable () - (declare (obsolete nil "26"))) - -(defun exwm-cm-start () - (declare (obsolete nil "26"))) - -(defun exwm-cm-stop () - (declare (obsolete nil "26"))) - -(defun exwm-cm-toggle () - (declare (obsolete nil "26"))) - - - -(provide 'exwm-cm) - -;;; exwm-cm.el ends here diff --git a/third_party/exwm/exwm-config.el b/third_party/exwm/exwm-config.el index 9609f4cf3c..a9f21e9c8c 100644 --- a/third_party/exwm/exwm-config.el +++ b/third_party/exwm/exwm-config.el @@ -1,6 +1,6 @@ ;;; exwm-config.el --- Predefined configurations -*- lexical-binding: t -*- -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> diff --git a/third_party/exwm/exwm-core.el b/third_party/exwm/exwm-core.el index 995b590dc5..e0d644d941 100644 --- a/third_party/exwm/exwm-core.el +++ b/third_party/exwm/exwm-core.el @@ -1,6 +1,6 @@ ;;; exwm-core.el --- Core definitions -*- lexical-binding: t -*- -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -33,6 +33,10 @@ (require 'xcb-ewmh) (require 'xcb-debug) +(defgroup exwm-debug nil + "Debugging." + :group 'exwm) + (defcustom exwm-debug-log-time-function #'exwm-debug-log-uptime "Function used for generating timestamps in `exwm-debug' logs. @@ -40,7 +44,6 @@ Here are some predefined candidates: `exwm-debug-log-uptime': Display the uptime of this Emacs instance. `exwm-debug-log-time': Display time of day. `nil': Disable timestamp." - :group 'exwm-debug :type `(choice (const :tag "Emacs uptime" ,#'exwm-debug-log-uptime) (const :tag "Time of day" ,#'exwm-debug-log-time) (const :tag "Off" nil) @@ -59,6 +62,9 @@ Here are some predefined candidates: (defvar exwm--connection nil "X connection.") +(defvar exwm--terminal nil + "Terminal corresponding to `exwm--connection'.") + (defvar exwm--wmsn-window nil "An X window owning the WM_S0 selection.") @@ -90,10 +96,12 @@ Here are some predefined candidates: (frame-or-index &optional id)) (define-minor-mode exwm-debug - "Debug-logging enabled if non-nil" - :global t) + "Debug-logging enabled if non-nil." + :global t + :group 'exwm-debug) (defmacro exwm--debug (&rest forms) + "Evaluate FORMS if mode `exwm-debug' is active." (when exwm-debug `(progn ,@forms))) (defmacro exwm--log (&optional format-string &rest objects) @@ -113,10 +121,12 @@ FORMAT-STRING is a string specifying the message to output, as in (defsubst exwm--id->buffer (id) "X window ID => Emacs buffer." + (declare (indent defun)) (cdr (assoc id exwm--id-buffer-alist))) (defsubst exwm--buffer->id (buffer) "Emacs buffer BUFFER => X window ID." + (declare (indent defun)) (car (rassoc buffer exwm--id-buffer-alist))) (defun exwm--lock (&rest _args) @@ -155,9 +165,11 @@ Nil can be passed as placeholder." (if height xcb:ConfigWindow:Height 0)) :x x :y y :width width :height height))) -(defun exwm--intern-atom (atom) - "Intern X11 ATOM." - (slot-value (xcb:+request-unchecked+reply exwm--connection +(defun exwm--intern-atom (atom &optional conn) + "Intern X11 ATOM. +If CONN is non-nil, use it instead of the value of the variable +`exwm--connection'." + (slot-value (xcb:+request-unchecked+reply (or conn exwm--connection) (make-instance 'xcb:InternAtom :only-if-exists 0 :name-len (length atom) @@ -177,6 +189,12 @@ least SECS seconds later." ,function ,@args)) +(defsubst exwm--terminal-p (&optional frame) + "Return t when FRAME's terminal is EXWM's terminal. +If FRAME is null, use selected frame." + (declare (indent defun)) + (eq exwm--terminal (frame-terminal frame))) + (defun exwm--get-client-event-mask () "Return event mask set on all managed windows." (logior xcb:EventMask:StructureNotify @@ -188,14 +206,17 @@ least SECS seconds later." "Convert COLOR to PIXEL (index in TrueColor colormap)." (when (and color (eq (x-display-visual-class) 'true-color)) - (let ((rgb (x-color-values color))) - (logior (lsh (lsh (pop rgb) -8) 16) - (lsh (lsh (pop rgb) -8) 8) - (lsh (pop rgb) -8))))) + (let ((rgb (color-values color))) + (logior (ash (ash (pop rgb) -8) 16) + (ash (ash (pop rgb) -8) 8) + (ash (pop rgb) -8))))) (defun exwm--get-visual-depth-colormap (conn id) "Get visual, depth and colormap from X window ID. -Return a three element list with the respective results." +Return a three element list with the respective results. + +If CONN is non-nil, use it instead of the value of the variable +`exwm--connection'." (let (ret-visual ret-depth ret-colormap) (with-slots (visual colormap) (xcb:+request-unchecked+reply conn @@ -227,7 +248,7 @@ One of `line-mode' or `char-mode'.") (defvar-local exwm--geometry nil) (defvar-local exwm-class-name nil "Class name in WM_CLASS.") (defvar-local exwm-instance-name nil "Instance name in WM_CLASS.") -(defvar-local exwm-title nil "Window title (either _NET_WM_NAME or WM_NAME)") +(defvar-local exwm-title nil "Window title (either _NET_WM_NAME or WM_NAME).") (defvar-local exwm--title-is-utf8 nil) (defvar-local exwm-transient-for nil "WM_TRANSIENT_FOR.") (defvar-local exwm--protocols nil) diff --git a/third_party/exwm/exwm-floating.el b/third_party/exwm/exwm-floating.el index a9f9315b71..34d06a30db 100644 --- a/third_party/exwm/exwm-floating.el +++ b/third_party/exwm/exwm-floating.el @@ -1,6 +1,6 @@ ;;; exwm-floating.el --- Floating Module for EXWM -*- lexical-binding: t -*- -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -31,17 +31,16 @@ (defgroup exwm-floating nil "Floating." - :version "25.3" :group 'exwm) (defcustom exwm-floating-setup-hook nil - "Normal hook run when an X window has been made floating, in the -context of the corresponding buffer." + "Normal hook run when an X window has been made floating. +This hook runs in the context of the corresponding buffer." :type 'hook) (defcustom exwm-floating-exit-hook nil - "Normal hook run when an X window has exited floating state, in the -context of the corresponding buffer." + "Normal hook run when an X window has exited floating state. +This hook runs in the context of the corresponding buffer." :type 'hook) (defcustom exwm-floating-border-color "navy" @@ -118,13 +117,13 @@ context of the corresponding buffer." (defvar exwm-workspace--current) (defvar exwm-workspace--frame-y-offset) (defvar exwm-workspace--window-y-offset) -(defvar exwm-workspace--workareas) (declare-function exwm-layout--hide "exwm-layout.el" (id)) (declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) (declare-function exwm-layout--refresh "exwm-layout.el" ()) (declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) (declare-function exwm-workspace--position "exwm-workspace.el" (frame)) (declare-function exwm-workspace--update-offsets "exwm-workspace.el" ()) +(declare-function exwm-workspace--workarea "exwm-workspace.el" (frame)) (defun exwm-floating--set-allowed-actions (id tilling) "Set _NET_WM_ALLOWED_ACTIONS." @@ -161,6 +160,8 @@ context of the corresponding buffer." (get-buffer "*scratch*"))) (make-frame `((minibuffer . ,(minibuffer-window exwm--frame)) + (tab-bar-lines . 0) + (tab-bar-lines-keep-state . t) (left . ,(* window-min-width -10000)) (top . ,(* window-min-height -10000)) (width . ,window-min-width) @@ -184,12 +185,8 @@ context of the corresponding buffer." (set-frame-parameter frame 'exwm-container frame-container) ;; Fix illegal parameters ;; FIXME: check normal hints restrictions - (let* ((workarea (elt exwm-workspace--workareas - (exwm-workspace--position original-frame))) - (x* (aref workarea 0)) - (y* (aref workarea 1)) - (width* (aref workarea 2)) - (height* (aref workarea 3))) + (with-slots ((x* x) (y* y) (width* width) (height* height)) + (exwm-workspace--workarea original-frame) ;; Center floating windows (when (and (or (= x 0) (= x x*)) (or (= y 0) (= y y*))) diff --git a/third_party/exwm/exwm-input.el b/third_party/exwm/exwm-input.el index 50676217f1..f1f035c91a 100644 --- a/third_party/exwm/exwm-input.el +++ b/third_party/exwm/exwm-input.el @@ -1,6 +1,6 @@ ;;; exwm-input.el --- Input Module for EXWM -*- lexical-binding: t -*- -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -40,14 +40,13 @@ (defgroup exwm-input nil "Input." - :version "25.3" :group 'exwm) (defcustom exwm-input-prefix-keys '(?\C-x ?\C-u ?\C-h ?\M-x ?\M-` ?\M-& ?\M-:) - "List of prefix keys EXWM should forward to Emacs when in line-mode. + "List of prefix keys EXWM should forward to Emacs when in `line-mode'. -The point is to make keys like 'C-x C-f' forwarded to Emacs in line-mode. +The point is to make keys like 'C-x C-f' forwarded to Emacs in `line-mode'. There is no need to add prefix keys for global/simulation keys or those defined in `exwm-mode-map' here." :type '(repeat key-sequence) @@ -87,7 +86,7 @@ defined in `exwm-mode-map' here." value)))) (defcustom exwm-input-line-mode-passthrough nil - "Non-nil makes 'line-mode' forward all events to Emacs." + "Non-nil makes `line-mode' forward all events to Emacs." :type 'boolean) ;; Input focus update requests should be accumulated for a short time @@ -102,6 +101,13 @@ defined in `exwm-mode-map' here." (defconst exwm-input--update-focus-interval 0.01 "Time interval (in seconds) for accumulating input focus update requests.") +(defconst exwm-input--passthrough-functions '(read-char + read-char-exclusive + read-key-sequence-vector + read-key-sequence + read-event) + "Low-level read functions that must be exempted from EXWM input handling.") + (defvar exwm-input--during-command nil "Indicate whether between `pre-command-hook' and `post-command-hook'.") @@ -115,10 +121,13 @@ defined in `exwm-mode-map' here." (defvar exwm-input--local-simulation-keys nil "Whether simulation keys are local.") -(defvar exwm-input--simulation-keys nil "Simulation keys in line-mode.") +(defvar exwm-input--simulation-keys nil "Simulation keys in `line-mode'.") + +(defvar exwm-input--skip-buffer-list-update nil + "Skip the upcoming `buffer-list-update'.") (defvar exwm-input--temp-line-mode nil - "Non-nil indicates it's in temporary line-mode for char-mode.") + "Non-nil indicates it's in temporary line-mode for `char-mode'.") (defvar exwm-input--timestamp-atom nil) @@ -126,25 +135,15 @@ defined in `exwm-mode-map' here." (defvar exwm-input--timestamp-window nil) -(defvar exwm-input--update-focus-defer-timer nil "Timer for polling the lock.") +(defvar exwm-input--update-focus-timer nil + "Timer for deferring the update of input focus.") (defvar exwm-input--update-focus-lock nil "Lock for solving input focus update contention.") -(defvar exwm-input--update-focus-timer nil - "Timer for deferring the update of input focus.") - (defvar exwm-input--update-focus-window nil "The (Emacs) window to be focused. -It also helps us discern whether a `buffer-list-update-hook' was caused by a -different window having been selected. - This value should always be overwritten.") -(defvar exwm-input--update-focus-window-buffer nil - "Buffer displayed in `exwm-input--update-focus-window'. -Helps us discern whether a `buffer-list-update-hook' was caused by the selected -window switching to a different buffer.") - (defvar exwm-input--echo-area-timer nil "Timer for detecting echo area dirty.") (defvar exwm-input--event-hook nil @@ -164,8 +163,6 @@ Current buffer will be the `exwm-mode' buffer when this hook runs.") (declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) (declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) (declare-function exwm-reset "exwm.el" ()) -(declare-function exwm-workspace--client-p "exwm-workspace.el" - (&optional frame)) (declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el") (declare-function exwm-workspace--workspace-p "exwm-workspace.el" (workspace)) (declare-function exwm-workspace-switch "exwm-workspace.el" @@ -301,51 +298,39 @@ ARGS are additional arguments to CALLBACK." (defun exwm-input--on-buffer-list-update () "Run in `buffer-list-update-hook' to track input focus." - ;; `buffer-list-update-hook' is invoked by several functions - ;; (`get-buffer-create', `select-window', `with-temp-buffer', etc.), but we - ;; just want to notice when a different window has been selected, or when the - ;; selected window displays a different buffer, so that we can set the focus - ;; to the associated X window (in case of an `exwm-mode' buffer). In order to - ;; differentiate, we keep track of the last selected window and buffer in the - ;; `exwm-input--update-focus-window' and - ;; `exwm-input--update-focus-window-buffer' variables. - (let* ((win (selected-window)) - (buf (window-buffer win))) - (when (and (not (exwm-workspace--client-p)) - (not (and (eq exwm-input--update-focus-window win) - (eq exwm-input--update-focus-window-buffer buf)))) - (exwm--log "selected-window=%S current-buffer=%S" win buf) - (setq exwm-input--update-focus-window win) - (setq exwm-input--update-focus-window-buffer buf) - (redirect-frame-focus (selected-frame) nil) - (exwm-input--update-focus-defer)))) + (when (and ; this hook is called incesantly; place cheap tests on top + (not exwm-input--skip-buffer-list-update) + (exwm--terminal-p) ; skip other terminals, e.g. TTY client frames + (not (frame-parameter nil 'no-accept-focus))) + (exwm--log "current-buffer=%S selected-window=%S" + (current-buffer) (selected-window)) + (redirect-frame-focus (selected-frame) nil) + (setq exwm-input--update-focus-window (selected-window)) + (exwm-input--update-focus-defer))) (defun exwm-input--update-focus-defer () - "Defer updating input focus." - (when exwm-input--update-focus-defer-timer - (cancel-timer exwm-input--update-focus-defer-timer)) + "Schedule a deferred update to input focus. +Instead of immediately focusing the current window, it defers the focus change +until the selected window stops changing (debouncing input focus updates)." + (when exwm-input--update-focus-timer + (cancel-timer exwm-input--update-focus-timer)) + (setq exwm-input--update-focus-timer + ;; Attempt to accumulate successive events close enough. + (run-with-timer exwm-input--update-focus-interval + nil + #'exwm-input--update-focus-commit))) + +(defun exwm-input--update-focus-commit () + "Attempt to update the window focus. +If we're currently updating the window focus, re-schedule a focus update +attempt later." (if exwm-input--update-focus-lock - (setq exwm-input--update-focus-defer-timer - (exwm--defer 0 #'exwm-input--update-focus-defer)) - (setq exwm-input--update-focus-defer-timer nil) - (when exwm-input--update-focus-timer - (cancel-timer exwm-input--update-focus-timer)) - (setq exwm-input--update-focus-timer - ;; Attempt to accumulate successive events close enough. - (run-with-timer exwm-input--update-focus-interval - nil - #'exwm-input--update-focus-commit - exwm-input--update-focus-window)))) - -(defun exwm-input--update-focus-commit (window) - "Commit updating input focus." - (setq exwm-input--update-focus-lock t) - (unwind-protect - (exwm-input--update-focus window) - (setq exwm-input--update-focus-lock nil))) + (exwm-input--update-focus-defer) + (let ((exwm-input--update-focus-lock t)) + (exwm-input--update-focus exwm-input--update-focus-window)))) (defun exwm-input--update-focus (window) - "Update input focus." + "Update input focus to WINDOW." (when (window-live-p window) (exwm--log "focus-window=%s focus-buffer=%s" window (window-buffer window)) (with-current-buffer (window-buffer window) @@ -469,9 +454,12 @@ ARGS are additional arguments to CALLBACK." (t ;; Replay this event by default. (setq fake-last-command t) - (setq mode xcb:Allow:ReplayPointer)))) - (when fake-last-command - (exwm-input--fake-last-command)) + (setq mode xcb:Allow:ReplayPointer))) + (when fake-last-command + (if buffer + (with-current-buffer buffer + (exwm-input--fake-last-command)) + (exwm-input--fake-last-command)))) (xcb:+request exwm--connection (make-instance 'xcb:AllowEvents :mode mode :time xcb:Time:CurrentTime)) (xcb:flush exwm--connection)) @@ -594,18 +582,10 @@ instead." (when (called-interactively-p 'any) (exwm-input--update-global-prefix-keys))) -;; Putting (t . EVENT) into `unread-command-events' does not really work -;; as documented for Emacs < 26.2. -(eval-and-compile - (if (or (< emacs-major-version 26) - (and (= emacs-major-version 26) - (< emacs-minor-version 2))) - (defsubst exwm-input--unread-event (event) - (setq unread-command-events - (append unread-command-events (list event)))) - (defsubst exwm-input--unread-event (event) - (setq unread-command-events - (append unread-command-events `((t . ,event))))))) +(defsubst exwm-input--unread-event (event) + (declare (indent defun)) + (setq unread-command-events + (append unread-command-events `((t . ,event))))) (defun exwm-input--mimic-read-event (event) "Process EVENT as if it were returned by `read-event'." @@ -680,8 +660,26 @@ Current buffer must be an `exwm-mode' buffer." (defun exwm-input--fake-last-command () "Fool some packages into thinking there is a change in the buffer." (setq last-command #'exwm-input--noop) - (run-hooks 'pre-command-hook) - (run-hooks 'post-command-hook)) + ;; The Emacs manual says: + ;; > Quitting is suppressed while running pre-command-hook and + ;; > post-command-hook. If an error happens while executing one of these + ;; > hooks, it does not terminate execution of the hook; instead the error is + ;; > silenced and the function in which the error occurred is removed from the + ;; > hook. + ;; We supress errors but neither continue execution nor we remove from the + ;; hook. + (condition-case err + (run-hooks 'pre-command-hook) + ((error) + (exwm--log "Error occurred while running pre-command-hook: %s" + (error-message-string err)) + (xcb-debug:backtrace))) + (condition-case err + (run-hooks 'post-command-hook) + ((error) + (exwm--log "Error occurred while running post-command-hook: %s" + (error-message-string err)) + (xcb-debug:backtrace)))) (defun exwm-input--on-KeyPress-line-mode (key-press raw-data) "Parse X KeyPress event to Emacs key event and then feed the command loop." @@ -725,7 +723,7 @@ Current buffer must be an `exwm-mode' buffer." (xcb:flush exwm--connection)))) (defun exwm-input--on-KeyPress-char-mode (key-press &optional _raw-data) - "Handle KeyPress event in char-mode." + "Handle KeyPress event in `char-mode'." (with-slots (detail state) key-press (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state)) event raw-event) @@ -748,7 +746,7 @@ Current buffer must be an `exwm-mode' buffer." (defun exwm-input--on-ButtonPress-line-mode (buffer button-event) "Handle button events in line mode. BUFFER is the `exwm-mode' buffer the event was generated -on. BUTTON-EVENT is the X event converted into an Emacs event. +on. BUTTON-EVENT is the X event converted into an Emacs event. The return value is used as event_mode to release the original button event." @@ -766,7 +764,7 @@ button event." xcb:Allow:ReplayPointer)))) (defun exwm-input--on-ButtonPress-char-mode () - "Handle button events in char-mode. + "Handle button events in `char-mode'. The return value is used as event_mode to release the original button event." (exwm--log) @@ -842,7 +840,7 @@ button event." ;;;###autoload (defun exwm-input-grab-keyboard (&optional id) - "Switch to line-mode." + "Switch to `line-mode'." (interactive (list (when (derived-mode-p 'exwm-mode) (exwm--buffer->id (window-buffer))))) (when id @@ -853,7 +851,7 @@ button event." ;;;###autoload (defun exwm-input-release-keyboard (&optional id) - "Switch to char-mode." + "Switch to `char-mode`." (interactive (list (when (derived-mode-p 'exwm-mode) (exwm--buffer->id (window-buffer))))) (when id @@ -864,7 +862,7 @@ button event." ;;;###autoload (defun exwm-input-toggle-keyboard (&optional id) - "Toggle between 'line-mode' and 'char-mode'." + "Toggle between `line-mode' and `char-mode'." (interactive (list (when (derived-mode-p 'exwm-mode) (exwm--buffer->id (window-buffer))))) (when id @@ -971,17 +969,12 @@ multiple keys. If END-KEY is non-nil, stop sending keys if it's pressed." #'exwm-input-send-simulation-key)))) exwm-input--simulation-keys)) -(defun exwm-input-set-simulation-keys (simulation-keys) - "Please customize or set `exwm-input-simulation-keys' instead." - (declare (obsolete nil "26")) - (exwm-input--set-simulation-keys simulation-keys)) - (defcustom exwm-input-simulation-keys nil "Simulation keys. It is an alist of the form (original-key . simulated-key), where both original-key and simulated-key are key sequences. Original-key is what you -type to an X window in line-mode which then gets translated to simulated-key +type to an X window in `line-mode' which then gets translated to simulated-key by EXWM and forwarded to the X window. Notes: @@ -1092,7 +1085,7 @@ where both ORIGINAL-KEY and SIMULATED-KEY are key sequences." (defmacro exwm-input-invoke-factory (keys) "Make a command that invokes KEYS when called. -One use is to access the keymap bound to KEYS (as prefix keys) in char-mode." +One use is to access the keymap bound to KEYS (as prefix keys) in `char-mode'." (let* ((keys (kbd keys)) (description (key-description keys))) `(defun ,(intern (concat "exwm-input--invoke--" description)) () @@ -1116,39 +1109,47 @@ One use is to access the keymap bound to KEYS (as prefix keys) in char-mode." (defun exwm-input--on-minibuffer-setup () "Run in `minibuffer-setup-hook' to grab keyboard if necessary." - (exwm--log) - (with-current-buffer - (window-buffer (frame-selected-window exwm-workspace--current)) - (when (and (derived-mode-p 'exwm-mode) - (not (exwm-workspace--client-p)) - (eq exwm--selected-input-mode 'char-mode)) - (exwm-input--grab-keyboard exwm--id)))) + (let* ((window (or (minibuffer-selected-window) ; minibuffer-setup-hook + (selected-window))) ; echo-area-clear-hook + (frame (window-frame window))) + (when (exwm--terminal-p frame) + (with-current-buffer (window-buffer window) + (when (and (derived-mode-p 'exwm-mode) + (eq exwm--selected-input-mode 'char-mode)) + (exwm--log "Grab #x%x window=%s frame=%s" exwm--id window frame) + (exwm-input--grab-keyboard exwm--id)))))) (defun exwm-input--on-minibuffer-exit () "Run in `minibuffer-exit-hook' to release keyboard if necessary." - (exwm--log) - (with-current-buffer - (window-buffer (frame-selected-window exwm-workspace--current)) - (when (and (derived-mode-p 'exwm-mode) - (not (exwm-workspace--client-p)) - (eq exwm--selected-input-mode 'char-mode) - (eq exwm--input-mode 'line-mode)) - (exwm-input--release-keyboard exwm--id)))) + (let* ((window (or (minibuffer-selected-window) ; minibuffer-setup-hook + (selected-window))) ; echo-area-clear-hook + (frame (window-frame window))) + (when (exwm--terminal-p frame) + (with-current-buffer (window-buffer window) + (when (and (derived-mode-p 'exwm-mode) + (eq exwm--selected-input-mode 'char-mode) + (eq exwm--input-mode 'line-mode)) + (exwm--log "Release #x%x window=%s frame=%s" exwm--id window frame) + (exwm-input--release-keyboard exwm--id)))))) (defun exwm-input--on-echo-area-dirty () "Run when new message arrives to grab keyboard if necessary." - (exwm--log) - (when (and (not (active-minibuffer-window)) - (not (exwm-workspace--client-p)) - cursor-in-echo-area) + (when (and cursor-in-echo-area + (not (active-minibuffer-window))) + (exwm--log) (exwm-input--on-minibuffer-setup))) (defun exwm-input--on-echo-area-clear () "Run in `echo-area-clear-hook' to release keyboard if necessary." - (exwm--log) (unless (current-message) + (exwm--log) (exwm-input--on-minibuffer-exit))) +(defun exwm-input--call-with-passthrough (function &rest args) + "Bind `exwm-input-line-mode-passthrough' and call FUNCTION with ARGS." + (let ((exwm-input-line-mode-passthrough t)) + (apply function args))) + (defun exwm-input--init () "Initialize the keyboard module." (exwm--log) @@ -1204,7 +1205,10 @@ One use is to access the keymap bound to KEYS (as prefix keys) in char-mode." (run-with-idle-timer 0 t #'exwm-input--on-echo-area-dirty)) (add-hook 'echo-area-clear-hook #'exwm-input--on-echo-area-clear) ;; Update focus when buffer list updates - (add-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update)) + (add-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update) + + (dolist (fun exwm-input--passthrough-functions) + (advice-add fun :around #'exwm-input--call-with-passthrough))) (defun exwm-input--post-init () "The second stage in the initialization of the input module." @@ -1214,6 +1218,8 @@ One use is to access the keymap bound to KEYS (as prefix keys) in char-mode." (defun exwm-input--exit () "Exit the input module." (exwm--log) + (dolist (fun exwm-input--passthrough-functions) + (advice-remove fun #'exwm-input--call-with-passthrough)) (exwm-input--unset-simulation-keys) (remove-hook 'pre-command-hook #'exwm-input--on-pre-command) (remove-hook 'post-command-hook #'exwm-input--on-post-command) @@ -1224,17 +1230,16 @@ One use is to access the keymap bound to KEYS (as prefix keys) in char-mode." (setq exwm-input--echo-area-timer nil)) (remove-hook 'echo-area-clear-hook #'exwm-input--on-echo-area-clear) (remove-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update) - (when exwm-input--update-focus-defer-timer - (cancel-timer exwm-input--update-focus-defer-timer)) (when exwm-input--update-focus-timer (cancel-timer exwm-input--update-focus-timer)) ;; Make input focus working even without a WM. - (xcb:+request exwm--connection - (make-instance 'xcb:SetInputFocus - :revert-to xcb:InputFocus:PointerRoot - :focus exwm--root - :time xcb:Time:CurrentTime)) - (xcb:flush exwm--connection)) + (when (slot-value exwm--connection 'connected) + (xcb:+request exwm--connection + (make-instance 'xcb:SetInputFocus + :revert-to xcb:InputFocus:PointerRoot + :focus exwm--root + :time xcb:Time:CurrentTime)) + (xcb:flush exwm--connection))) diff --git a/third_party/exwm/exwm-layout.el b/third_party/exwm/exwm-layout.el index 9173a1c049..8649c11ffd 100644 --- a/third_party/exwm/exwm-layout.el +++ b/third_party/exwm/exwm-layout.el @@ -1,6 +1,6 @@ ;;; exwm-layout.el --- Layout Module for EXWM -*- lexical-binding: t -*- -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -29,7 +29,6 @@ (defgroup exwm-layout nil "Layout." - :version "25.3" :group 'exwm) (defcustom exwm-layout-auto-iconify t @@ -57,8 +56,7 @@ (declare-function exwm-input--grab-keyboard "exwm-input.el") (declare-function exwm-input-grab-keyboard "exwm-input.el") (declare-function exwm-workspace--active-p "exwm-workspace.el" (frame)) -(declare-function exwm-workspace--client-p "exwm-workspace.el" - (&optional frame)) +(declare-function exwm-workspace--get-geometry "exwm-workspace.el" (frame)) (declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el") (declare-function exwm-workspace--workspace-p "exwm-workspace.el" (workspace)) @@ -66,7 +64,7 @@ (frame-or-index &optional id)) (defun exwm-layout--set-state (id state) - "Set WM_STATE." + "Set WM_STATE of X window ID to STATE." (exwm--log "id=#x%x" id) (xcb:+request exwm--connection (make-instance 'xcb:icccm:set-WM_STATE @@ -75,24 +73,28 @@ (setq exwm-state state))) (defun exwm-layout--iconic-state-p (&optional id) + "Check whether X window ID is in iconic state." (= xcb:icccm:WM_STATE:IconicState (if id (buffer-local-value 'exwm-state (exwm--id->buffer id)) exwm-state))) -(defun exwm-layout--set-ewmh-state (xwin) - "Set _NET_WM_STATE." - (with-current-buffer (exwm--id->buffer xwin) +(defun exwm-layout--set-ewmh-state (id) + "Set _NET_WM_STATE of X window ID to the value of variable `exwm--ewmh-state'." + (with-current-buffer (exwm--id->buffer id) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_STATE :window exwm--id :data exwm--ewmh-state)))) (defun exwm-layout--fullscreen-p () + "Check whether current `exwm-mode' buffer is in fullscreen state." (when (derived-mode-p 'exwm-mode) (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state))) (defun exwm-layout--auto-iconify () + "Helper function to iconify unused X windows. +See variable `exwm-layout-auto-iconify'." (when (and exwm-layout-auto-iconify (not exwm-transient-for)) (let ((xwin exwm--id) @@ -154,7 +156,8 @@ (with-current-buffer (exwm--id->buffer id) (unless (or (exwm-layout--iconic-state-p) (and exwm--floating-frame - (eq 4294967295. exwm--desktop))) + exwm--desktop + (= 4294967295. exwm--desktop))) (exwm--log "Hide #x%x" id) (when exwm--floating-frame (let* ((container (frame-parameter exwm--floating-frame @@ -212,7 +215,7 @@ ;;;###autoload (cl-defun exwm-layout-unset-fullscreen (&optional id) - "Restore window from fullscreen state." + "Restore X window ID from fullscreen state." (interactive) (exwm--log "id=#x%x" (or id 0)) (unless (and (or id (derived-mode-p 'exwm-mode)) @@ -243,7 +246,7 @@ ;;;###autoload (cl-defun exwm-layout-toggle-fullscreen (&optional id) - "Toggle fullscreen mode." + "Toggle fullscreen mode of X window ID." (interactive (list (exwm--buffer->id (window-buffer)))) (exwm--log "id=#x%x" (or id 0)) (unless (or id (derived-mode-p 'exwm-mode)) @@ -300,7 +303,8 @@ selected by `other-buffer'." clients clients-floating)))))) (defun exwm-layout--refresh (&optional frame) - "Refresh layout." + "Refresh layout of FRAME. +If FRAME is nil, refresh layout of selected frame." ;; `window-size-change-functions' sets this argument while ;; `window-configuration-change-hook' makes the frame selected. (unless frame @@ -405,22 +409,29 @@ selected by `other-buffer'." (defun exwm-layout--on-minibuffer-setup () "Refresh layout when minibuffer grows." (exwm--log) - (unless (exwm-workspace--client-p) - (exwm--defer 0 (lambda () - (when (< 1 (window-height (minibuffer-window))) - (exwm-layout--refresh)))))) + ;; Only when active minibuffer's frame is an EXWM frame. + (let* ((mini-window (active-minibuffer-window)) + (frame (window-frame mini-window))) + (when (exwm-workspace--workspace-p frame) + (exwm--defer 0 (lambda () + (when (< 1 (window-height mini-window)) + (exwm-layout--refresh frame))))))) (defun exwm-layout--on-echo-area-change (&optional dirty) - "Run when message arrives or in `echo-area-clear-hook' to refresh layout." - (when (and (current-message) - (not (exwm-workspace--client-p)) - (or (cl-position ?\n (current-message)) - (> (length (current-message)) - (frame-width exwm-workspace--current)))) - (exwm--log) - (if dirty - (exwm-layout--refresh) - (exwm--defer 0 #'exwm-layout--refresh)))) + "Run when message arrives or in `echo-area-clear-hook' to refresh layout. +If DIRTY is non-nil, refresh layout immediately." + (let ((frame (window-frame (active-minibuffer-window))) + (msg (current-message))) + ;; Check whether the frame where current window's minibuffer resides (not + ;; current window's frame for floating windows!) must be adjusted. + (when (and msg + (exwm-workspace--workspace-p frame) + (or (cl-position ?\n msg) + (> (length msg) (frame-width frame)))) + (exwm--log) + (if dirty + (exwm-layout--refresh exwm-workspace--current) + (exwm--defer 0 #'exwm-layout--refresh exwm-workspace--current))))) ;;;###autoload (defun exwm-layout-enlarge-window (delta &optional horizontal) diff --git a/third_party/exwm/exwm-manage.el b/third_party/exwm/exwm-manage.el index e940257fc9..ab66e298ac 100644 --- a/third_party/exwm/exwm-manage.el +++ b/third_party/exwm/exwm-manage.el @@ -1,7 +1,7 @@ ;;; exwm-manage.el --- Window Management Module for -*- lexical-binding: t -*- ;;; EXWM -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -30,12 +30,11 @@ (defgroup exwm-manage nil "Manage." - :version "25.3" :group 'exwm) (defcustom exwm-manage-finish-hook nil - "Normal hook run after a window is just managed, in the context of the -corresponding buffer." + "Normal hook run after a window is just managed. +This hook runs in the context of the corresponding `exwm-mode' buffer." :type 'hook) (defcustom exwm-manage-force-tiling nil @@ -151,12 +150,12 @@ want to match against EXWM internal variables such as `exwm-title', (defvar exwm-manage--ping-lock nil "Non-nil indicates EXWM is pinging a window.") +(defvar exwm-input--skip-buffer-list-update) (defvar exwm-input-prefix-keys) (defvar exwm-workspace--current) (defvar exwm-workspace--id-struts-alist) (defvar exwm-workspace--list) (defvar exwm-workspace--switch-history-outdated) -(defvar exwm-workspace--workareas) (defvar exwm-workspace-current-index) (declare-function exwm--update-class "exwm.el" (id &optional force)) (declare-function exwm--update-hints "exwm.el" (id &optional force)) @@ -169,17 +168,22 @@ want to match against EXWM internal variables such as `exwm-title', (declare-function exwm--update-window-type "exwm.el" (id &optional force)) (declare-function exwm-floating--set-floating "exwm-floating.el" (id)) (declare-function exwm-floating--unset-floating "exwm-floating.el" (id)) -(declare-function exwm-input-grab-keyboard "exwm-input.el") +(declare-function exwm-input-grab-keyboard "exwm-input.el" (&optional id)) +(declare-function exwm-input-release-keyboard "exwm-input.el" (&optional id)) (declare-function exwm-input-set-local-simulation-keys "exwm-input.el") (declare-function exwm-layout--fullscreen-p "exwm-layout.el" ()) (declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) +(declare-function exwm-layout-set-fullscreen "exwm-layout.el" (&optional id)) +(declare-function exwm-workspace--get-geometry "exwm-workspace.el" (frame)) (declare-function exwm-workspace--position "exwm-workspace.el" (frame)) (declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame)) (declare-function exwm-workspace--update-struts "exwm-workspace.el" ()) (declare-function exwm-workspace--update-workareas "exwm-workspace.el" ()) +(declare-function exwm-workspace--workarea "exwm-workspace.el" (frame)) (defun exwm-manage--update-geometry (id &optional force) - "Update window geometry." + "Update geometry of X window ID. +Override current geometry if FORCE is non-nil." (exwm--log "id=#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and exwm--geometry (not force)) @@ -195,7 +199,7 @@ want to match against EXWM internal variables such as `exwm-title', :height (/ (x-display-pixel-height) 2)))))))) (defun exwm-manage--update-ewmh-state (id) - "Update _NET_WM_STATE." + "Update _NET_WM_STATE of X window ID." (exwm--log "id=#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless exwm--ewmh-state @@ -206,7 +210,8 @@ want to match against EXWM internal variables such as `exwm-title', (setq exwm--ewmh-state (append (slot-value reply 'value) nil))))))) (defun exwm-manage--update-mwm-hints (id &optional force) - "Update _MOTIF_WM_HINTS." + "Update _MOTIF_WM_HINTS of X window ID. +Override current hinds if FORCE is non-nil." (exwm--log "id=#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and (not exwm--mwm-hints-decorations) (not force)) @@ -229,6 +234,23 @@ want to match against EXWM internal variables such as `exwm-title', (elt value 2))) ;MotifWmHints.decorations (setq exwm--mwm-hints-decorations nil)))))))) +(defun exwm-manage--update-default-directory (id) + "Update the `default-directory' of X window ID. +Sets the `default-directory' of the EXWM buffer associated with X window to +match its current working directory. + +This only works when procfs is mounted, which may not be the case on some BSDs." + (with-current-buffer (exwm--id->buffer id) + (if-let* ((response (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:ewmh:get-_NET_WM_PID + :window id))) + (pid (slot-value response 'value)) + (cwd (file-symlink-p (format "/proc/%d/cwd" pid))) + ((file-accessible-directory-p cwd))) + (setq default-directory (file-name-as-directory cwd)) + (setq default-directory (expand-file-name "~/"))))) + + (defun exwm-manage--set-client-list () "Set _NET_CLIENT_LIST." (exwm--log) @@ -262,7 +284,8 @@ want to match against EXWM internal variables such as `exwm-title', (make-instance 'xcb:ChangeSaveSet :mode xcb:SetMode:Insert :window id)) - (with-current-buffer (generate-new-buffer "*EXWM*") + (with-current-buffer (let ((exwm-input--skip-buffer-list-update t)) + (generate-new-buffer "*EXWM*")) ;; Keep the oldest X window first. (setq exwm--id-buffer-alist (nconc exwm--id-buffer-alist `((,id . ,(current-buffer))))) @@ -324,12 +347,8 @@ want to match against EXWM internal variables such as `exwm-title', (with-slots (x y width height) exwm--geometry ;; Center window of type _NET_WM_WINDOW_TYPE_SPLASH (when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH exwm-window-type) - (let* ((workarea (elt exwm-workspace--workareas - (exwm-workspace--position exwm--frame))) - (x* (aref workarea 0)) - (y* (aref workarea 1)) - (width* (aref workarea 2)) - (height* (aref workarea 3))) + (with-slots ((x* x) (y* y) (width* width) (height* height)) + (exwm-workspace--workarea exwm--frame) (exwm--set-geometry id (+ x* (/ (- width* width) 2)) (+ y* (/ (- height* height) 2)) @@ -347,7 +366,8 @@ want to match against EXWM internal variables such as `exwm-title', :stack-mode xcb:StackMode:Below))) (xcb:flush exwm--connection) (setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist)) - (let ((kill-buffer-query-functions nil)) + (let ((kill-buffer-query-functions nil) + (exwm-input--skip-buffer-list-update t)) (kill-buffer (current-buffer))) (throw 'return 'ignored)) (let ((index (plist-get exwm--configurations 'workspace))) @@ -390,29 +410,26 @@ want to match against EXWM internal variables such as `exwm-title', (if (plist-get exwm--configurations 'char-mode) (exwm-input-release-keyboard id) (exwm-input-grab-keyboard id)) - (let ((simulation-keys (plist-get exwm--configurations 'simulation-keys)) - (prefix-keys (plist-get exwm--configurations 'prefix-keys))) - (with-current-buffer (exwm--id->buffer id) - (when simulation-keys - (exwm-input-set-local-simulation-keys simulation-keys)) - (when prefix-keys - (setq-local exwm-input-prefix-keys prefix-keys)))) + (when-let ((simulation-keys (plist-get exwm--configurations 'simulation-keys))) + (exwm-input-set-local-simulation-keys simulation-keys)) + (when-let ((prefix-keys (plist-get exwm--configurations 'prefix-keys))) + (setq-local exwm-input-prefix-keys prefix-keys)) (setq exwm-workspace--switch-history-outdated t) (exwm--update-desktop id) (exwm-manage--update-ewmh-state id) - (with-current-buffer (exwm--id->buffer id) - (when (or (plist-get exwm--configurations 'fullscreen) - (exwm-layout--fullscreen-p)) - (setq exwm--ewmh-state (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN - exwm--ewmh-state)) - (exwm-layout-set-fullscreen id)) - (run-hooks 'exwm-manage-finish-hook))))) + (exwm-manage--update-default-directory id) + (when (or (plist-get exwm--configurations 'fullscreen) + (exwm-layout--fullscreen-p)) + (setq exwm--ewmh-state (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN + exwm--ewmh-state)) + (exwm-layout-set-fullscreen id)) + (run-hooks 'exwm-manage-finish-hook)))) (defun exwm-manage--unmanage-window (id &optional withdraw-only) "Unmanage window ID. If WITHDRAW-ONLY is non-nil, the X window will be properly placed back to the -root window. Set WITHDRAW-ONLY to 'quit if this functions is used when window +root window. Set WITHDRAW-ONLY to `quit' if this functions is used when window manager is shutting down." (let ((buffer (exwm--id->buffer id))) (exwm--log "Unmanage #x%x (buffer: %s, widthdraw: %s)" @@ -427,7 +444,9 @@ manager is shutting down." (exwm-workspace--update-workareas) (dolist (f exwm-workspace--list) (exwm-workspace--set-fullscreen f))) - (when (buffer-live-p buffer) + (when (and (buffer-live-p buffer) + ;; Invoked from `exwm-manage--exit' upon disconnection. + (slot-value exwm--connection 'connected)) (with-current-buffer buffer ;; Unmap the X window. (xcb:+request exwm--connection @@ -509,8 +528,11 @@ manager is shutting down." (defun exwm-manage--kill-buffer-query-function () "Run in `kill-buffer-query-functions'." - (exwm--log "id=#x%x; buffer=%s" exwm--id (current-buffer)) + (exwm--log "id=#x%x; buffer=%s" (or exwm--id 0) (current-buffer)) (catch 'return + (when (or (not exwm--connection) + (not (slot-value exwm--connection 'connected))) + (throw 'return t)) (when (or (not exwm--id) (xcb:+request-checked+request-check exwm--connection (make-instance 'xcb:ChangeWindowAttributes @@ -587,7 +609,8 @@ Would you like to kill it? " (throw 'return nil))))) (defun exwm-manage--kill-client (&optional id) - "Kill an X client." + "Kill X client ID. +If ID is nil, kill X window corresponding to current buffer." (unless id (setq id (exwm--buffer->id (current-buffer)))) (exwm--log "id=#x%x" id) (let* ((response (xcb:+request-unchecked+reply exwm--connection @@ -605,14 +628,16 @@ Would you like to kill it? " (xcb:flush exwm--connection))) (defun exwm-manage--add-frame (frame) - "Run in `after-make-frame-functions'." + "Run in `after-make-frame-functions'. +FRAME is the newly created frame." (exwm--log "frame=%s" frame) (when (display-graphic-p frame) (push (string-to-number (frame-parameter frame 'outer-window-id)) exwm-manage--frame-outer-id-list))) (defun exwm-manage--remove-frame (frame) - "Run in `delete-frame-functions'." + "Run in `delete-frame-functions'. +FRAME is the frame to be deleted." (exwm--log "frame=%s" frame) (when (display-graphic-p frame) (setq exwm-manage--frame-outer-id-list @@ -620,7 +645,8 @@ Would you like to kill it? " exwm-manage--frame-outer-id-list)))) (defun exwm-manage--on-ConfigureRequest (data _synthetic) - "Handle ConfigureRequest event." + "Handle ConfigureRequest event. +DATA contains unmarshalled ConfigureRequest event data." (exwm--log) (let ((obj (make-instance 'xcb:ConfigureRequest)) buffer edges width-delta height-delta) @@ -710,7 +736,8 @@ border-width: %d; sibling: #x%x; stack-mode: %d" (xcb:flush exwm--connection)) (defun exwm-manage--on-MapRequest (data _synthetic) - "Handle MapRequest event." + "Handle MapRequest event. +DATA contains unmarshalled MapRequest event data." (let ((obj (make-instance 'xcb:MapRequest))) (xcb:unmarshal obj data) (with-slots (parent window) obj @@ -730,7 +757,8 @@ border-width: %d; sibling: #x%x; stack-mode: %d" (exwm-manage--manage-window window)))))) (defun exwm-manage--on-UnmapNotify (data _synthetic) - "Handle UnmapNotify event." + "Handle UnmapNotify event. +DATA contains unmarshalled UnmapNotify event data." (let ((obj (make-instance 'xcb:UnmapNotify))) (xcb:unmarshal obj data) (with-slots (window) obj @@ -738,7 +766,8 @@ border-width: %d; sibling: #x%x; stack-mode: %d" (exwm-manage--unmanage-window window t)))) (defun exwm-manage--on-MapNotify (data _synthetic) - "Handle MapNotify event." + "Handle MapNotify event. +DATA contains unmarshalled MapNotify event data." (let ((obj (make-instance 'xcb:MapNotify))) (xcb:unmarshal obj data) (with-slots (window) obj @@ -763,7 +792,9 @@ border-width: %d; sibling: #x%x; stack-mode: %d" (xcb:flush exwm--connection))))) (defun exwm-manage--on-DestroyNotify (data synthetic) - "Handle DestroyNotify event." + "Handle DestroyNotify event. +DATA contains unmarshalled DestroyNotify event data. +SYNTHETIC indicates whether the event is a synthetic event." (unless synthetic (exwm--log) (let ((obj (make-instance 'xcb:DestroyNotify))) diff --git a/third_party/exwm/exwm-randr.el b/third_party/exwm/exwm-randr.el index 68bfdd70e9..7f0e50559b 100644 --- a/third_party/exwm/exwm-randr.el +++ b/third_party/exwm/exwm-randr.el @@ -1,6 +1,6 @@ ;;; exwm-randr.el --- RandR Module for EXWM -*- lexical-binding: t -*- -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -52,9 +52,10 @@ (require 'exwm-core) (require 'exwm-workspace) +(declare-function x-get-atom-name "C source code" (VALUE &optional FRAME)) + (defgroup exwm-randr nil "RandR." - :version "25.3" :group 'exwm) (defcustom exwm-randr-refresh-hook nil @@ -89,10 +90,6 @@ corresponding monitors whenever the monitors are active. \\='(1 \"HDMI-1\" 3 \"DP-1\")" :type '(plist :key-type integer :value-type string)) -(with-no-warnings - (define-obsolete-variable-alias 'exwm-randr-workspace-output-plist - 'exwm-randr-workspace-monitor-plist "27.1")) - (defvar exwm-randr--last-timestamp 0 "Used for debouncing events.") (defvar exwm-randr--prev-screen-change-seqnum nil @@ -267,9 +264,6 @@ In a mirroring setup some monitors overlap and should be treated as one." (xcb:flush exwm--connection) (run-hooks 'exwm-randr-refresh-hook)))) -(define-obsolete-function-alias 'exwm-randr--refresh #'exwm-randr-refresh - "27.1") - (defun exwm-randr--on-ScreenChangeNotify (data _synthetic) "Handle `ScreenChangeNotify' event. diff --git a/third_party/exwm/exwm-systemtray.el b/third_party/exwm/exwm-systemtray.el index 43b3e1eaef..9e57dae4eb 100644 --- a/third_party/exwm/exwm-systemtray.el +++ b/third_party/exwm/exwm-systemtray.el @@ -1,7 +1,7 @@ ;;; exwm-systemtray.el --- System Tray Module for -*- lexical-binding: t -*- ;;; EXWM -;; Copyright (C) 2016-2021 Free Software Foundation, Inc. +;; Copyright (C) 2016-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -30,6 +30,7 @@ ;;; Code: +(require 'xcb-ewmh) (require 'xcb-icccm) (require 'xcb-xembed) (require 'xcb-systemtray) @@ -37,6 +38,8 @@ (require 'exwm-core) (require 'exwm-workspace) +(declare-function exwm-workspace--workarea "exwm-workspace.el" (frame)) + (defclass exwm-systemtray--icon () ((width :initarg :width) (height :initarg :height) @@ -46,7 +49,7 @@ (defclass xcb:systemtray:-ClientMessage (xcb:icccm:--ClientMessage xcb:ClientMessage) ((format :initform 32) - (type :initform xcb:Atom:MANAGER) + (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 @@ -54,7 +57,6 @@ (defgroup exwm-systemtray nil "System tray." - :version "25.3" :group 'exwm) (defcustom exwm-systemtray-height nil @@ -67,44 +69,49 @@ 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 'workspace-background "Background color of systemtray. - -This should be a color, or nil for transparent background." - :type '(choice (const :tag "Transparent" nil) - (color)) +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) + (const :tag "Frame background" workspace-background) + (color :tag "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 `workspace-background' instead.") + (setq value 'workspace-background)) (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 @@ -113,7 +120,7 @@ This should be a color, or nil for transparent background." (defvar xcb:Atom:_NET_SYSTEM_TRAY_S0) (defun exwm-systemtray--embed (icon) - "Embed an icon." + "Embed an ICON." (exwm--log "Try to embed #x%x" icon) (let ((info (xcb:+request-unchecked+reply exwm-systemtray--connection (make-instance 'xcb:xembed:get-_XEMBED_INFO @@ -202,7 +209,7 @@ This should be a color, or nil for transparent background." (exwm-systemtray--refresh)))) (defun exwm-systemtray--unembed (icon) - "Unembed an icon." + "Unembed an ICON." (exwm--log "Unembed #x%x" icon) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:UnmapWindow :window icon)) @@ -234,14 +241,13 @@ This should be a color, or nil for transparent background." (setq x (+ x (slot-value (cdr pair) 'width) exwm-systemtray-icon-gap)) (setq map t))) - (let ((workarea (elt exwm-workspace--workareas - exwm-workspace-current-index))) + (let ((workarea (exwm-workspace--workarea exwm-workspace-current-index))) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ConfigureWindow :window exwm-systemtray--embedder-window :value-mask (logior xcb:ConfigWindow:X xcb:ConfigWindow:Width) - :x (- (aref workarea 2) x) + :x (- (slot-value workarea 'width) x) :width x))) (when map (xcb:+request exwm-systemtray--connection @@ -249,8 +255,83 @@ This should be a color, or nil for transparent background." :window exwm-systemtray--embedder-window)))) (xcb:flush exwm-systemtray--connection)) +(defun exwm-systemtray--refresh-background-color (&optional remap) + "Refresh background color after theme change or workspace switch. +If REMAP is not nil, map and unmap the embedder window so that the background is +redrawn." + ;; Only `workspace-background' is dependent on current theme and workspace. + (when (eq 'workspace-background exwm-systemtray-background-color) + (exwm-systemtray--set-background-color) + (when remap + (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)))) + +(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 `workspace-background' instead") + (face-background 'default exwm-workspace--current))) + (workspace-background + (face-background 'default exwm-workspace--current)) + (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." + "Unembed icons on DestroyNotify. +Argument DATA contains the raw event data." (exwm--log) (let ((obj (make-instance 'xcb:DestroyNotify))) (xcb:unmarshal obj data) @@ -259,7 +340,8 @@ This should be a color, or nil for transparent background." (exwm-systemtray--unembed window))))) (defun exwm-systemtray--on-ReparentNotify (data _synthetic) - "Unembed icons on ReparentNotify." + "Unembed icons on ReparentNotify. +Argument DATA contains the raw event data." (exwm--log) (let ((obj (make-instance 'xcb:ReparentNotify))) (xcb:unmarshal obj data) @@ -269,7 +351,8 @@ This should be a color, or nil for transparent background." (exwm-systemtray--unembed window))))) (defun exwm-systemtray--on-ResizeRequest (data _synthetic) - "Resize the tray icon on ResizeRequest." + "Resize the tray icon on ResizeRequest. +Argument DATA contains the raw event data." (exwm--log) (let ((obj (make-instance 'xcb:ResizeRequest)) attr) @@ -297,7 +380,8 @@ This should be a color, or nil for transparent background." (exwm-systemtray--refresh))))) (defun exwm-systemtray--on-PropertyNotify (data _synthetic) - "Map/Unmap the tray icon on PropertyNotify." + "Map/Unmap the tray icon on PropertyNotify. +Argument DATA contains the raw event data." (exwm--log) (let ((obj (make-instance 'xcb:PropertyNotify)) attr info visible) @@ -322,7 +406,8 @@ This should be a color, or nil for transparent background." (exwm-systemtray--refresh)))))) (defun exwm-systemtray--on-ClientMessage (data _synthetic) - "Handle client messages." + "Handle client messages. +Argument DATA contains the raw event data." (let ((obj (make-instance 'xcb:ClientMessage)) opcode data32) (xcb:unmarshal obj data) @@ -341,7 +426,8 @@ This should be a color, or nil for transparent background." (exwm--log "Unknown opcode message: %s" obj))))))) (defun exwm-systemtray--on-KeyPress (data _synthetic) - "Forward all KeyPress events to Emacs frame." + "Forward all KeyPress events to Emacs frame. +Argument DATA contains the raw event data." (exwm--log) ;; This function is only executed when there's no autohide minibuffer, ;; a workspace frame has the input focus and the pointer is over a @@ -370,13 +456,18 @@ This should be a color, or nil for transparent background." (frame-parameter exwm-workspace--current 'window-id)) :x 0 - :y (- (elt (elt exwm-workspace--workareas - exwm-workspace-current-index) - 3) + :y (- (slot-value (exwm-workspace--workarea + exwm-workspace-current-index) + 'height) exwm-workspace--frame-y-offset exwm-systemtray-height)))) + (exwm-systemtray--refresh-background-color) (exwm-systemtray--refresh)) +(defun exwm-systemtray--on-theme-change (_theme) + "Refresh system tray upon theme change." + (exwm-systemtray--refresh-background-color 'remap)) + (defun exwm-systemtray--refresh-all () "Reposition/Refresh the system tray." (exwm--log) @@ -386,9 +477,9 @@ This should be a color, or nil for transparent background." (make-instance 'xcb:ConfigureWindow :window exwm-systemtray--embedder-window :value-mask xcb:ConfigWindow:Y - :y (- (elt (elt exwm-workspace--workareas - exwm-workspace-current-index) - 3) + :y (- (slot-value (exwm-workspace--workarea + exwm-workspace-current-index) + 'height) exwm-workspace--frame-y-offset exwm-systemtray-height)))) (exwm-systemtray--refresh)) @@ -402,7 +493,8 @@ This should be a color, or nil for transparent background." (cl-assert (not exwm-systemtray--embedder-window)) (unless exwm-systemtray-height (setq exwm-systemtray-height (max exwm-systemtray--icon-min-size - (line-pixel-height)))) + (with-selected-window (minibuffer-window) + (line-pixel-height))))) ;; Create a new connection. (setq exwm-systemtray--connection (xcb:connect)) (set-process-query-on-exit-flag (slot-value exwm-systemtray--connection @@ -469,8 +561,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 @@ -482,20 +573,26 @@ This should be a color, or nil for transparent background." (exwm-workspace--update-offsets) (setq frame exwm-workspace--current ;; Bottom aligned. - y (- (elt (elt exwm-workspace--workareas - exwm-workspace-current-index) - 3) + y (- (slot-value (exwm-workspace--workarea + exwm-workspace-current-index) + 'height) 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 +601,29 @@ 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_WM_WINDOW_TYPE. + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ewmh:set-_NET_WM_WINDOW_TYPE + :window id + :data (vector xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK))) + ;; 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 @@ -536,6 +643,9 @@ This should be a color, or nil for transparent background." (add-hook 'exwm-workspace-switch-hook #'exwm-systemtray--on-workspace-switch) (add-hook 'exwm-workspace--update-workareas-hook #'exwm-systemtray--refresh-all) + ;; Add hook to update background colors. + (add-hook 'enable-theme-functions #'exwm-systemtray--on-theme-change) + (add-hook 'disable-theme-functions #'exwm-systemtray--on-theme-change) (add-hook 'menu-bar-mode-hook #'exwm-systemtray--refresh-all) (add-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all) (when (boundp 'exwm-randr-refresh-hook) @@ -548,27 +658,31 @@ This should be a color, or nil for transparent background." "Exit the systemtray module." (exwm--log) (when exwm-systemtray--connection - ;; Hide & reparent out the embedder before disconnection to prevent - ;; embedded icons from being reparented to an Emacs frame (which is the - ;; parent of the embedder). - (xcb:+request exwm-systemtray--connection - (make-instance 'xcb:UnmapWindow - :window exwm-systemtray--embedder-window)) - (xcb:+request exwm-systemtray--connection - (make-instance 'xcb:ReparentWindow - :window exwm-systemtray--embedder-window - :parent exwm--root - :x 0 - :y 0)) - (xcb:disconnect exwm-systemtray--connection) + (when (slot-value exwm-systemtray--connection 'connected) + ;; Hide & reparent out the embedder before disconnection to prevent + ;; embedded icons from being reparented to an Emacs frame (which is the + ;; parent of the embedder). + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:UnmapWindow + :window exwm-systemtray--embedder-window)) + (xcb:+request exwm-systemtray--connection + (make-instance 'xcb:ReparentWindow + :window exwm-systemtray--embedder-window + :parent exwm--root + :x 0 + :y 0)) + (xcb:disconnect exwm-systemtray--connection)) (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 #'exwm-systemtray--refresh-all) + (remove-hook 'enable-theme-functions #'exwm-systemtray--on-theme-change) + (remove-hook 'disable-theme-functions #'exwm-systemtray--on-theme-change) (remove-hook 'menu-bar-mode-hook #'exwm-systemtray--refresh-all) (remove-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all) (when (boundp 'exwm-randr-refresh-hook) diff --git a/third_party/exwm/exwm-workspace.el b/third_party/exwm/exwm-workspace.el index fc68e1b070..89be697159 100644 --- a/third_party/exwm/exwm-workspace.el +++ b/third_party/exwm/exwm-workspace.el @@ -1,6 +1,6 @@ ;;; exwm-workspace.el --- Workspace Module for EXWM -*- lexical-binding: t -*- -;; Copyright (C) 1015-2021 Free Software Foundation, Inc. +;; Copyright (C) 1015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -31,7 +31,6 @@ (defgroup exwm-workspace nil "Workspace." - :version "25.3" :group 'exwm) (defcustom exwm-workspace-switch-hook nil @@ -39,8 +38,8 @@ :type 'hook) (defcustom exwm-workspace-list-change-hook nil - "Normal hook run when the workspace list is changed (workspace added, -deleted, moved, etc)." + "Normal hook run when the workspace list is changed. +This happens when a workspace is added, deleted, moved, etc." :type 'hook) (defcustom exwm-workspace-show-all-buffers nil @@ -74,8 +73,7 @@ A restart is required for this change to take effect." :type 'integer) (defcustom exwm-workspace-switch-create-limit 10 - "Number of workspaces `exwm-workspace-switch-create' allowed to create -each time." + "Number of workspaces `exwm-workspace-switch-create' is allowed to create." :type 'integer) (defvar exwm-workspace-current-index 0 "Index of current active workspace.") @@ -85,9 +83,6 @@ each time." If the minibuffer is detached, this value is 0.") -(defvar exwm-workspace--client nil - "The 'client' frame parameter of emacsclient frames.") - (defvar exwm-workspace--create-silently nil "When non-nil workspaces are created in the background (not switched to). @@ -153,8 +148,8 @@ Please manually run the hook `exwm-workspace-list-change-hook' afterwards.") (defsubst exwm-workspace--position (frame) "Retrieve index of given FRAME in workspace list. - -NIL if FRAME is not a workspace" +NIL if FRAME is not a workspace." + (declare (indent defun)) (cl-position frame exwm-workspace--list)) (defsubst exwm-workspace--count () @@ -163,28 +158,23 @@ NIL if FRAME is not a workspace" (defsubst exwm-workspace--workspace-p (frame) "Return t if FRAME is a workspace." + (declare (indent defun)) (memq frame exwm-workspace--list)) -(defvar exwm-workspace--client-p-hash-table - (make-hash-table :test 'eq :weakness 'key) - "Used to cache the results of calling ‘exwm-workspace--client-p’.") - -(defsubst exwm-workspace--client-p (&optional frame) - "Return non-nil if FRAME is an emacsclient frame." - (let* ((frame (or frame (selected-frame))) - (cached-value - (gethash frame exwm-workspace--client-p-hash-table 'absent))) - (if (eq cached-value 'absent) - (puthash frame - (or (frame-parameter frame 'client) - (not (display-graphic-p frame))) - exwm-workspace--client-p-hash-table) - cached-value))) +(defsubst exwm-workspace--workarea (frame) + "Return workarea corresponding to FRAME. +FRAME may be either a workspace frame or a workspace position." + (declare (indent defun)) + (elt exwm-workspace--workareas + (if (integerp frame) + frame + (exwm-workspace--position frame)))) (defvar exwm-workspace--switch-map nil "Keymap used for interactively selecting workspace.") (defun exwm-workspace--init-switch-map () + "Initialize variable `exwm-workspace--switch-map'." (let ((map (make-sparse-keymap))) (define-key map [t] (lambda () (interactive))) (define-key map "+" #'exwm-workspace--prompt-add) @@ -235,7 +225,8 @@ NIL if FRAME is not a workspace" (t (user-error "[EXWM] Invalid workspace: %s" frame-or-index)))) (defun exwm-workspace--prompt-for-workspace (&optional prompt) - "Prompt for a workspace, returning the workspace frame." + "Prompt for a workspace, returning the workspace frame. +Show PROMPT to the user if non-nil." (exwm-workspace--update-switch-history) (let* ((current-idx (exwm-workspace--position exwm-workspace--current)) (history-add-new-input nil) ;prevent modifying history @@ -264,7 +255,6 @@ NIL if FRAME is not a workspace" (when (and exwm-workspace--prompt-delete-allowed (< 1 (exwm-workspace--count))) (let ((frame (elt exwm-workspace--list (1- minibuffer-history-position)))) - (exwm-workspace--get-remove-frame-next-workspace frame) (if (eq frame exwm-workspace--current) ;; Abort the recursive minibuffer if deleting the current workspace. (progn @@ -351,63 +341,69 @@ NIL if FRAME is not a workspace" (defun exwm-workspace--update-workareas () "Update `exwm-workspace--workareas'." - (let ((root-width (x-display-pixel-width)) - (root-height (x-display-pixel-height)) - workareas - edge width position - delta) - ;; Calculate workareas with no struts. - (if (frame-parameter (car exwm-workspace--list) 'exwm-geometry) - ;; Use the 'exwm-geometry' frame parameter if possible. - (dolist (f exwm-workspace--list) - (with-slots (x y width height) (frame-parameter f 'exwm-geometry) - (setq workareas (append workareas - (list (vector x y width height)))))) - ;; Fall back to use the screen size. - (let ((workarea (vector 0 0 root-width root-height))) - (setq workareas (make-list (exwm-workspace--count) workarea)))) + (let* ((root-width (x-display-pixel-width)) + (root-height (x-display-pixel-height)) + ;; Get workareas prior to struts. + (workareas (mapcar + (lambda (frame) + (if-let (rect (frame-parameter frame 'exwm-geometry)) + ;; Use the 'exwm-geometry' frame parameter if it + ;; exists. Make sure to clone it, will be modified + ;; below! + (clone rect) + ;; Fall back to use the screen size. + (make-instance 'xcb:RECTANGLE + :x 0 + :y 0 + :width root-width + :height root-height))) + exwm-workspace--list))) ;; Exclude areas occupied by struts. (dolist (struts exwm-workspace--struts) - (setq edge (aref struts 0) - width (aref struts 1) - position (aref struts 2)) - (dolist (w workareas) - (pcase edge - ;; Left and top are always processed first. - (`left - (setq delta (- (aref w 0) width)) - (when (and (< delta 0) - (or (not position) - (< (max (aref position 0) (aref w 1)) - (min (aref position 1) - (+ (aref w 1) (aref w 3)))))) - (cl-incf (aref w 2) delta) - (setf (aref w 0) width))) - (`right - (setq delta (- root-width (aref w 0) (aref w 2) width)) - (when (and (< delta 0) - (or (not position) - (< (max (aref position 0) (aref w 1)) - (min (aref position 1) - (+ (aref w 1) (aref w 3)))))) - (cl-incf (aref w 2) delta))) - (`top - (setq delta (- (aref w 1) width)) - (when (and (< delta 0) - (or (not position) - (< (max (aref position 0) (aref w 0)) - (min (aref position 1) - (+ (aref w 0) (aref w 2)))))) - (cl-incf (aref w 3) delta) - (setf (aref w 1) width))) - (`bottom - (setq delta (- root-height (aref w 1) (aref w 3) width)) - (when (and (< delta 0) - (or (not position) - (< (max (aref position 0) (aref w 0)) - (min (aref position 1) - (+ (aref w 0) (aref w 2)))))) - (cl-incf (aref w 3) delta)))))) + (let* ((edge (aref struts 0)) + (size (aref struts 1)) + (position (aref struts 2)) + (beg (and position (aref position 0))) + (end (and position (aref position 1))) + delta) + (dolist (w workareas) + (with-slots (x y width height) w + (pcase edge + ;; Left and top are always processed first. + ('left + (setq delta (- size x)) + (when (and (< 0 delta) + (< delta width) + (or (not position) + (< (max beg y) + (min end (+ y height))))) + (cl-decf width delta) + (setf x size))) + ('right + (setq delta (- size (- root-width x width))) + (when (and (< 0 delta) + (< delta width) + (or (not position) + (< (max beg y) + (min end (+ y height))))) + (cl-decf width delta))) + ('top + (setq delta (- size y)) + (when (and (< 0 delta) + (< delta height) + (or (not position) + (< (max beg x) + (min end (+ x width))))) + (cl-decf height delta) + (setf y size))) + ('bottom + (setq delta (- size (- root-height y height))) + (when (and (< 0 delta) + (< delta height) + (or (not position) + (< (max beg x) + (min end (+ x width))))) + (cl-decf height delta)))))))) ;; Save the result. (setq exwm-workspace--workareas workareas) (xcb:flush exwm--connection)) @@ -443,8 +439,9 @@ NIL if FRAME is not a workspace" exwm-workspace--window-y-offset (- (elt edges 1) y)))))))) (defun exwm-workspace--set-active (frame active) - "Make frame FRAME active on its monitor." - (exwm--log "active=%s; frame=%s" frame active) + "Make frame FRAME active on its monitor. +ACTIVE indicates whether to set the frame active or inactive." + (exwm--log "active=%s; frame=%s" active frame) (set-frame-parameter frame 'exwm-active active) (if active (exwm-workspace--set-fullscreen frame) @@ -453,30 +450,25 @@ NIL if FRAME is not a workspace" (xcb:flush exwm--connection)) (defun exwm-workspace--active-p (frame) - "Return non-nil if FRAME is active" + "Return non-nil if FRAME is active." (frame-parameter frame 'exwm-active)) (defun exwm-workspace--set-fullscreen (frame) "Make frame FRAME fullscreen according to `exwm-workspace--workareas'." (exwm--log "frame=%s" frame) - (let ((workarea (elt exwm-workspace--workareas - (exwm-workspace--position frame))) - (id (frame-parameter frame 'exwm-outer-id)) - (container (frame-parameter frame 'exwm-container)) - x y width height) - (setq x (aref workarea 0) - y (aref workarea 1) - width (aref workarea 2) - height (aref workarea 3)) - (exwm--log "x=%s; y=%s; w=%s; h=%s" x y width height) - (when (and (eq frame exwm-workspace--current) - (exwm-workspace--minibuffer-own-frame-p)) - (exwm-workspace--resize-minibuffer-frame)) - (if (exwm-workspace--active-p frame) - (exwm--set-geometry container x y width height) - (exwm--set-geometry container x y 1 1)) - (exwm--set-geometry id nil nil width height) - (xcb:flush exwm--connection)) + (let ((id (frame-parameter frame 'exwm-outer-id)) + (container (frame-parameter frame 'exwm-container))) + (with-slots (x y width height) + (exwm-workspace--workarea frame) + (exwm--log "x=%s; y=%s; w=%s; h=%s" x y width height) + (when (and (eq frame exwm-workspace--current) + (exwm-workspace--minibuffer-own-frame-p)) + (exwm-workspace--resize-minibuffer-frame)) + (if (exwm-workspace--active-p frame) + (exwm--set-geometry container x y width height) + (exwm--set-geometry container x y 1 1)) + (exwm--set-geometry id nil nil width height) + (xcb:flush exwm--connection))) ;; This is only used for workspace initialization. (when exwm-workspace--fullscreen-frame-count (cl-incf exwm-workspace--fullscreen-frame-count))) @@ -484,20 +476,20 @@ NIL if FRAME is not a workspace" (defun exwm-workspace--resize-minibuffer-frame () "Resize minibuffer (and its container) to fit the size of workspace." (cl-assert (exwm-workspace--minibuffer-own-frame-p)) - (let ((workarea (elt exwm-workspace--workareas exwm-workspace-current-index)) + (let ((workarea (exwm-workspace--workarea exwm-workspace-current-index)) (container (frame-parameter exwm-workspace--minibuffer 'exwm-container)) y width) (setq y (if (eq exwm-workspace-minibuffer-position 'top) - (- (aref workarea 1) + (- (slot-value workarea 'y) exwm-workspace--attached-minibuffer-height) ;; Reset the frame size. (set-frame-height exwm-workspace--minibuffer 1) (redisplay) ;FIXME. - (+ (aref workarea 1) (aref workarea 3) + (+ (slot-value workarea 'y) (slot-value workarea 'height) (- (frame-pixel-height exwm-workspace--minibuffer)) exwm-workspace--attached-minibuffer-height)) - width (aref workarea 2)) + width (slot-value workarea 'width)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window container @@ -508,7 +500,7 @@ NIL if FRAME is not a workspace" xcb:ConfigWindow:Sibling 0) xcb:ConfigWindow:StackMode) - :x (aref workarea 0) + :x (slot-value workarea 'x) :y y :width width :sibling exwm-manage--desktop @@ -571,11 +563,13 @@ PREFIX-DIGITS is a list of the digits introduced so far." ;;;###autoload (defun exwm-workspace-switch (frame-or-index &optional force) - "Switch to workspace INDEX (0-based). + "Switch to workspace FRAME-OR-INDEX (0-based). Query for the index if not specified when called interactively. Passing a workspace frame as the first option or making use of the rest options are -for internal use only." +for internal use only. + +When FORCE is true, allow switching to current workspace." (interactive (list (cond @@ -701,7 +695,7 @@ for internal use only." ;;;###autoload (defun exwm-workspace-switch-create (frame-or-index) - "Switch to workspace INDEX or creating it first if it does not exist yet. + "Switch to workspace FRAME-OR-INDEX creating it first non-existent. Passing a workspace frame as the first option is for internal use only." (interactive @@ -830,7 +824,6 @@ INDEX must not exceed the current number of workspaces." (exwm-workspace--workspace-from-frame-or-index frame-or-index) exwm-workspace--current))) - (exwm-workspace--get-remove-frame-next-workspace frame) (delete-frame frame)))) (defun exwm-workspace--set-desktop (id) @@ -988,7 +981,7 @@ INDEX must not exceed the current number of workspaces." ;;;###autoload (defun exwm-workspace-switch-to-buffer (buffer-or-name) - "Make the current Emacs window display another buffer." + "Make selected window display BUFFER-OR-NAME." (interactive (let ((inhibit-quit t)) ;; Show all buffers @@ -1040,7 +1033,7 @@ INDEX must not exceed the current number of workspaces." (switch-to-buffer buffer-or-name))))) (defun exwm-workspace-rename-buffer (newname) - "Rename a buffer." + "Rename current buffer to NEWNAME." (let ((hidden (= ?\s (aref newname 0))) (basename (replace-regexp-in-string "<[0-9]+>$" "" newname)) (counter 1) @@ -1056,10 +1049,12 @@ INDEX must not exceed the current number of workspaces." buffer-list-update-hook))) (rename-buffer (concat (and hidden " ") newname))))) -(defun exwm-workspace--x-create-frame (orig-fun params) - "Set override-redirect on the frame created by `x-create-frame'." +(defun exwm-workspace--x-create-frame (orig-x-create-frame params) + "Set override-redirect on the frame created by `x-create-frame'. +ORIG-X-CREATE-FRAME is the advised function `x-create-frame'. +PARAMS are the original arguments." (exwm--log) - (let ((frame (funcall orig-fun params))) + (let ((frame (funcall orig-x-create-frame params))) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window (string-to-number @@ -1078,7 +1073,7 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." ;;;###autoload (defun exwm-workspace-attach-minibuffer () - "Attach the minibuffer so that it always shows." + "Attach the minibuffer making it always visible." (interactive) (exwm--log) (when (and (exwm-workspace--minibuffer-own-frame-p) @@ -1130,8 +1125,10 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (exwm-workspace-attach-minibuffer)))) (defun exwm-workspace--update-minibuffer-height (&optional echo-area) - "Update the minibuffer frame height." - (unless (exwm-workspace--client-p) + "Update the minibuffer frame height. +When ECHO-AREA is non-nil, take the size of the echo area into +account when calculating the height." + (when (exwm--terminal-p) (let ((height (with-current-buffer (window-buffer (minibuffer-window exwm-workspace--minibuffer)) @@ -1153,9 +1150,9 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (set-frame-height exwm-workspace--minibuffer height)))) (defun exwm-workspace--on-ConfigureNotify (data _synthetic) - "Adjust the container to fit the minibuffer frame." - (let ((obj (make-instance 'xcb:ConfigureNotify)) - workarea y) + "Adjust the container to fit the minibuffer frame. +DATA contains unmarshalled ConfigureNotify event data." + (let ((obj (make-instance 'xcb:ConfigureNotify)) y) (xcb:unmarshal obj data) (with-slots (window height) obj (when (eq (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id) @@ -1175,13 +1172,13 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (when (/= (exwm-workspace--count) (length exwm-workspace--workareas)) ;; There is a chance the workareas are not updated timely. (exwm-workspace--update-workareas)) - (setq workarea (elt exwm-workspace--workareas - exwm-workspace-current-index) - y (if (eq exwm-workspace-minibuffer-position 'top) - (- (aref workarea 1) - exwm-workspace--attached-minibuffer-height) - (+ (aref workarea 1) (aref workarea 3) (- height) - exwm-workspace--attached-minibuffer-height))) + (with-slots ((y* y) (height* height)) + (exwm-workspace--workarea exwm-workspace-current-index) + (setq y (if (eq exwm-workspace-minibuffer-position 'top) + (- y* + exwm-workspace--attached-minibuffer-height) + (+ y* height* (- height) + exwm-workspace--attached-minibuffer-height)))) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm-workspace--minibuffer @@ -1193,7 +1190,8 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (xcb:flush exwm--connection))))) (defun exwm-workspace--display-buffer (buffer alist) - "Display BUFFER as if the current workspace is selected." + "Display BUFFER as if the current workspace were selected. +ALIST is an action alist, as accepted by function `display-buffer'." ;; Only when the floating minibuffer frame is selected. ;; This also protect this functions from being recursively called. (when (eq (selected-frame) exwm-workspace--minibuffer) @@ -1245,10 +1243,10 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (xcb:flush exwm--connection)) (defun exwm-workspace--on-minibuffer-setup () - "Run in minibuffer-setup-hook to show the minibuffer and its container." + "Run in `minibuffer-setup-hook' to show the minibuffer and its container." (exwm--log) (when (and (= 1 (minibuffer-depth)) - (not (exwm-workspace--client-p))) + (exwm--terminal-p)) (add-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height) (exwm-workspace--show-minibuffer)) ;; FIXME: This is a temporary fix for the *Completions* buffer not @@ -1267,19 +1265,19 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (window-preserve-size window))))) (defun exwm-workspace--on-minibuffer-exit () - "Run in minibuffer-exit-hook to hide the minibuffer container." + "Run in `minibuffer-exit-hook' to hide the minibuffer container." (exwm--log) (when (and (= 1 (minibuffer-depth)) - (not (exwm-workspace--client-p))) + (exwm--terminal-p)) (remove-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height) (exwm-workspace--hide-minibuffer))) (defun exwm-workspace--on-echo-area-dirty () "Run when new message arrives to show the echo area and its container." (when (and (not (active-minibuffer-window)) - (not (exwm-workspace--client-p)) (or (current-message) - cursor-in-echo-area)) + cursor-in-echo-area) + (exwm--terminal-p)) (exwm-workspace--update-minibuffer-height t) (exwm-workspace--show-minibuffer) (unless (or (not exwm-workspace-display-echo-area-timeout) @@ -1301,8 +1299,8 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." #'exwm-workspace--echo-area-maybe-clear)))) (defun exwm-workspace--on-echo-area-clear () - "Run in echo-area-clear-hook to hide echo area container." - (unless (exwm-workspace--client-p) + "Run in `echo-area-clear-hook' to hide echo area container." + (when (exwm--terminal-p) (unless (active-minibuffer-window) (exwm-workspace--hide-minibuffer)) (when exwm-workspace--display-echo-area-timer @@ -1332,8 +1330,6 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (set-frame-parameter frame 'exwm-outer-id outer-id) (set-frame-parameter frame 'exwm-id window-id) (set-frame-parameter frame 'exwm-container container) - ;; In case it's created by emacsclient. - (set-frame-parameter frame 'client nil) ;; Copy RandR frame parameters from the first workspace to ;; prevent potential problems. The values do not matter here as ;; they'll be updated by the RandR module later. @@ -1392,7 +1388,7 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (make-instance 'xcb:MapWindow :window container))) (xcb:flush exwm--connection) ;; Delay making the workspace fullscreen until Emacs becomes idle - (exwm--defer 0 #'set-frame-parameter frame 'fullscreen 'fullboth) + (exwm--defer 0 #'exwm-workspace--fullscreen-workspace frame) ;; Update EWMH properties. (exwm-workspace--update-ewmh-props) (if exwm-workspace--create-silently @@ -1403,41 +1399,44 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." frame exwm-workspace-current-index original-index)) (run-hooks 'exwm-workspace-list-change-hook))) -(defun exwm-workspace--get-remove-frame-next-workspace (frame) - "Return the next workspace if workspace FRAME is removed. - -All X windows currently on workspace FRAME will be automatically moved to -the next workspace." +(defun exwm-workspace--get-next-workspace (frame) + "Return the next workspace if workspace FRAME were removed. +Return nil if FRAME is the only workspace." (let* ((index (exwm-workspace--position frame)) (lastp (= index (1- (exwm-workspace--count)))) (nextw (elt exwm-workspace--list (+ index (if lastp -1 +1))))) - ;; Clients need to be moved to some other workspace before this being - ;; removed. - (dolist (pair exwm--id-buffer-alist) - (with-current-buffer (cdr pair) - (when (eq exwm--frame frame) - (exwm-workspace-move-window nextw exwm--id)))) - nextw)) - -(defun exwm-workspace--remove-frame-as-workspace (frame) - "Stop treating frame FRAME as a workspace." + (unless (eq frame nextw) + nextw))) + +(defun exwm-workspace--remove-frame-as-workspace (frame &optional quit) + "Stop treating FRAME as a workspace. +When QUIT is non-nil cleanup avoid communicating with the X server." ;; TODO: restore all frame parameters (e.g. exwm-workspace, buffer-predicate, ;; etc) (exwm--log "Removing frame `%s' as workspace" frame) - (let* ((index (exwm-workspace--position frame)) - (nextw (exwm-workspace--get-remove-frame-next-workspace frame))) - ;; Need to remove the workspace from the list in order for - ;; the correct calculation of indexes. - (setq exwm-workspace--list (delete frame exwm-workspace--list)) - ;; Update the _NET_WM_DESKTOP property of each X window affected. - (dolist (pair exwm--id-buffer-alist) - (when (<= (1- index) - (exwm-workspace--position (buffer-local-value 'exwm--frame - (cdr pair)))) - (exwm-workspace--set-desktop (car pair)))) - ;; If the current workspace is deleted, switch to next one. - (when (eq frame exwm-workspace--current) - (exwm-workspace-switch nextw))) + (unless quit + (let* ((next-frame (exwm-workspace--get-next-workspace frame)) + (following-frames (cdr (memq frame exwm-workspace--list)))) + ;; Need to remove the workspace from the list for the correct calculation of + ;; indexes below. + (setq exwm-workspace--list (delete frame exwm-workspace--list)) + ;; Move the windows to the next workspace and switch to it. + (unless next-frame + ;; The user managed to delete the last workspace, so create a new one. + (exwm--log "Last workspace deleted; create a new one") + (let ((exwm-workspace--create-silently t)) + (setq next-frame (make-frame)))) + (dolist (pair exwm--id-buffer-alist) + (let ((other-frame (buffer-local-value 'exwm--frame (cdr pair)))) + ;; Move X windows to next-frame. + (when (eq other-frame frame) + (exwm-workspace-move-window next-frame (car pair))) + ;; Update the _NET_WM_DESKTOP property of each following X window. + (when (memq other-frame following-frames) + (exwm-workspace--set-desktop (car pair))))) + ;; If the current workspace is deleted, switch to next one. + (when (eq frame exwm-workspace--current) + (exwm-workspace-switch next-frame)))) ;; Reparent out the frame. (let ((outer-id (frame-parameter frame 'exwm-outer-id))) (xcb:+request exwm--connection @@ -1471,24 +1470,23 @@ the next workspace." ;; Update EWMH properties. (exwm-workspace--update-ewmh-props) ;; Update switch history. - (setq exwm-workspace--switch-history-outdated t) - (run-hooks 'exwm-workspace-list-change-hook)) + (unless quit + (setq exwm-workspace--switch-history-outdated t) + (run-hooks 'exwm-workspace-list-change-hook))) (defun exwm-workspace--on-delete-frame (frame) - "Hook run upon `delete-frame' that tears down FRAME's configuration as a workspace." + "Hook run upon `delete-frame' removing FRAME as a workspace." (cond ((not (exwm-workspace--workspace-p frame)) (exwm--log "Frame `%s' is not a workspace" frame)) (t - (when (= 1 (exwm-workspace--count)) - ;; The user managed to delete the last workspace, so create a new one. - (exwm--log "Last workspace deleted; create a new one") - ;; TODO: this makes sense in the hook. But we need a function that takes - ;; care of converting a workspace into a regular unmanaged frame. - (let ((exwm-workspace--create-silently t)) - (make-frame))) - (exwm-workspace--remove-frame-as-workspace frame) - (remhash frame exwm-workspace--client-p-hash-table)))) + (exwm-workspace--remove-frame-as-workspace frame)))) + +(defun exwm-workspace--fullscreen-workspace (frame) + "Make workspace FRAME fullscreen. +Called from a timer." + (when (frame-live-p frame) + (set-frame-parameter frame 'fullscreen 'fullboth))) (defun exwm-workspace--on-after-make-frame (frame) "Hook run upon `make-frame' that configures FRAME as a workspace." @@ -1497,6 +1495,11 @@ the next workspace." (exwm--log "Frame `%s' is already a workspace" frame)) ((not (display-graphic-p frame)) (exwm--log "Frame `%s' is not graphical" frame)) + ((not (eq (frame-terminal) exwm--terminal)) + (exwm--log "Frame `%s' is on a different terminal (%S instead of %S)" + frame + (frame-terminal frame) + exwm--terminal)) ((not (string-equal (replace-regexp-in-string "\\.0$" "" (slot-value exwm--connection 'display)) @@ -1557,13 +1560,13 @@ applied to all subsequently created X frames." (interactive "e")) (defun exwm-workspace--init-minibuffer-frame () + "Initialize minibuffer-only frame." (exwm--log) ;; Initialize workspaces without minibuffers. (setq exwm-workspace--minibuffer (make-frame '((window-system . x) (minibuffer . only) (left . 10000) (right . 10000) - (width . 1) (height . 1) - (client . nil)))) + (width . 1) (height . 1)))) ;; This is the only usable minibuffer frame. (setq default-minibuffer-frame exwm-workspace--minibuffer) (exwm-workspace--modify-all-x-frames-parameters @@ -1628,11 +1631,14 @@ applied to all subsequently created X frames." :test #'equal)) (defun exwm-workspace--exit-minibuffer-frame () + "Cleanup minibuffer-only frame." (exwm--log) ;; Only on minibuffer-frame. (remove-hook 'minibuffer-setup-hook #'exwm-workspace--on-minibuffer-setup) (remove-hook 'minibuffer-exit-hook #'exwm-workspace--on-minibuffer-exit) (remove-hook 'echo-area-clear-hook #'exwm-workspace--on-echo-area-clear) + (when exwm-workspace--display-echo-area-timer + (cancel-timer exwm-workspace--display-echo-area-timer)) (when exwm-workspace--timer (cancel-timer exwm-workspace--timer) (setq exwm-workspace--timer nil)) @@ -1640,15 +1646,18 @@ applied to all subsequently created X frames." (cl-delete '(exwm-workspace--display-buffer) display-buffer-alist :test #'equal)) (setq default-minibuffer-frame nil) - (let ((id (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id))) - (when (and exwm-workspace--minibuffer id) - (xcb:+request exwm--connection - (make-instance 'xcb:ReparentWindow - :window id - :parent exwm--root - :x 0 - :y 0))) - (setq exwm-workspace--minibuffer nil))) + (when (frame-live-p exwm-workspace--minibuffer) ; might be already dead + (let ((id (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id))) + (when (and exwm-workspace--minibuffer id + ;; Invoked from `exwm-manage--exit' upon disconnection. + (slot-value exwm--connection 'connected)) + (xcb:+request exwm--connection + (make-instance 'xcb:ReparentWindow + :window id + :parent exwm--root + :x 0 + :y 0))) + (setq exwm-workspace--minibuffer nil)))) (defun exwm-workspace--init () "Initialize workspace module." @@ -1666,33 +1675,22 @@ applied to all subsequently created X frames." (dolist (i initial-workspaces) (unless (frame-parameter i 'window-id) (setq initial-workspaces (delq i initial-workspaces)))) - (setq exwm-workspace--client - (frame-parameter (car initial-workspaces) 'client)) (let ((f (car initial-workspaces))) ;; Remove the possible internal border. - (set-frame-parameter f 'internal-border-width 0) - ;; Prevent user from deleting the first frame by accident. - (set-frame-parameter f 'client nil))) + (set-frame-parameter f 'internal-border-width 0))) (exwm-workspace--init-minibuffer-frame) ;; Remove/hide existing frames. (dolist (f initial-workspaces) - (if (frame-parameter f 'client) - (progn - (unless exwm-workspace--client - (setq exwm-workspace--client (frame-parameter f 'client))) - (make-frame-invisible f)) - (when (eq 'x (framep f)) ;do not delete the initial frame. - (delete-frame f)))) + (when (eq 'x (framep f)) ;do not delete the initial frame. + (delete-frame f))) ;; Recreate one frame with the external minibuffer set. - (setq initial-workspaces (list (make-frame '((window-system . x) - (client . nil)))))) + (setq initial-workspaces (list (make-frame '((window-system . x)))))) ;; Prevent `other-buffer' from selecting already displayed EXWM buffers. (modify-all-frames-parameters '((buffer-predicate . exwm-layout--other-buffer-predicate))) ;; Create remaining workspaces. (dotimes (_ (- exwm-workspace-number (length initial-workspaces))) - (nconc initial-workspaces (list (make-frame '((window-system . x) - (client . nil)))))) + (nconc initial-workspaces (list (make-frame '((window-system . x)))))) ;; Configure workspaces (let ((exwm-workspace--create-silently t)) (dolist (i initial-workspaces) @@ -1737,36 +1735,26 @@ applied to all subsequently created X frames." #'exwm-workspace--on-echo-area-clear)) ;; Hide & reparent out all frames (save-set can't be used here since ;; X windows will be re-mapped). + (when (slot-value exwm--connection 'connected) + (dolist (i exwm-workspace--list) + (when (frame-live-p i) ; might be already dead + (exwm-workspace--remove-frame-as-workspace i 'quit) + (modify-frame-parameters i '((exwm-selected-window . nil) + (exwm-urgency . nil) + (exwm-outer-id . nil) + (exwm-id . nil) + (exwm-container . nil) + ;; (internal-border-width . nil) ; integerp + (fullscreen . nil) + (buffer-predicate . nil)))))) + ;; Don't let dead frames linger. (setq exwm-workspace--current nil) - (dolist (i exwm-workspace--list) - (exwm-workspace--remove-frame-as-workspace i) - (modify-frame-parameters i '((exwm-selected-window . nil) - (exwm-urgency . nil) - (exwm-outer-id . nil) - (exwm-id . nil) - (exwm-container . nil) - ;; (internal-border-width . nil) ; integerp - ;; (client . nil) - (fullscreen . nil) - (buffer-predicate . nil)))) - ;; Restore the 'client' frame parameter (before `exwm-exit'). - (when exwm-workspace--client - (dolist (f exwm-workspace--list) - (set-frame-parameter f 'client exwm-workspace--client)) - (when (exwm-workspace--minibuffer-own-frame-p) - (set-frame-parameter exwm-workspace--minibuffer 'client - exwm-workspace--client)) - (setq exwm-workspace--client nil))) + (setq exwm-workspace-current-index 0) + (setq exwm-workspace--list nil)) (defun exwm-workspace--post-init () "The second stage in the initialization of the workspace module." (exwm--log) - (when exwm-workspace--client - ;; Reset the 'fullscreen' frame parameter to make emacsclinet frames - ;; fullscreen (even without the RandR module enabled). - (dolist (i exwm-workspace--list) - (set-frame-parameter i 'fullscreen nil) - (set-frame-parameter i 'fullscreen 'fullboth))) ;; Wait until all workspace frames are resized. (with-timeout (1) (while (< exwm-workspace--fullscreen-frame-count (exwm-workspace--count)) diff --git a/third_party/exwm/exwm-xim.el b/third_party/exwm/exwm-xim.el index 9589648d22..1f0c9c460b 100644 --- a/third_party/exwm/exwm-xim.el +++ b/third_party/exwm/exwm-xim.el @@ -1,6 +1,6 @@ ;;; exwm-xim.el --- XIM Module for EXWM -*- lexical-binding: t -*- -;; Copyright (C) 2019-2021 Free Software Foundation, Inc. +;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -68,7 +68,7 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'xcb-keysyms) (require 'xcb-xim) @@ -167,6 +167,7 @@ C,no" (defun exwm-xim--on-SelectionRequest (data _synthetic) "Handle SelectionRequest events on IMS window. +DATA contains unmarshalled SelectionRequest event data. Such events would be received when clients query for LOCALES or TRANSPORT." (exwm--log) @@ -754,10 +755,12 @@ Such event would be received when the client window is destroyed." ;; Close IMS communication connections. (mapc (lambda (i) (when (vectorp i) - (xcb:disconnect (elt i 0)))) + (when (slot-value (elt i 0) 'connected) + (xcb:disconnect (elt i 0))))) exwm-xim--server-client-plist) ;; Close the IMS connection. - (unless exwm-xim--conn + (unless (and exwm-xim--conn + (slot-value exwm-xim--conn 'connected)) (cl-return-from exwm-xim--exit)) ;; Remove exwm-xim from XIM_SERVERS. (let ((reply (xcb:+request-unchecked+reply exwm-xim--conn diff --git a/third_party/exwm/exwm-xsettings.el b/third_party/exwm/exwm-xsettings.el new file mode 100644 index 0000000000..99d6b9c4ac --- /dev/null +++ b/third_party/exwm/exwm-xsettings.el @@ -0,0 +1,336 @@ +;;; 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-xsettings) +(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) +(defvar exwm-xsettings--serial 0) + +(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)) + +(defgroup exwm-xsettings nil + "XSETTINGS." + :group 'exwm) + +(defcustom exwm-xsettings nil + "Alist of custom XSETTINGS. +These settings take precedence over `exwm-xsettings-theme' and +`exwm-xsettings-icon-theme'." + :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." + :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." + :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) + +(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 diff --git a/third_party/exwm/exwm.el b/third_party/exwm/exwm.el index b025f6b49a..c4900eab48 100644 --- a/third_party/exwm/exwm.el +++ b/third_party/exwm/exwm.el @@ -1,13 +1,13 @@ ;;; exwm.el --- Emacs X Window Manager -*- lexical-binding: t -*- -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> -;; Maintainer: Adrián Medraño Calvo <adrian@medranocalvo.com> -;; Version: 0.26 -;; Package-Requires: ((xelb "0.18")) +;; Maintainer: Adrián Medraño Calvo <adrian@medranocalvo.com>, Steven Allen <steven@stebalien.com>, Daniel Mendler <mail@daniel-mendler.de> +;; Version: 0.28 +;; Package-Requires: ((emacs "27.1") (xelb "0.18")) ;; Keywords: unix -;; URL: https://github.com/ch11ng/exwm +;; URL: https://github.com/emacs-exwm/exwm ;; This file is part of GNU Emacs. @@ -29,14 +29,18 @@ ;; Overview ;; -------- ;; EXWM (Emacs X Window Manager) is a full-featured tiling X window manager -;; for Emacs built on top of [XELB](https://github.com/ch11ng/xelb). +;; for Emacs built on top of [XELB](https://github.com/emacs-exwm/xelb). ;; It features: ;; + Fully keyboard-driven operations ;; + Hybrid layout modes (tiling & stacking) ;; + Dynamic workspace support ;; + ICCCM/EWMH compliance -;; + (Optional) RandR (multi-monitor) support -;; + (Optional) Built-in system tray +;; Optional features: +;; + RandR (multi-monitor) support +;; + System tray +;; + Input method +;; + Background setting support +;; + XSETTINGS server ;; Installation & configuration ;; ---------------------------- @@ -54,7 +58,7 @@ ;; xinit -- vt01 ;; ;; You should additionally hide the menu-bar, tool-bar, etc to increase the -;; usable space. Please check the wiki (https://github.com/ch11ng/exwm/wiki) +;; usable space. Please check the wiki (https://github.com/emacs-exwm/exwm/wiki) ;; for more detailed instructions on installation, configuration, usage, etc. ;; References: @@ -72,10 +76,11 @@ (require 'exwm-manage) (require 'exwm-input) +(declare-function x-get-atom-name "C source code" (VALUE &optional FRAME)) + (defgroup exwm nil "Emacs X Window Manager." :tag "EXWM" - :version "25.3" :group 'applications :prefix "exwm-") @@ -95,7 +100,10 @@ "Normal hook run when window title is updated." :type 'hook) -(defcustom exwm-blocking-subrs '(x-file-dialog x-popup-dialog x-select-font) +(defcustom exwm-blocking-subrs + ;; `x-file-dialog' and `x-select-font' are missing on some Emacs builds, for + ;; example on the X11 Lucid build. + '(x-file-dialog x-popup-dialog x-select-font message-box message-or-box) "Subrs (primitives) that would normally block EXWM." :type '(repeat function)) @@ -108,6 +116,10 @@ (defconst exwm--server-name "server-exwm" "Name of the subordinate Emacs server.") +(defvar exwm--server-timeout 1 + "Number of seconds to wait for the subordinate Emacs server to exit. +After this time, the server will be killed.") + (defvar exwm--server-process nil "Process of the subordinate Emacs server.") (defun exwm-reset () @@ -127,7 +139,7 @@ "Restart EXWM." (interactive) (exwm--log) - (when (exwm--confirm-kill-emacs "[EXWM] Restart? " 'no-check) + (when (exwm--confirm-kill-emacs "Restart?" 'no-check) (let* ((attr (process-attributes (emacs-pid))) (args (cdr (assq 'args attr))) (ppid (cdr (assq 'ppid attr))) @@ -153,7 +165,8 @@ (kill-emacs)))))) (defun exwm--update-desktop (xwin) - "Update _NET_WM_DESKTOP." + "Update _NET_WM_DESKTOP. +Argument XWIN contains the X window of the `exwm-mode' buffer." (exwm--log "#x%x" xwin) (with-current-buffer (exwm--id->buffer xwin) (let ((reply (xcb:+request-unchecked+reply exwm--connection @@ -163,7 +176,7 @@ (when reply (setq desktop (slot-value reply 'value)) (cond - ((eq desktop 4294967295.) + ((and desktop (= desktop 4294967295.)) (unless (or (not exwm--floating-frame) (eq exwm--frame exwm-workspace--current) (and exwm--desktop @@ -180,7 +193,11 @@ (exwm-workspace--set-desktop xwin))))))) (defun exwm--update-window-type (id &optional force) - "Update _NET_WM_WINDOW_TYPE." + "Update `exwm-window-type' from _NET_WM_WINDOW_TYPE. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if +`exwm-window-type' is unset." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and exwm-window-type (not force)) @@ -191,7 +208,11 @@ (setq exwm-window-type (append (slot-value reply 'value) nil))))))) (defun exwm--update-class (id &optional force) - "Update WM_CLASS." + "Update `exwm-instance-name' and `exwm-class' from WM_CLASS. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if any of +`exwm-instance-name' or `exwm-class' is unset." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and exwm-instance-name exwm-class-name (not force)) @@ -204,7 +225,11 @@ (run-hooks 'exwm-update-class-hook))))))) (defun exwm--update-utf8-title (id &optional force) - "Update _NET_WM_NAME." + "Update `exwm-title' from _NET_WM_NAME. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if `exwm-title' is +unset." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (when (or force (not exwm-title)) @@ -217,7 +242,11 @@ (run-hooks 'exwm-update-title-hook))))))) (defun exwm--update-ctext-title (id &optional force) - "Update WM_NAME." + "Update `exwm-title' from WM_NAME. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if `exwm-title' is +unset." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (or exwm--title-is-utf8 @@ -230,13 +259,18 @@ (run-hooks 'exwm-update-title-hook))))))) (defun exwm--update-title (id) - "Update _NET_WM_NAME or WM_NAME." + "Update _NET_WM_NAME or WM_NAME. +Argument ID contains the X window of the `exwm-mode' buffer." (exwm--log "#x%x" id) (exwm--update-utf8-title id) (exwm--update-ctext-title id)) (defun exwm--update-transient-for (id &optional force) - "Update WM_TRANSIENT_FOR." + "Update `exwm-transient-for' from WM_TRANSIENT_FOR. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if `exwm-title' is +unset." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and exwm-transient-for (not force)) @@ -247,7 +281,15 @@ (setq exwm-transient-for (slot-value reply 'value))))))) (defun exwm--update-normal-hints (id &optional force) - "Update WM_NORMAL_HINTS." + "Update normal hints from WM_NORMAL_HINTS. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place all of +`exwm--normal-hints-x exwm--normal-hints-y', +`exwm--normal-hints-width exwm--normal-hints-height', +`exwm--normal-hints-min-width exwm--normal-hints-min-height' and +`exwm--normal-hints-max-width exwm--normal-hints-max-height' are +unset." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and (not force) @@ -295,7 +337,11 @@ exwm--normal-hints-max-height))))))))) (defun exwm--update-hints (id &optional force) - "Update WM_HINTS." + "Update hints from WM_HINTS. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if both of +`exwm--hints-input' and `exwm--hints-urgency' are unset." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and (not force) exwm--hints-input exwm--hints-urgency) @@ -317,7 +363,11 @@ (setq exwm-workspace--switch-history-outdated t)))))))) (defun exwm--update-protocols (id &optional force) - "Update WM_PROTOCOLS." + "Update `exwm--protocols' from WM_PROTOCOLS. +Argument ID contains the X window of the `exwm-mode' buffer. + +When FORCE is nil the update only takes place if `exwm--protocols' +is unset." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and exwm--protocols (not force)) @@ -328,7 +378,7 @@ (setq exwm--protocols (append (slot-value reply 'value) nil))))))) (defun exwm--update-struts-legacy (id) - "Update _NET_WM_STRUT." + "Update struts of X window ID from _NET_WM_STRUT." (exwm--log "#x%x" id) (let ((pair (assq id exwm-workspace--id-struts-alist)) reply struts) @@ -349,7 +399,7 @@ (exwm-workspace--set-fullscreen f))))) (defun exwm--update-struts-partial (id) - "Update _NET_WM_STRUT_PARTIAL." + "Update struts of X window ID from _NET_WM_STRUT_PARTIAL." (exwm--log "#x%x" id) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:ewmh:get-_NET_WM_STRUT_PARTIAL @@ -369,13 +419,14 @@ (exwm-workspace--set-fullscreen f)))) (defun exwm--update-struts (id) - "Update _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT." + "Update struts of X window ID from _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT." (exwm--log "#x%x" id) (exwm--update-struts-partial id) (exwm--update-struts-legacy id)) (defun exwm--on-PropertyNotify (data _synthetic) - "Handle PropertyNotify event." + "Handle PropertyNotify event. +DATA contains unmarshalled PropertyNotify event data." (let ((obj (make-instance 'xcb:PropertyNotify)) atom id buffer) (xcb:unmarshal obj data) @@ -413,15 +464,16 @@ atom))))))) (defun exwm--on-ClientMessage (raw-data _synthetic) - "Handle ClientMessage event." + "Handle ClientMessage event. +RAW-DATA contains unmarshalled ClientMessage event data." (let ((obj (make-instance 'xcb:ClientMessage)) type id data) (xcb:unmarshal obj raw-data) (setq type (slot-value obj 'type) id (slot-value obj 'window) data (slot-value (slot-value obj 'data) 'data32)) - (exwm--log "atom=%s(%s)" (x-get-atom-name type exwm-workspace--current) - type) + (exwm--log "atom=%s(%s) id=#x%x data=%s" (x-get-atom-name type exwm-workspace--current) + type (or id 0) data) (cond ;; _NET_NUMBER_OF_DESKTOPS. ((= type xcb:Atom:_NET_NUMBER_OF_DESKTOPS) @@ -434,7 +486,6 @@ ((and (> current requested) (> current 1)) (let ((frame (car (last exwm-workspace--list)))) - (exwm-workspace--get-remove-frame-next-workspace frame) (delete-frame frame)))))) ;; _NET_CURRENT_DESKTOP. ((= type xcb:Atom:_NET_CURRENT_DESKTOP) @@ -443,7 +494,8 @@ ((= type xcb:Atom:_NET_ACTIVE_WINDOW) (let ((buffer (exwm--id->buffer id)) iconic window) - (when (buffer-live-p buffer) + (if (buffer-live-p buffer) + ;; Either an `exwm-mode' buffer (an X window) or a floating frame. (with-current-buffer buffer (when (eq exwm--frame exwm-workspace--current) (if exwm--floating-frame @@ -457,7 +509,11 @@ (setq window (get-buffer-window nil t)) (when (or iconic (not (eq window (selected-window)))) - (select-window window)))))))) + (select-window window))))) + ;; A workspace. + (dolist (f exwm-workspace--list) + (when (eq id (frame-parameter f 'exwm-outer-id)) + (x-focus-frame f t)))))) ;; _NET_CLOSE_WINDOW. ((= type xcb:Atom:_NET_CLOSE_WINDOW) (let ((buffer (exwm--id->buffer id))) @@ -594,7 +650,8 @@ (x-get-atom-name type exwm-workspace--current) type))))) (defun exwm--on-SelectionClear (data _synthetic) - "Handle SelectionClear events." + "Handle SelectionClear events. +DATA contains unmarshalled SelectionClear event data." (exwm--log) (let ((obj (make-instance 'xcb:SelectionClear)) owner selection) @@ -605,6 +662,17 @@ (eq selection xcb:Atom:WM_S0)) (exwm-exit)))) +(defun exwm--on-delete-terminal (terminal) + "Handle terminal being deleted without Emacs being killed. +This function is Hooked to `delete-terminal-functions'. + +TERMINAL is the terminal being (or that has been) deleted. + +This may happen when invoking `save-buffers-kill-terminal' within an emacsclient +session." + (when (eq terminal exwm--terminal) + (exwm-exit))) + (defun exwm--init-icccm-ewmh () "Initialize ICCCM/EWMH support." (exwm--log) @@ -825,7 +893,8 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." ;;;###autoload (cl-defun exwm-init (&optional frame) - "Initialize EXWM." + "Initialize EXWM. +FRAME, if given, indicates the X display EXWM should manage." (interactive) (exwm--log "%s" frame) (if frame @@ -841,6 +910,7 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." (condition-case err (progn (exwm-enable 'undo) ;never initialize again + (setq exwm--terminal (frame-terminal frame)) (setq exwm--connection (xcb:connect)) (set-process-query-on-exit-flag (slot-value exwm--connection 'process) nil) ;prevent query message on exit @@ -863,6 +933,10 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." ;; Disable some features not working well with EXWM (setq use-dialog-box nil confirm-kill-emacs #'exwm--confirm-kill-emacs) + (advice-add 'save-buffers-kill-terminal + :before-while #'exwm--confirm-kill-terminal) + ;; Clean up if the terminal is deleted. + (add-hook 'delete-terminal-functions 'exwm--on-delete-terminal) (exwm--lock) (exwm--init-icccm-ewmh) (exwm-layout--init) @@ -891,15 +965,17 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." (run-hooks 'exwm-exit-hook) (setq confirm-kill-emacs nil) ;; Exit modules. - (exwm-input--exit) - (exwm-manage--exit) - (exwm-workspace--exit) - (exwm-floating--exit) - (exwm-layout--exit) (when exwm--connection + (exwm-input--exit) + (exwm-manage--exit) + (exwm-workspace--exit) + (exwm-floating--exit) + (exwm-layout--exit) (xcb:flush exwm--connection) (xcb:disconnect exwm--connection)) - (setq exwm--connection nil)) + (setq exwm--connection nil) + (setq exwm--terminal nil) + (exwm--log "Exited")) ;;;###autoload (defun exwm-enable (&optional undo) @@ -933,15 +1009,21 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." (defun exwm--server-stop () "Stop the subordinate Emacs server." (exwm--log) - (server-force-delete exwm--server-name) (when exwm--server-process + (when (process-live-p exwm--server-process) + (cl-loop + initially (signal-process exwm--server-process 'TERM) + while (process-live-p exwm--server-process) + repeat (* 10 exwm--server-timeout) + do (sit-for 0.1))) (delete-process exwm--server-process) (setq exwm--server-process nil))) -(defun exwm--server-eval-at (&rest args) - "Wrapper of `server-eval-at' used to advice subrs." +(defun exwm--server-eval-at (function &rest args) + "Wrapper of `server-eval-at' used to advice subrs. +FUNCTION is the function to be evaluated, ARGS are the arguments." ;; Start the subordinate Emacs server if it's not alive - (exwm--log "%s" args) + (exwm--log "%s %s" function args) (unless (server-running-p exwm--server-name) (when exwm--server-process (delete-process exwm--server-process)) (setq exwm--server-process @@ -950,7 +1032,7 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." (car command-line-args) ;The executable file "-d" (frame-parameter nil 'display) "-Q" - (concat "--daemon=" exwm--server-name) + (concat "--fg-daemon=" exwm--server-name) "--eval" ;; Create an invisible frame "(make-frame '((window-system . x) (visibility)))")) @@ -959,8 +1041,8 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." (server-eval-at exwm--server-name `(progn (select-frame (car (frame-list))) - (let ((result ,(nconc (list (make-symbol (subr-name (car args)))) - (cdr args)))) + (let ((result ,(nconc (list (make-symbol (subr-name function))) + args))) (pcase (type-of result) ;; Return the name of a buffer (`buffer (buffer-name result)) @@ -978,8 +1060,20 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." ;; For other types, return the value as-is. (t result)))))) +(defun exwm--confirm-kill-terminal (&optional _) + "Confirm before killing terminal." + ;; This is invoked instead of `save-buffers-kill-emacs' (C-x C-c) on client + ;; frames. + (if (exwm--terminal-p) + (exwm--confirm-kill-emacs "Kill terminal?") + t)) + (defun exwm--confirm-kill-emacs (prompt &optional force) - "Confirm before exiting Emacs." + "Confirm before exiting Emacs. +PROMPT a reason to present to the user. +If FORCE is nil, ask the user for confirmation. +If FORCE is the symbol `no-check', ask if there are unsaved buffers. +If FORCE is any other non-nil value, force killing of Emacs." (exwm--log) (when (cond ((and force (not (eq force 'no-check))) @@ -996,7 +1090,7 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." (`break (y-or-n-p prompt)) (x x))) (t - (yes-or-no-p (format "[EXWM] %d window(s) will be destroyed. %s" + (yes-or-no-p (format "[EXWM] %d X window(s) will be destroyed. %s" (length exwm--id-buffer-alist) prompt)))) ;; Run `kill-emacs-hook' (`server-force-stop' excluded) before Emacs ;; frames are unmapped so that errors (if any) can be visible. |