subtree(3p/exwm): update to commit 'b62d5e79'

This is almost one year of changes to EXWM. Note that it undoes our
port of https://github.com/ch11ng/exwm/pull/737

That PR hasn't seen any movement in three years, so it might not be
that relevant anymore. Other stuff has been mainlined in the meantime.

Change-Id: I0845ff8a28a5bb1553855f6d6f0ceeaedcf0809e
This commit is contained in:
Vincent Ambo 2023-06-06 00:38:52 +03:00
commit ff96777456
9 changed files with 530 additions and 234 deletions

201
third_party/exwm/exwm-background.el vendored Normal file
View file

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

View file

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

View file

@ -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)

View file

@ -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 ()

View file

@ -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)

View file

@ -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)))

View file

@ -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, the symbol `workspace-background' for the background
color of current workspace frame, or the symbol `transparent' for transparent
background.
This should be a color, or nil for transparent background."
:type '(choice (const :tag "Transparent" nil)
(color))
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)

View file

@ -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))

View file

@ -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.