mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

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

12
third_party/exwm/exwm-core.el vendored
View file

@ -59,6 +59,9 @@ Here are some predefined candidates:
(defvar exwm--connection nil "X connection.") (defvar exwm--connection nil "X connection.")
(defvar exwm--terminal nil
"Terminal corresponding to `exwm--connection'.")
(defvar exwm--wmsn-window nil (defvar exwm--wmsn-window nil
"An X window owning the WM_S0 selection.") "An X window owning the WM_S0 selection.")
@ -155,9 +158,9 @@ Nil can be passed as placeholder."
(if height xcb:ConfigWindow:Height 0)) (if height xcb:ConfigWindow:Height 0))
:x x :y y :width width :height height))) :x x :y y :width width :height height)))
(defun exwm--intern-atom (atom) (defun exwm--intern-atom (atom &optional conn)
"Intern X11 ATOM." "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 (make-instance 'xcb:InternAtom
:only-if-exists 0 :only-if-exists 0
:name-len (length atom) :name-len (length atom)
@ -177,6 +180,11 @@ least SECS seconds later."
,function ,function
,@args)) ,@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 () (defun exwm--get-client-event-mask ()
"Return event mask set on all managed windows." "Return event mask set on all managed windows."
(logior xcb:EventMask:StructureNotify (logior xcb:EventMask:StructureNotify

2
third_party/exwm/exwm-floating.el vendored
View file

@ -161,6 +161,8 @@ context of the corresponding buffer."
(get-buffer "*scratch*"))) (get-buffer "*scratch*")))
(make-frame (make-frame
`((minibuffer . ,(minibuffer-window exwm--frame)) `((minibuffer . ,(minibuffer-window exwm--frame))
(tab-bar-lines . 0)
(tab-bar-lines-keep-state . t)
(left . ,(* window-min-width -10000)) (left . ,(* window-min-width -10000))
(top . ,(* window-min-height -10000)) (top . ,(* window-min-height -10000))
(width . ,window-min-width) (width . ,window-min-width)

82
third_party/exwm/exwm-input.el vendored
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--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 (defvar exwm-input--temp-line-mode nil
"Non-nil indicates it's in temporary line-mode for char-mode.") "Non-nil indicates it's in temporary line-mode for char-mode.")
@ -135,16 +138,8 @@ defined in `exwm-mode-map' here."
"Timer for deferring the update of input focus.") "Timer for deferring the update of input focus.")
(defvar exwm-input--update-focus-window nil "The (Emacs) window to be focused. (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.") 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--echo-area-timer nil "Timer for detecting echo area dirty.")
(defvar exwm-input--event-hook nil (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--iconic-state-p "exwm-layout.el" (&optional id))
(declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) (declare-function exwm-layout--show "exwm-layout.el" (id &optional window))
(declare-function exwm-reset "exwm.el" ()) (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--minibuffer-own-frame-p "exwm-workspace.el")
(declare-function exwm-workspace--workspace-p "exwm-workspace.el" (workspace)) (declare-function exwm-workspace--workspace-p "exwm-workspace.el" (workspace))
(declare-function exwm-workspace-switch "exwm-workspace.el" (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 () (defun exwm-input--on-buffer-list-update ()
"Run in `buffer-list-update-hook' to track input focus." "Run in `buffer-list-update-hook' to track input focus."
;; `buffer-list-update-hook' is invoked by several functions (when (and ; this hook is called incesantly; place cheap tests on top
;; (`get-buffer-create', `select-window', `with-temp-buffer', etc.), but we (not exwm-input--skip-buffer-list-update)
;; just want to notice when a different window has been selected, or when the (exwm--terminal-p)) ; skip other terminals, e.g. TTY client frames
;; selected window displays a different buffer, so that we can set the focus (exwm--log "current-buffer=%S selected-window=%S"
;; to the associated X window (in case of an `exwm-mode' buffer). In order to (current-buffer) (selected-window))
;; differentiate, we keep track of the last selected window and buffer in the (redirect-frame-focus (selected-frame) nil)
;; `exwm-input--update-focus-window' and (setq exwm-input--update-focus-window (selected-window))
;; `exwm-input--update-focus-window-buffer' variables. (exwm-input--update-focus-defer)))
(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))))
(defun exwm-input--update-focus-defer () (defun exwm-input--update-focus-defer ()
"Defer updating input focus." "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 () (defun exwm-input--on-minibuffer-setup ()
"Run in `minibuffer-setup-hook' to grab keyboard if necessary." "Run in `minibuffer-setup-hook' to grab keyboard if necessary."
(exwm--log) (let* ((window (or (minibuffer-selected-window) ; minibuffer-setup-hook
(with-current-buffer (selected-window))) ; echo-area-clear-hook
(window-buffer (frame-selected-window exwm-workspace--current)) (frame (window-frame window)))
(when (and (derived-mode-p 'exwm-mode) (when (exwm--terminal-p frame)
(not (exwm-workspace--client-p)) (with-current-buffer (window-buffer window)
(eq exwm--selected-input-mode 'char-mode)) (when (and (derived-mode-p 'exwm-mode)
(exwm-input--grab-keyboard exwm--id)))) (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 () (defun exwm-input--on-minibuffer-exit ()
"Run in `minibuffer-exit-hook' to release keyboard if necessary." "Run in `minibuffer-exit-hook' to release keyboard if necessary."
(exwm--log) (let* ((window (or (minibuffer-selected-window) ; minibuffer-setup-hook
(with-current-buffer (selected-window))) ; echo-area-clear-hook
(window-buffer (frame-selected-window exwm-workspace--current)) (frame (window-frame window)))
(when (and (derived-mode-p 'exwm-mode) (when (exwm--terminal-p frame)
(not (exwm-workspace--client-p)) (with-current-buffer (window-buffer window)
(eq exwm--selected-input-mode 'char-mode) (when (and (derived-mode-p 'exwm-mode)
(eq exwm--input-mode 'line-mode)) (eq exwm--selected-input-mode 'char-mode)
(exwm-input--release-keyboard exwm--id)))) (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 () (defun exwm-input--on-echo-area-dirty ()
"Run when new message arrives to grab keyboard if necessary." "Run when new message arrives to grab keyboard if necessary."
(exwm--log) (when (and cursor-in-echo-area
(when (and (not (active-minibuffer-window)) (not (active-minibuffer-window)))
(not (exwm-workspace--client-p)) (exwm--log)
cursor-in-echo-area)
(exwm-input--on-minibuffer-setup))) (exwm-input--on-minibuffer-setup)))
(defun exwm-input--on-echo-area-clear () (defun exwm-input--on-echo-area-clear ()
"Run in `echo-area-clear-hook' to release keyboard if necessary." "Run in `echo-area-clear-hook' to release keyboard if necessary."
(exwm--log)
(unless (current-message) (unless (current-message)
(exwm--log)
(exwm-input--on-minibuffer-exit))) (exwm-input--on-minibuffer-exit)))
(defun exwm-input--init () (defun exwm-input--init ()

34
third_party/exwm/exwm-layout.el vendored
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-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--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--minibuffer-own-frame-p "exwm-workspace.el")
(declare-function exwm-workspace--workspace-p "exwm-workspace.el" (declare-function exwm-workspace--workspace-p "exwm-workspace.el"
(workspace)) (workspace))
@ -405,22 +403,28 @@ selected by `other-buffer'."
(defun exwm-layout--on-minibuffer-setup () (defun exwm-layout--on-minibuffer-setup ()
"Refresh layout when minibuffer grows." "Refresh layout when minibuffer grows."
(exwm--log) (exwm--log)
(unless (exwm-workspace--client-p) ;; Only when active minibuffer's frame is an EXWM frame.
(exwm--defer 0 (lambda () (let* ((mini-window (active-minibuffer-window))
(when (< 1 (window-height (minibuffer-window))) (frame (window-frame mini-window)))
(exwm-layout--refresh)))))) (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) (defun exwm-layout--on-echo-area-change (&optional dirty)
"Run when message arrives or in `echo-area-clear-hook' to refresh layout." "Run when message arrives or in `echo-area-clear-hook' to refresh layout."
(when (and (current-message) (let ((frame (window-frame (active-minibuffer-window)))
(not (exwm-workspace--client-p)) (msg (current-message)))
(or (cl-position ?\n (current-message)) ;; Check whether the frame where current window's minibuffer resides (not
(> (length (current-message)) ;; current window's frame for floating windows!) must be adjusted.
(frame-width exwm-workspace--current)))) (when (and msg
(exwm--log) (exwm-workspace--workspace-p frame)
(if dirty (or (cl-position ?\n msg)
(exwm-layout--refresh) (> (length msg) (frame-width frame))))
(exwm--defer 0 #'exwm-layout--refresh)))) (exwm--log)
(if dirty
(exwm-layout--refresh exwm-workspace--current)
(exwm--defer 0 #'exwm-layout--refresh exwm-workspace--current)))))
;;;###autoload ;;;###autoload
(defun exwm-layout-enlarge-window (delta &optional horizontal) (defun exwm-layout-enlarge-window (delta &optional horizontal)

7
third_party/exwm/exwm-manage.el vendored
View file

@ -151,6 +151,7 @@ want to match against EXWM internal variables such as `exwm-title',
(defvar exwm-manage--ping-lock nil (defvar exwm-manage--ping-lock nil
"Non-nil indicates EXWM is pinging a window.") "Non-nil indicates EXWM is pinging a window.")
(defvar exwm-input--skip-buffer-list-update)
(defvar exwm-input-prefix-keys) (defvar exwm-input-prefix-keys)
(defvar exwm-workspace--current) (defvar exwm-workspace--current)
(defvar exwm-workspace--id-struts-alist) (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 (make-instance 'xcb:ChangeSaveSet
:mode xcb:SetMode:Insert :mode xcb:SetMode:Insert
:window id)) :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. ;; Keep the oldest X window first.
(setq exwm--id-buffer-alist (setq exwm--id-buffer-alist
(nconc exwm--id-buffer-alist `((,id . ,(current-buffer))))) (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))) :stack-mode xcb:StackMode:Below)))
(xcb:flush exwm--connection) (xcb:flush exwm--connection)
(setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist)) (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))) (kill-buffer (current-buffer)))
(throw 'return 'ignored)) (throw 'return 'ignored))
(let ((index (plist-get exwm--configurations 'workspace))) (let ((index (plist-get exwm--configurations 'workspace)))

197
third_party/exwm/exwm-systemtray.el vendored
View file

@ -1,7 +1,7 @@
;;; exwm-systemtray.el --- System Tray Module for -*- lexical-binding: t -*- ;;; exwm-systemtray.el --- System Tray Module for -*- lexical-binding: t -*-
;;; EXWM ;;; 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> ;; Author: Chris Feng <chris.w.feng@gmail.com>
@ -30,6 +30,7 @@
;;; Code: ;;; Code:
(require 'xcb-ewmh)
(require 'xcb-icccm) (require 'xcb-icccm)
(require 'xcb-xembed) (require 'xcb-xembed)
(require 'xcb-systemtray) (require 'xcb-systemtray)
@ -67,44 +68,49 @@ You shall use the default value if using auto-hide minibuffer."
"Gap between icons." "Gap between icons."
:type 'integer) :type 'integer)
(defvar exwm-systemtray--connection nil "The X connection.")
(defvar exwm-systemtray--embedder-window nil "The embedder window.") (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. "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." Transparent background is not yet supported when Emacs uses 32-bit depth
:type '(choice (const :tag "Transparent" nil) visual, as reported by `x-display-planes'. The X resource \"Emacs.visualClass:
(color)) 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 :initialize #'custom-initialize-default
:set (lambda (symbol value) :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) (set-default symbol value)
;; Change the background color for embedder. (when (and exwm-systemtray--connection
(when (and exwm--connection
exwm-systemtray--embedder-window) exwm-systemtray--embedder-window)
(let ((background-pixel (exwm--color->pixel value))) ;; Change the background color for embedder.
(xcb:+request exwm--connection (exwm-systemtray--set-background-color)
(make-instance 'xcb:ChangeWindowAttributes ;; Unmap & map to take effect immediately.
:window exwm-systemtray--embedder-window (xcb:+request exwm-systemtray--connection
:value-mask (logior xcb:CW:BackPixmap (make-instance 'xcb:UnmapWindow
(if background-pixel :window exwm-systemtray--embedder-window))
xcb:CW:BackPixel 0)) (xcb:+request exwm-systemtray--connection
:background-pixmap (make-instance 'xcb:MapWindow
xcb:BackPixmap:ParentRelative :window exwm-systemtray--embedder-window))
:background-pixel background-pixel)) (xcb:flush exwm-systemtray--connection))))
;; 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)))))
;; GTK icons require at least 16 pixels to show normally. ;; GTK icons require at least 16 pixels to show normally.
(defconst exwm-systemtray--icon-min-size 16 "Minimum icon size.") (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--list nil "The icon list.")
(defvar exwm-systemtray--selection-owner-window nil (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)))) :window exwm-systemtray--embedder-window))))
(xcb:flush exwm-systemtray--connection)) (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) (defun exwm-systemtray--on-DestroyNotify (data _synthetic)
"Unembed icons on DestroyNotify." "Unembed icons on DestroyNotify."
(exwm--log) (exwm--log)
@ -375,8 +455,13 @@ This should be a color, or nil for transparent background."
3) 3)
exwm-workspace--frame-y-offset exwm-workspace--frame-y-offset
exwm-systemtray-height)))) exwm-systemtray-height))))
(exwm-systemtray--refresh-background-color)
(exwm-systemtray--refresh)) (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 () (defun exwm-systemtray--refresh-all ()
"Reposition/Refresh the system tray." "Reposition/Refresh the system tray."
(exwm--log) (exwm--log)
@ -402,7 +487,8 @@ This should be a color, or nil for transparent background."
(cl-assert (not exwm-systemtray--embedder-window)) (cl-assert (not exwm-systemtray--embedder-window))
(unless exwm-systemtray-height (unless exwm-systemtray-height
(setq exwm-systemtray-height (max exwm-systemtray--icon-min-size (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. ;; Create a new connection.
(setq exwm-systemtray--connection (xcb:connect)) (setq exwm-systemtray--connection (xcb:connect))
(set-process-query-on-exit-flag (slot-value exwm-systemtray--connection (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))) :data xcb:systemtray:ORIENTATION:HORZ)))
;; Create the embedder. ;; Create the embedder.
(let ((id (xcb:generate-id exwm-systemtray--connection)) (let ((id (xcb:generate-id exwm-systemtray--connection))
(background-pixel (exwm--color->pixel exwm-systemtray-background-color)) frame parent embedder-depth embedder-visual embedder-colormap y)
frame parent depth y)
(setq exwm-systemtray--embedder-window id) (setq exwm-systemtray--embedder-window id)
(if (exwm-workspace--minibuffer-own-frame-p) (if (exwm-workspace--minibuffer-own-frame-p)
(setq frame exwm-workspace--minibuffer (setq frame exwm-workspace--minibuffer
@ -487,15 +572,21 @@ This should be a color, or nil for transparent background."
3) 3)
exwm-workspace--frame-y-offset exwm-workspace--frame-y-offset
exwm-systemtray-height))) exwm-systemtray-height)))
(setq parent (string-to-number (frame-parameter frame 'window-id)) (setq parent (string-to-number (frame-parameter frame 'window-id)))
depth (slot-value (xcb:+request-unchecked+reply ;; Use default depth, visual and colormap (from root window), instead of
exwm-systemtray--connection ;; Emacs frame's. See Section "Visual and background pixmap handling" in
(make-instance 'xcb:GetGeometry ;; "System Tray Protocol Specification 0.3".
:drawable parent)) (let* ((vdc (exwm--get-visual-depth-colormap exwm-systemtray--connection
'depth)) 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 (xcb:+request exwm-systemtray--connection
(make-instance 'xcb:CreateWindow (make-instance 'xcb:CreateWindow
:depth depth :depth embedder-depth
:wid id :wid id
:parent parent :parent parent
:x 0 :x 0
@ -504,19 +595,29 @@ This should be a color, or nil for transparent background."
:height exwm-systemtray-height :height exwm-systemtray-height
:border-width 0 :border-width 0
:class xcb:WindowClass:InputOutput :class xcb:WindowClass:InputOutput
:visual 0 :visual embedder-visual
:value-mask (logior xcb:CW:BackPixmap :colormap embedder-colormap
(if background-pixel :value-mask (logior xcb:CW:BorderPixel
xcb:CW:BackPixel 0) xcb:CW:Colormap
xcb:CW:EventMask) xcb:CW:EventMask)
:background-pixmap xcb:BackPixmap:ParentRelative :border-pixel 0
:background-pixel background-pixel
:event-mask xcb:EventMask:SubstructureNotify)) :event-mask xcb:EventMask:SubstructureNotify))
(exwm-systemtray--set-background-color)
;; Set _NET_WM_NAME. ;; Set _NET_WM_NAME.
(xcb:+request exwm-systemtray--connection (xcb:+request exwm-systemtray--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME (make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window id :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) (xcb:flush exwm-systemtray--connection)
;; Attach event listeners. ;; Attach event listeners.
(xcb:+event exwm-systemtray--connection 'xcb:DestroyNotify (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-switch-hook #'exwm-systemtray--on-workspace-switch)
(add-hook 'exwm-workspace--update-workareas-hook (add-hook 'exwm-workspace--update-workareas-hook
#'exwm-systemtray--refresh-all) #'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 'menu-bar-mode-hook #'exwm-systemtray--refresh-all)
(add-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all) (add-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all)
(when (boundp 'exwm-randr-refresh-hook) (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 (setq exwm-systemtray--connection nil
exwm-systemtray--list nil exwm-systemtray--list nil
exwm-systemtray--selection-owner-window 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 (remove-hook 'exwm-workspace-switch-hook
#'exwm-systemtray--on-workspace-switch) #'exwm-systemtray--on-workspace-switch)
(remove-hook 'exwm-workspace--update-workareas-hook (remove-hook 'exwm-workspace--update-workareas-hook
#'exwm-systemtray--refresh-all) #'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 'menu-bar-mode-hook #'exwm-systemtray--refresh-all)
(remove-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all) (remove-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all)
(when (boundp 'exwm-randr-refresh-hook) (when (boundp 'exwm-randr-refresh-hook)

185
third_party/exwm/exwm-workspace.el vendored
View file

@ -85,9 +85,6 @@ each time."
If the minibuffer is detached, this value is 0.") 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 (defvar exwm-workspace--create-silently nil
"When non-nil workspaces are created in the background (not switched to). "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." "Return t if FRAME is a workspace."
(memq frame exwm-workspace--list)) (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 (defvar exwm-workspace--switch-map nil
"Keymap used for interactively selecting workspace.") "Keymap used for interactively selecting workspace.")
@ -264,7 +245,6 @@ NIL if FRAME is not a workspace"
(when (and exwm-workspace--prompt-delete-allowed (when (and exwm-workspace--prompt-delete-allowed
(< 1 (exwm-workspace--count))) (< 1 (exwm-workspace--count)))
(let ((frame (elt exwm-workspace--list (1- minibuffer-history-position)))) (let ((frame (elt exwm-workspace--list (1- minibuffer-history-position))))
(exwm-workspace--get-remove-frame-next-workspace frame)
(if (eq frame exwm-workspace--current) (if (eq frame exwm-workspace--current)
;; Abort the recursive minibuffer if deleting the current workspace. ;; Abort the recursive minibuffer if deleting the current workspace.
(progn (progn
@ -444,7 +424,7 @@ NIL if FRAME is not a workspace"
(defun exwm-workspace--set-active (frame active) (defun exwm-workspace--set-active (frame active)
"Make frame FRAME active on its monitor." "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) (set-frame-parameter frame 'exwm-active active)
(if active (if active
(exwm-workspace--set-fullscreen frame) (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 (exwm-workspace--workspace-from-frame-or-index
frame-or-index) frame-or-index)
exwm-workspace--current))) exwm-workspace--current)))
(exwm-workspace--get-remove-frame-next-workspace frame)
(delete-frame frame)))) (delete-frame frame))))
(defun exwm-workspace--set-desktop (id) (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) (defun exwm-workspace--update-minibuffer-height (&optional echo-area)
"Update the minibuffer frame height." "Update the minibuffer frame height."
(unless (exwm-workspace--client-p) (when (exwm--terminal-p)
(let ((height (let ((height
(with-current-buffer (with-current-buffer
(window-buffer (minibuffer-window exwm-workspace--minibuffer)) (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." "Run in minibuffer-setup-hook to show the minibuffer and its container."
(exwm--log) (exwm--log)
(when (and (= 1 (minibuffer-depth)) (when (and (= 1 (minibuffer-depth))
(not (exwm-workspace--client-p))) (exwm--terminal-p))
(add-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height) (add-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height)
(exwm-workspace--show-minibuffer)) (exwm-workspace--show-minibuffer))
;; FIXME: This is a temporary fix for the *Completions* buffer not ;; 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." "Run in minibuffer-exit-hook to hide the minibuffer container."
(exwm--log) (exwm--log)
(when (and (= 1 (minibuffer-depth)) (when (and (= 1 (minibuffer-depth))
(not (exwm-workspace--client-p))) (exwm--terminal-p))
(remove-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height) (remove-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height)
(exwm-workspace--hide-minibuffer))) (exwm-workspace--hide-minibuffer)))
(defun exwm-workspace--on-echo-area-dirty () (defun exwm-workspace--on-echo-area-dirty ()
"Run when new message arrives to show the echo area and its container." "Run when new message arrives to show the echo area and its container."
(when (and (not (active-minibuffer-window)) (when (and (not (active-minibuffer-window))
(not (exwm-workspace--client-p))
(or (current-message) (or (current-message)
cursor-in-echo-area)) cursor-in-echo-area)
(exwm--terminal-p))
(exwm-workspace--update-minibuffer-height t) (exwm-workspace--update-minibuffer-height t)
(exwm-workspace--show-minibuffer) (exwm-workspace--show-minibuffer)
(unless (or (not exwm-workspace-display-echo-area-timeout) (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 () (defun exwm-workspace--on-echo-area-clear ()
"Run in echo-area-clear-hook to hide echo area container." "Run in echo-area-clear-hook to hide echo area container."
(unless (exwm-workspace--client-p) (when (exwm--terminal-p)
(unless (active-minibuffer-window) (unless (active-minibuffer-window)
(exwm-workspace--hide-minibuffer)) (exwm-workspace--hide-minibuffer))
(when exwm-workspace--display-echo-area-timer (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-outer-id outer-id)
(set-frame-parameter frame 'exwm-id window-id) (set-frame-parameter frame 'exwm-id window-id)
(set-frame-parameter frame 'exwm-container container) (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 ;; Copy RandR frame parameters from the first workspace to
;; prevent potential problems. The values do not matter here as ;; prevent potential problems. The values do not matter here as
;; they'll be updated by the RandR module later. ;; 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))) (make-instance 'xcb:MapWindow :window container)))
(xcb:flush exwm--connection) (xcb:flush exwm--connection)
;; Delay making the workspace fullscreen until Emacs becomes idle ;; 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. ;; Update EWMH properties.
(exwm-workspace--update-ewmh-props) (exwm-workspace--update-ewmh-props)
(if exwm-workspace--create-silently (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)) frame exwm-workspace-current-index original-index))
(run-hooks 'exwm-workspace-list-change-hook))) (run-hooks 'exwm-workspace-list-change-hook)))
(defun exwm-workspace--get-remove-frame-next-workspace (frame) (defun exwm-workspace--get-next-workspace (frame)
"Return the next workspace if workspace FRAME is removed. "Return the next workspace if workspace FRAME were removed.
Return nil if FRAME is the only workspace."
All X windows currently on workspace FRAME will be automatically moved to
the next workspace."
(let* ((index (exwm-workspace--position frame)) (let* ((index (exwm-workspace--position frame))
(lastp (= index (1- (exwm-workspace--count)))) (lastp (= index (1- (exwm-workspace--count))))
(nextw (elt exwm-workspace--list (+ index (if lastp -1 +1))))) (nextw (elt exwm-workspace--list (+ index (if lastp -1 +1)))))
;; Clients need to be moved to some other workspace before this being (unless (eq frame nextw)
;; removed. nextw)))
(dolist (pair exwm--id-buffer-alist)
(with-current-buffer (cdr pair)
(when (eq exwm--frame frame)
(exwm-workspace-move-window nextw exwm--id))))
nextw))
(defun exwm-workspace--remove-frame-as-workspace (frame) (defun exwm-workspace--remove-frame-as-workspace (frame)
"Stop treating frame FRAME as a workspace." "Stop treating frame FRAME as a workspace."
;; TODO: restore all frame parameters (e.g. exwm-workspace, buffer-predicate, ;; TODO: restore all frame parameters (e.g. exwm-workspace, buffer-predicate,
;; etc) ;; etc)
(exwm--log "Removing frame `%s' as workspace" frame) (exwm--log "Removing frame `%s' as workspace" frame)
(let* ((index (exwm-workspace--position frame)) (let* ((next-frame (exwm-workspace--get-next-workspace frame))
(nextw (exwm-workspace--get-remove-frame-next-workspace frame))) (following-frames (cdr (memq frame exwm-workspace--list))))
;; Need to remove the workspace from the list in order for ;; Need to remove the workspace from the list for the correct calculation of
;; the correct calculation of indexes. ;; indexes below.
(setq exwm-workspace--list (delete frame exwm-workspace--list)) (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) (dolist (pair exwm--id-buffer-alist)
(when (<= (1- index) (let ((other-frame (buffer-local-value 'exwm--frame (cdr pair))))
(exwm-workspace--position (buffer-local-value 'exwm--frame ;; Move X windows to next-frame.
(cdr pair)))) (when (eq other-frame frame)
(exwm-workspace--set-desktop (car pair)))) (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. ;; If the current workspace is deleted, switch to next one.
(when (eq frame exwm-workspace--current) (when (eq frame exwm-workspace--current)
(exwm-workspace-switch nextw))) (exwm-workspace-switch next-frame)))
;; Reparent out the frame. ;; Reparent out the frame.
(let ((outer-id (frame-parameter frame 'exwm-outer-id))) (let ((outer-id (frame-parameter frame 'exwm-outer-id)))
(xcb:+request exwm--connection (xcb:+request exwm--connection
@ -1480,15 +1457,13 @@ the next workspace."
((not (exwm-workspace--workspace-p frame)) ((not (exwm-workspace--workspace-p frame))
(exwm--log "Frame `%s' is not a workspace" frame)) (exwm--log "Frame `%s' is not a workspace" frame))
(t (t
(when (= 1 (exwm-workspace--count)) (exwm-workspace--remove-frame-as-workspace frame))))
;; The user managed to delete the last workspace, so create a new one.
(exwm--log "Last workspace deleted; create a new one") (defun exwm-workspace--fullscreen-workspace (frame)
;; TODO: this makes sense in the hook. But we need a function that takes "Make workspace FRAME fullscreen.
;; care of converting a workspace into a regular unmanaged frame. Called from a timer."
(let ((exwm-workspace--create-silently t)) (when (frame-live-p frame)
(make-frame))) (set-frame-parameter frame 'fullscreen 'fullboth)))
(exwm-workspace--remove-frame-as-workspace frame)
(remhash frame exwm-workspace--client-p-hash-table))))
(defun exwm-workspace--on-after-make-frame (frame) (defun exwm-workspace--on-after-make-frame (frame)
"Hook run upon `make-frame' that configures FRAME as a workspace." "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)) (exwm--log "Frame `%s' is already a workspace" frame))
((not (display-graphic-p frame)) ((not (display-graphic-p frame))
(exwm--log "Frame `%s' is not graphical" 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 ((not (string-equal
(replace-regexp-in-string "\\.0$" "" (replace-regexp-in-string "\\.0$" ""
(slot-value exwm--connection 'display)) (slot-value exwm--connection 'display))
@ -1562,8 +1542,7 @@ applied to all subsequently created X frames."
(setq exwm-workspace--minibuffer (setq exwm-workspace--minibuffer
(make-frame '((window-system . x) (minibuffer . only) (make-frame '((window-system . x) (minibuffer . only)
(left . 10000) (right . 10000) (left . 10000) (right . 10000)
(width . 1) (height . 1) (width . 1) (height . 1))))
(client . nil))))
;; This is the only usable minibuffer frame. ;; This is the only usable minibuffer frame.
(setq default-minibuffer-frame exwm-workspace--minibuffer) (setq default-minibuffer-frame exwm-workspace--minibuffer)
(exwm-workspace--modify-all-x-frames-parameters (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-setup-hook #'exwm-workspace--on-minibuffer-setup)
(remove-hook 'minibuffer-exit-hook #'exwm-workspace--on-minibuffer-exit) (remove-hook 'minibuffer-exit-hook #'exwm-workspace--on-minibuffer-exit)
(remove-hook 'echo-area-clear-hook #'exwm-workspace--on-echo-area-clear) (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 (when exwm-workspace--timer
(cancel-timer exwm-workspace--timer) (cancel-timer exwm-workspace--timer)
(setq exwm-workspace--timer nil)) (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 (cl-delete '(exwm-workspace--display-buffer) display-buffer-alist
:test #'equal)) :test #'equal))
(setq default-minibuffer-frame nil) (setq default-minibuffer-frame nil)
(let ((id (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id))) (when (frame-live-p exwm-workspace--minibuffer) ; might be already dead
(when (and exwm-workspace--minibuffer id) (let ((id (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id)))
(xcb:+request exwm--connection (when (and exwm-workspace--minibuffer id)
(make-instance 'xcb:ReparentWindow (xcb:+request exwm--connection
:window id (make-instance 'xcb:ReparentWindow
:parent exwm--root :window id
:x 0 :parent exwm--root
:y 0))) :x 0
(setq exwm-workspace--minibuffer nil))) :y 0)))
(setq exwm-workspace--minibuffer nil))))
(defun exwm-workspace--init () (defun exwm-workspace--init ()
"Initialize workspace module." "Initialize workspace module."
@ -1666,33 +1648,22 @@ applied to all subsequently created X frames."
(dolist (i initial-workspaces) (dolist (i initial-workspaces)
(unless (frame-parameter i 'window-id) (unless (frame-parameter i 'window-id)
(setq initial-workspaces (delq i initial-workspaces)))) (setq initial-workspaces (delq i initial-workspaces))))
(setq exwm-workspace--client
(frame-parameter (car initial-workspaces) 'client))
(let ((f (car initial-workspaces))) (let ((f (car initial-workspaces)))
;; Remove the possible internal border. ;; Remove the possible internal border.
(set-frame-parameter f 'internal-border-width 0) (set-frame-parameter f 'internal-border-width 0)))
;; Prevent user from deleting the first frame by accident.
(set-frame-parameter f 'client nil)))
(exwm-workspace--init-minibuffer-frame) (exwm-workspace--init-minibuffer-frame)
;; Remove/hide existing frames. ;; Remove/hide existing frames.
(dolist (f initial-workspaces) (dolist (f initial-workspaces)
(if (frame-parameter f 'client) (when (eq 'x (framep f)) ;do not delete the initial frame.
(progn (delete-frame f)))
(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))))
;; Recreate one frame with the external minibuffer set. ;; Recreate one frame with the external minibuffer set.
(setq initial-workspaces (list (make-frame '((window-system . x) (setq initial-workspaces (list (make-frame '((window-system . x))))))
(client . nil))))))
;; Prevent `other-buffer' from selecting already displayed EXWM buffers. ;; Prevent `other-buffer' from selecting already displayed EXWM buffers.
(modify-all-frames-parameters (modify-all-frames-parameters
'((buffer-predicate . exwm-layout--other-buffer-predicate))) '((buffer-predicate . exwm-layout--other-buffer-predicate)))
;; Create remaining workspaces. ;; Create remaining workspaces.
(dotimes (_ (- exwm-workspace-number (length initial-workspaces))) (dotimes (_ (- exwm-workspace-number (length initial-workspaces)))
(nconc initial-workspaces (list (make-frame '((window-system . x) (nconc initial-workspaces (list (make-frame '((window-system . x))))))
(client . nil))))))
;; Configure workspaces ;; Configure workspaces
(let ((exwm-workspace--create-silently t)) (let ((exwm-workspace--create-silently t))
(dolist (i initial-workspaces) (dolist (i initial-workspaces)
@ -1739,34 +1710,22 @@ applied to all subsequently created X frames."
;; X windows will be re-mapped). ;; X windows will be re-mapped).
(setq exwm-workspace--current nil) (setq exwm-workspace--current nil)
(dolist (i exwm-workspace--list) (dolist (i exwm-workspace--list)
(exwm-workspace--remove-frame-as-workspace i) (when (frame-live-p i) ; might be already dead
(modify-frame-parameters i '((exwm-selected-window . nil) (exwm-workspace--remove-frame-as-workspace i)
(exwm-urgency . nil) (modify-frame-parameters i '((exwm-selected-window . nil)
(exwm-outer-id . nil) (exwm-urgency . nil)
(exwm-id . nil) (exwm-outer-id . nil)
(exwm-container . nil) (exwm-id . nil)
;; (internal-border-width . nil) ; integerp (exwm-container . nil)
;; (client . nil) ;; (internal-border-width . nil) ; integerp
(fullscreen . nil) (fullscreen . nil)
(buffer-predicate . nil)))) (buffer-predicate . nil)))))
;; Restore the 'client' frame parameter (before `exwm-exit'). ;; Don't let dead frames linger.
(when exwm-workspace--client (setq exwm-workspace--list nil))
(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)))
(defun exwm-workspace--post-init () (defun exwm-workspace--post-init ()
"The second stage in the initialization of the workspace module." "The second stage in the initialization of the workspace module."
(exwm--log) (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. ;; Wait until all workspace frames are resized.
(with-timeout (1) (with-timeout (1)
(while (< exwm-workspace--fullscreen-frame-count (exwm-workspace--count)) (while (< exwm-workspace--fullscreen-frame-count (exwm-workspace--count))

44
third_party/exwm/exwm.el vendored
View file

@ -4,7 +4,7 @@
;; Author: Chris Feng <chris.w.feng@gmail.com> ;; Author: Chris Feng <chris.w.feng@gmail.com>
;; Maintainer: Adrián Medraño Calvo <adrian@medranocalvo.com> ;; Maintainer: Adrián Medraño Calvo <adrian@medranocalvo.com>
;; Version: 0.26 ;; Version: 0.27
;; Package-Requires: ((xelb "0.18")) ;; Package-Requires: ((xelb "0.18"))
;; Keywords: unix ;; Keywords: unix
;; URL: https://github.com/ch11ng/exwm ;; URL: https://github.com/ch11ng/exwm
@ -127,7 +127,7 @@
"Restart EXWM." "Restart EXWM."
(interactive) (interactive)
(exwm--log) (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))) (let* ((attr (process-attributes (emacs-pid)))
(args (cdr (assq 'args attr))) (args (cdr (assq 'args attr)))
(ppid (cdr (assq 'ppid attr))) (ppid (cdr (assq 'ppid attr)))
@ -420,8 +420,8 @@
(setq type (slot-value obj 'type) (setq type (slot-value obj 'type)
id (slot-value obj 'window) id (slot-value obj 'window)
data (slot-value (slot-value obj 'data) 'data32)) data (slot-value (slot-value obj 'data) 'data32))
(exwm--log "atom=%s(%s)" (x-get-atom-name type exwm-workspace--current) (exwm--log "atom=%s(%s) id=#x%x data=%s" (x-get-atom-name type exwm-workspace--current)
type) type (or id 0) data)
(cond (cond
;; _NET_NUMBER_OF_DESKTOPS. ;; _NET_NUMBER_OF_DESKTOPS.
((= type xcb:Atom:_NET_NUMBER_OF_DESKTOPS) ((= type xcb:Atom:_NET_NUMBER_OF_DESKTOPS)
@ -434,7 +434,6 @@
((and (> current requested) ((and (> current requested)
(> current 1)) (> current 1))
(let ((frame (car (last exwm-workspace--list)))) (let ((frame (car (last exwm-workspace--list))))
(exwm-workspace--get-remove-frame-next-workspace frame)
(delete-frame frame)))))) (delete-frame frame))))))
;; _NET_CURRENT_DESKTOP. ;; _NET_CURRENT_DESKTOP.
((= type xcb:Atom:_NET_CURRENT_DESKTOP) ((= type xcb:Atom:_NET_CURRENT_DESKTOP)
@ -443,7 +442,8 @@
((= type xcb:Atom:_NET_ACTIVE_WINDOW) ((= type xcb:Atom:_NET_ACTIVE_WINDOW)
(let ((buffer (exwm--id->buffer id)) (let ((buffer (exwm--id->buffer id))
iconic window) 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 (with-current-buffer buffer
(when (eq exwm--frame exwm-workspace--current) (when (eq exwm--frame exwm-workspace--current)
(if exwm--floating-frame (if exwm--floating-frame
@ -457,7 +457,11 @@
(setq window (get-buffer-window nil t)) (setq window (get-buffer-window nil t))
(when (or iconic (when (or iconic
(not (eq window (selected-window)))) (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. ;; _NET_CLOSE_WINDOW.
((= type xcb:Atom:_NET_CLOSE_WINDOW) ((= type xcb:Atom:_NET_CLOSE_WINDOW)
(let ((buffer (exwm--id->buffer id))) (let ((buffer (exwm--id->buffer id)))
@ -605,6 +609,13 @@
(eq selection xcb:Atom:WM_S0)) (eq selection xcb:Atom:WM_S0))
(exwm-exit)))) (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 () (defun exwm--init-icccm-ewmh ()
"Initialize ICCCM/EWMH support." "Initialize ICCCM/EWMH support."
(exwm--log) (exwm--log)
@ -841,6 +852,7 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'."
(condition-case err (condition-case err
(progn (progn
(exwm-enable 'undo) ;never initialize again (exwm-enable 'undo) ;never initialize again
(setq exwm--terminal (frame-terminal frame))
(setq exwm--connection (xcb:connect)) (setq exwm--connection (xcb:connect))
(set-process-query-on-exit-flag (slot-value exwm--connection 'process) (set-process-query-on-exit-flag (slot-value exwm--connection 'process)
nil) ;prevent query message on exit 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 ;; Disable some features not working well with EXWM
(setq use-dialog-box nil (setq use-dialog-box nil
confirm-kill-emacs #'exwm--confirm-kill-emacs) 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--lock)
(exwm--init-icccm-ewmh) (exwm--init-icccm-ewmh)
(exwm-layout--init) (exwm-layout--init)
@ -899,7 +915,9 @@ manager. If t, replace it, if nil, abort and ask the user if `ask'."
(when exwm--connection (when exwm--connection
(xcb:flush exwm--connection) (xcb:flush exwm--connection)
(xcb:disconnect exwm--connection)) (xcb:disconnect exwm--connection))
(setq exwm--connection nil)) (setq exwm--connection nil)
(setq exwm--terminal nil)
(exwm--log "Exited"))
;;;###autoload ;;;###autoload
(defun exwm-enable (&optional undo) (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. ;; For other types, return the value as-is.
(t result)))))) (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) (defun exwm--confirm-kill-emacs (prompt &optional force)
"Confirm before exiting Emacs." "Confirm before exiting Emacs."
(exwm--log) (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)) (`break (y-or-n-p prompt))
(x x))) (x x)))
(t (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)))) (length exwm--id-buffer-alist) prompt))))
;; Run `kill-emacs-hook' (`server-force-stop' excluded) before Emacs ;; Run `kill-emacs-hook' (`server-force-stop' excluded) before Emacs
;; frames are unmapped so that errors (if any) can be visible. ;; frames are unmapped so that errors (if any) can be visible.