diff options
Diffstat (limited to 'third_party/exwm')
| -rw-r--r-- | third_party/exwm/exwm-background.el | 201 | ||||
| -rw-r--r-- | third_party/exwm/exwm-core.el | 12 | ||||
| -rw-r--r-- | third_party/exwm/exwm-floating.el | 2 | ||||
| -rw-r--r-- | third_party/exwm/exwm-input.el | 82 | ||||
| -rw-r--r-- | third_party/exwm/exwm-layout.el | 34 | ||||
| -rw-r--r-- | third_party/exwm/exwm-manage.el | 7 | ||||
| -rw-r--r-- | third_party/exwm/exwm-systemtray.el | 199 | ||||
| -rw-r--r-- | third_party/exwm/exwm-workspace.el | 185 | ||||
| -rw-r--r-- | third_party/exwm/exwm.el | 44 |
9 files changed, 531 insertions, 235 deletions
diff --git a/third_party/exwm/exwm-background.el b/third_party/exwm/exwm-background.el new file mode 100644 index 000000000000..e7a0360c97c0 --- /dev/null +++ b/third_party/exwm/exwm-background.el @@ -0,0 +1,201 @@ +;;; exwm-background.el --- X Background Module for EXWM -*- lexical-binding: t -*- + +;; Copyright (C) 2022 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 exwm-background--connection + (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-core.el b/third_party/exwm/exwm-core.el index 995b590dc582..75c7c1b17b77 100644 --- a/third_party/exwm/exwm-core.el +++ b/third_party/exwm/exwm-core.el @@ -59,6 +59,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.") @@ -155,9 +158,9 @@ 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) +(defun exwm--intern-atom (atom &optional conn) "Intern X11 ATOM." - (slot-value (xcb:+request-unchecked+reply 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 +180,11 @@ 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." + (eq exwm--terminal (frame-terminal frame))) + (defun exwm--get-client-event-mask () "Return event mask set on all managed windows." (logior xcb:EventMask:StructureNotify diff --git a/third_party/exwm/exwm-floating.el b/third_party/exwm/exwm-floating.el index a9f9315b710f..69e86a24e81b 100644 --- a/third_party/exwm/exwm-floating.el +++ b/third_party/exwm/exwm-floating.el @@ -161,6 +161,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) diff --git a/third_party/exwm/exwm-input.el b/third_party/exwm/exwm-input.el index 50676217f1ad..79bc78ef0fe9 100644 --- a/third_party/exwm/exwm-input.el +++ b/third_party/exwm/exwm-input.el @@ -117,6 +117,9 @@ defined in `exwm-mode-map' here." (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.") @@ -135,16 +138,8 @@ defined in `exwm-mode-map' here." "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 +159,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,24 +294,14 @@ 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 + (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." @@ -1116,37 +1099,40 @@ 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--init () diff --git a/third_party/exwm/exwm-layout.el b/third_party/exwm/exwm-layout.el index 9173a1c049df..ea186fe5a451 100644 --- a/third_party/exwm/exwm-layout.el +++ b/third_party/exwm/exwm-layout.el @@ -57,8 +57,6 @@ (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--minibuffer-own-frame-p "exwm-workspace.el") (declare-function exwm-workspace--workspace-p "exwm-workspace.el" (workspace)) @@ -405,22 +403,28 @@ 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)))) + (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 e940257fc9f8..c3d47f72259f 100644 --- a/third_party/exwm/exwm-manage.el +++ b/third_party/exwm/exwm-manage.el @@ -151,6 +151,7 @@ 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) @@ -262,7 +263,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))))) @@ -347,7 +349,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))) diff --git a/third_party/exwm/exwm-systemtray.el b/third_party/exwm/exwm-systemtray.el index 43b3e1eaef41..0f199866241d 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-2022 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) @@ -67,44 +68,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 @@ -249,6 +255,80 @@ 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." (exwm--log) @@ -375,8 +455,13 @@ This should be a color, or nil for transparent background." 3) 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) @@ -402,7 +487,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 +555,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 @@ -487,15 +572,21 @@ This should be a color, or nil for transparent background." 3) 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 +595,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 +637,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) @@ -564,11 +668,14 @@ This should be a color, or nil for transparent background." (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 fc68e1b07053..06217a77692a 100644 --- a/third_party/exwm/exwm-workspace.el +++ b/third_party/exwm/exwm-workspace.el @@ -85,9 +85,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). @@ -165,22 +162,6 @@ NIL if FRAME is not a workspace" "Return t if FRAME is a workspace." (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))) - (defvar exwm-workspace--switch-map nil "Keymap used for interactively selecting workspace.") @@ -264,7 +245,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 @@ -444,7 +424,7 @@ NIL if FRAME is not a workspace" (defun exwm-workspace--set-active (frame active) "Make frame FRAME active on its monitor." - (exwm--log "active=%s; frame=%s" frame active) + (exwm--log "active=%s; frame=%s" active frame) (set-frame-parameter frame 'exwm-active active) (if active (exwm-workspace--set-fullscreen frame) @@ -830,7 +810,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) @@ -1131,7 +1110,7 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (defun exwm-workspace--update-minibuffer-height (&optional echo-area) "Update the minibuffer frame height." - (unless (exwm-workspace--client-p) + (when (exwm--terminal-p) (let ((height (with-current-buffer (window-buffer (minibuffer-window exwm-workspace--minibuffer)) @@ -1248,7 +1227,7 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." "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 @@ -1270,16 +1249,16 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." "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) @@ -1302,7 +1281,7 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (defun exwm-workspace--on-echo-area-clear () "Run in echo-area-clear-hook to hide echo area container." - (unless (exwm-workspace--client-p) + (when (exwm--terminal-p) (unless (active-minibuffer-window) (exwm-workspace--hide-minibuffer)) (when exwm-workspace--display-echo-area-timer @@ -1332,8 +1311,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 +1369,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 +1380,41 @@ 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)) + (unless (eq frame nextw) + nextw))) (defun exwm-workspace--remove-frame-as-workspace (frame) "Stop treating frame FRAME as a workspace." ;; 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. + (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)) - ;; Update the _NET_WM_DESKTOP property of each X window affected. + (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) - (when (<= (1- index) - (exwm-workspace--position (buffer-local-value 'exwm--frame - (cdr pair)))) - (exwm-workspace--set-desktop (car pair)))) + (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 nextw))) + (exwm-workspace-switch next-frame))) ;; Reparent out the frame. (let ((outer-id (frame-parameter frame 'exwm-outer-id))) (xcb:+request exwm--connection @@ -1480,15 +1457,13 @@ the next workspace." ((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 +1472,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)) @@ -1562,8 +1542,7 @@ applied to all subsequently created X frames." (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 @@ -1633,6 +1612,8 @@ applied to all subsequently created X frames." (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 +1621,16 @@ 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) + (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 +1648,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) @@ -1739,34 +1710,22 @@ applied to all subsequently created X frames." ;; X windows will be re-mapped). (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))) + (when (frame-live-p i) ; might be already dead + (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 + (fullscreen . nil) + (buffer-predicate . nil))))) + ;; Don't let dead frames linger. + (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.el b/third_party/exwm/exwm.el index b025f6b49aa5..345f76beb66c 100644 --- a/third_party/exwm/exwm.el +++ b/third_party/exwm/exwm.el @@ -4,7 +4,7 @@ ;; Author: Chris Feng <chris.w.feng@gmail.com> ;; Maintainer: Adrián Medraño Calvo <adrian@medranocalvo.com> -;; Version: 0.26 +;; Version: 0.27 ;; Package-Requires: ((xelb "0.18")) ;; Keywords: unix ;; URL: https://github.com/ch11ng/exwm @@ -127,7 +127,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))) @@ -420,8 +420,8 @@ (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 +434,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 +442,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 +457,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))) @@ -605,6 +609,13 @@ (eq selection xcb:Atom:WM_S0)) (exwm-exit)))) +(defun exwm--on-delete-terminal (terminal) + "Handle terminal being deleted without Emacs being killed. +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) @@ -841,6 +852,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 +875,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) @@ -899,7 +915,9 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'." (when exwm--connection (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) @@ -978,6 +996,14 @@ 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 "[EXWM] Kill terminal?") + t)) + (defun exwm--confirm-kill-emacs (prompt &optional force) "Confirm before exiting Emacs." (exwm--log) @@ -996,7 +1022,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. |