35e7b8a1a8
This contains a bunch of upstream changes after the new maintainers of
EXWM took over, including proper mainlined versions of patches I've
been carrying around here manually.
Notably this undoes the Chromium focus fix patch, lets see how that goes.
git-subtree-dir: third_party/exwm
git-subtree-mainline: a756b46bc70a8a1dbb205d50283a3fe65282ed91
git-subtree-split: a6e66f5e33
Change-Id: Ibcaba379b56611b8f1918c3b60469492d64a3eb7
833 lines
39 KiB
EmacsLisp
833 lines
39 KiB
EmacsLisp
;;; exwm-manage.el --- Window Management Module for -*- lexical-binding: t -*-
|
||
;;; EXWM
|
||
|
||
;; Copyright (C) 2015-2024 Free Software Foundation, Inc.
|
||
|
||
;; Author: Chris Feng <chris.w.feng@gmail.com>
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This is the fundamental module of EXWM that deals with window management.
|
||
|
||
;;; Code:
|
||
|
||
(require 'exwm-core)
|
||
|
||
(defgroup exwm-manage nil
|
||
"Manage."
|
||
:group 'exwm)
|
||
|
||
(defcustom exwm-manage-finish-hook nil
|
||
"Normal hook run after a window is just managed.
|
||
This hook runs in the context of the corresponding `exwm-mode' buffer."
|
||
:type 'hook)
|
||
|
||
(defcustom exwm-manage-force-tiling nil
|
||
"Non-nil to force managing all X windows in tiling layout.
|
||
You can still make the X windows floating afterwards."
|
||
:type 'boolean)
|
||
|
||
(defcustom exwm-manage-ping-timeout 3
|
||
"Seconds to wait before killing a client."
|
||
:type 'integer)
|
||
|
||
(defcustom exwm-manage-configurations nil
|
||
"Per-application configurations.
|
||
|
||
Configuration options allow to override various default behaviors of EXWM
|
||
and only take effect when they are present. Note for certain options
|
||
specifying nil is not exactly the same as leaving them out. Currently
|
||
possible choices:
|
||
* floating: Force floating (non-nil) or tiling (nil) on startup.
|
||
* x/y/width/height: Override the initial geometry (floating X window only).
|
||
* border-width: Override the border width (only visible when floating).
|
||
* fullscreen: Force full screen (non-nil) on startup.
|
||
* floating-mode-line: `mode-line-format' used when floating.
|
||
* tiling-mode-line: `mode-line-format' used when tiling.
|
||
* floating-header-line: `header-line-format' used when floating.
|
||
* tiling-header-line: `header-line-format' used when tiling.
|
||
* char-mode: Force char-mode (non-nil) on startup.
|
||
* prefix-keys: `exwm-input-prefix-keys' local to this X window.
|
||
* simulation-keys: `exwm-input-simulation-keys' local to this X window.
|
||
* workspace: The initial workspace.
|
||
* managed: Force to manage (non-nil) or not manage (nil) the X window.
|
||
|
||
For each X window managed for the first time, matching criteria (sexps) are
|
||
evaluated sequentially and the first configuration with a non-nil matching
|
||
criterion would be applied. Apart from generic forms, one would typically
|
||
want to match against EXWM internal variables such as `exwm-title',
|
||
`exwm-class-name' and `exwm-instance-name'."
|
||
:type '(alist :key-type (sexp :tag "Matching criterion" nil)
|
||
:value-type
|
||
(plist :tag "Configurations"
|
||
:options
|
||
(((const :tag "Floating" floating) boolean)
|
||
((const :tag "X" x) number)
|
||
((const :tag "Y" y) number)
|
||
((const :tag "Width" width) number)
|
||
((const :tag "Height" height) number)
|
||
((const :tag "Border width" border-width) integer)
|
||
((const :tag "Fullscreen" fullscreen) boolean)
|
||
((const :tag "Floating mode-line" floating-mode-line)
|
||
sexp)
|
||
((const :tag "Tiling mode-line" tiling-mode-line) sexp)
|
||
((const :tag "Floating header-line"
|
||
floating-header-line)
|
||
sexp)
|
||
((const :tag "Tiling header-line" tiling-header-line)
|
||
sexp)
|
||
((const :tag "Char-mode" char-mode) boolean)
|
||
((const :tag "Prefix keys" prefix-keys)
|
||
(repeat key-sequence))
|
||
((const :tag "Simulation keys" simulation-keys)
|
||
(alist :key-type (key-sequence :tag "From")
|
||
:value-type (key-sequence :tag "To")))
|
||
((const :tag "Workspace" workspace) integer)
|
||
((const :tag "Managed" managed) boolean)
|
||
;; For forward compatibility.
|
||
((other) sexp))))
|
||
;; TODO: This is admittedly ugly. We'd be better off with an event type.
|
||
:get (lambda (symbol)
|
||
(mapcar (lambda (pair)
|
||
(let* ((match (car pair))
|
||
(config (cdr pair))
|
||
(prefix-keys (plist-get config 'prefix-keys)))
|
||
(when prefix-keys
|
||
(setq config (copy-tree config)
|
||
config (plist-put config 'prefix-keys
|
||
(mapcar (lambda (i)
|
||
(if (sequencep i)
|
||
i
|
||
(vector i)))
|
||
prefix-keys))))
|
||
(cons match config)))
|
||
(default-value symbol)))
|
||
:set (lambda (symbol value)
|
||
(set symbol
|
||
(mapcar (lambda (pair)
|
||
(let* ((match (car pair))
|
||
(config (cdr pair))
|
||
(prefix-keys (plist-get config 'prefix-keys)))
|
||
(when prefix-keys
|
||
(setq config (copy-tree config)
|
||
config (plist-put config 'prefix-keys
|
||
(mapcar (lambda (i)
|
||
(if (sequencep i)
|
||
(aref i 0)
|
||
i))
|
||
prefix-keys))))
|
||
(cons match config)))
|
||
value))))
|
||
|
||
;; FIXME: Make the following values as small as possible.
|
||
(defconst exwm-manage--height-delta-min 5)
|
||
(defconst exwm-manage--width-delta-min 5)
|
||
|
||
;; The _MOTIF_WM_HINTS atom (see <Xm/MwmUtil.h> for more details)
|
||
;; It's currently only used in 'exwm-manage' module
|
||
(defvar exwm-manage--_MOTIF_WM_HINTS nil "_MOTIF_WM_HINTS atom.")
|
||
|
||
(defvar exwm-manage--desktop nil "The desktop X window.")
|
||
|
||
(defvar exwm-manage--frame-outer-id-list nil
|
||
"List of window-outer-id's of all frames.")
|
||
|
||
(defvar exwm-manage--ping-lock nil
|
||
"Non-nil indicates EXWM is pinging a window.")
|
||
|
||
(defvar exwm-input--skip-buffer-list-update)
|
||
(defvar exwm-input-prefix-keys)
|
||
(defvar exwm-workspace--current)
|
||
(defvar exwm-workspace--id-struts-alist)
|
||
(defvar exwm-workspace--list)
|
||
(defvar exwm-workspace--switch-history-outdated)
|
||
(defvar exwm-workspace-current-index)
|
||
(declare-function exwm--update-class "exwm.el" (id &optional force))
|
||
(declare-function exwm--update-hints "exwm.el" (id &optional force))
|
||
(declare-function exwm--update-normal-hints "exwm.el" (id &optional force))
|
||
(declare-function exwm--update-protocols "exwm.el" (id &optional force))
|
||
(declare-function exwm--update-struts "exwm.el" (id))
|
||
(declare-function exwm--update-title "exwm.el" (id))
|
||
(declare-function exwm--update-transient-for "exwm.el" (id &optional force))
|
||
(declare-function exwm--update-desktop "exwm.el" (id &optional force))
|
||
(declare-function exwm--update-window-type "exwm.el" (id &optional force))
|
||
(declare-function exwm-floating--set-floating "exwm-floating.el" (id))
|
||
(declare-function exwm-floating--unset-floating "exwm-floating.el" (id))
|
||
(declare-function exwm-input-grab-keyboard "exwm-input.el" (&optional id))
|
||
(declare-function exwm-input-release-keyboard "exwm-input.el" (&optional id))
|
||
(declare-function exwm-input-set-local-simulation-keys "exwm-input.el")
|
||
(declare-function exwm-layout--fullscreen-p "exwm-layout.el" ())
|
||
(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id))
|
||
(declare-function exwm-layout-set-fullscreen "exwm-layout.el" (&optional id))
|
||
(declare-function exwm-workspace--get-geometry "exwm-workspace.el" (frame))
|
||
(declare-function exwm-workspace--position "exwm-workspace.el" (frame))
|
||
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
|
||
(declare-function exwm-workspace--update-struts "exwm-workspace.el" ())
|
||
(declare-function exwm-workspace--update-workareas "exwm-workspace.el" ())
|
||
(declare-function exwm-workspace--workarea "exwm-workspace.el" (frame))
|
||
|
||
(defun exwm-manage--update-geometry (id &optional force)
|
||
"Update geometry of X window ID.
|
||
Override current geometry if FORCE is non-nil."
|
||
(exwm--log "id=#x%x" id)
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless (and exwm--geometry (not force))
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:GetGeometry :drawable id))))
|
||
(setq exwm--geometry
|
||
(or reply
|
||
;; Provide a reasonable fallback value.
|
||
(make-instance 'xcb:RECTANGLE
|
||
:x 0
|
||
:y 0
|
||
:width (/ (x-display-pixel-width) 2)
|
||
:height (/ (x-display-pixel-height) 2))))))))
|
||
|
||
(defun exwm-manage--update-ewmh-state (id)
|
||
"Update _NET_WM_STATE of X window ID."
|
||
(exwm--log "id=#x%x" id)
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless exwm--ewmh-state
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:ewmh:get-_NET_WM_STATE
|
||
:window id))))
|
||
(when reply
|
||
(setq exwm--ewmh-state (append (slot-value reply 'value) nil)))))))
|
||
|
||
(defun exwm-manage--update-mwm-hints (id &optional force)
|
||
"Update _MOTIF_WM_HINTS of X window ID.
|
||
Override current hinds if FORCE is non-nil."
|
||
(exwm--log "id=#x%x" id)
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless (and (not exwm--mwm-hints-decorations) (not force))
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:icccm:-GetProperty
|
||
:window id
|
||
:property exwm-manage--_MOTIF_WM_HINTS
|
||
:type exwm-manage--_MOTIF_WM_HINTS
|
||
:long-length 5))))
|
||
(when reply
|
||
;; Check MotifWmHints.decorations.
|
||
(with-slots (value) reply
|
||
(setq value (append value nil))
|
||
(when (and value
|
||
;; See <Xm/MwmUtil.h> for fields definitions.
|
||
(/= 0 (logand
|
||
(elt value 0) ;MotifWmHints.flags
|
||
2)) ;MWM_HINTS_DECORATIONS
|
||
(= 0
|
||
(elt value 2))) ;MotifWmHints.decorations
|
||
(setq exwm--mwm-hints-decorations nil))))))))
|
||
|
||
(defun exwm-manage--update-default-directory (id)
|
||
"Update the `default-directory' of X window ID.
|
||
Sets the `default-directory' of the EXWM buffer associated with X window to
|
||
match its current working directory.
|
||
|
||
This only works when procfs is mounted, which may not be the case on some BSDs."
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(if-let* ((response (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:ewmh:get-_NET_WM_PID
|
||
:window id)))
|
||
(pid (slot-value response 'value))
|
||
(cwd (file-symlink-p (format "/proc/%d/cwd" pid)))
|
||
((file-accessible-directory-p cwd)))
|
||
(setq default-directory (file-name-as-directory cwd))
|
||
(setq default-directory (expand-file-name "~/")))))
|
||
|
||
|
||
(defun exwm-manage--set-client-list ()
|
||
"Set _NET_CLIENT_LIST."
|
||
(exwm--log)
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST
|
||
:window exwm--root
|
||
:data (vconcat (mapcar #'car exwm--id-buffer-alist)))))
|
||
|
||
(cl-defun exwm-manage--get-configurations ()
|
||
"Retrieve configurations for this buffer."
|
||
(exwm--log)
|
||
(when (derived-mode-p 'exwm-mode)
|
||
(dolist (i exwm-manage-configurations)
|
||
(save-current-buffer
|
||
(when (with-demoted-errors "Problematic configuration: %S"
|
||
(eval (car i) t))
|
||
(cl-return-from exwm-manage--get-configurations (cdr i)))))))
|
||
|
||
(defun exwm-manage--manage-window (id)
|
||
"Manage window ID."
|
||
(exwm--log "Try to manage #x%x" id)
|
||
(catch 'return
|
||
;; Ensure it's alive
|
||
(when (xcb:+request-checked+request-check exwm--connection
|
||
(make-instance 'xcb:ChangeWindowAttributes
|
||
:window id :value-mask xcb:CW:EventMask
|
||
:event-mask (exwm--get-client-event-mask)))
|
||
(throw 'return 'dead))
|
||
;; Add this X window to save-set.
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ChangeSaveSet
|
||
:mode xcb:SetMode:Insert
|
||
:window id))
|
||
(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)))))
|
||
(exwm-mode)
|
||
(setq exwm--id id
|
||
exwm--frame exwm-workspace--current)
|
||
(exwm--update-window-type id)
|
||
(exwm--update-class id)
|
||
(exwm--update-transient-for id)
|
||
(exwm--update-normal-hints id)
|
||
(exwm--update-hints id)
|
||
(exwm-manage--update-geometry id)
|
||
(exwm-manage--update-mwm-hints id)
|
||
(exwm--update-title id)
|
||
(exwm--update-protocols id)
|
||
(setq exwm--configurations (exwm-manage--get-configurations))
|
||
;; OverrideRedirect is not checked here.
|
||
(when (and
|
||
;; The user has specified to manage it.
|
||
(not (plist-get exwm--configurations 'managed))
|
||
(or
|
||
;; The user has specified not to manage it.
|
||
(plist-member exwm--configurations 'managed)
|
||
;; This is not a type of X window we can manage.
|
||
(and exwm-window-type
|
||
(not (cl-intersection
|
||
exwm-window-type
|
||
(list xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_NORMAL))))
|
||
;; Check the _MOTIF_WM_HINTS property to not manage floating X
|
||
;; windows without decoration.
|
||
(and (not exwm--mwm-hints-decorations)
|
||
(not exwm--hints-input)
|
||
;; Floating windows only
|
||
(or exwm-transient-for exwm--fixed-size
|
||
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY
|
||
exwm-window-type)
|
||
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG
|
||
exwm-window-type)))))
|
||
(exwm--log "No need to manage #x%x" id)
|
||
;; Update struts.
|
||
(when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK exwm-window-type)
|
||
(exwm--update-struts id))
|
||
;; Remove all events
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ChangeWindowAttributes
|
||
:window id :value-mask xcb:CW:EventMask
|
||
:event-mask
|
||
(if (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK
|
||
exwm-window-type)
|
||
;; Listen for PropertyChange (struts) and
|
||
;; UnmapNotify/DestroyNotify event of the dock.
|
||
(exwm--get-client-event-mask)
|
||
xcb:EventMask:NoEvent)))
|
||
;; The window needs to be mapped
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:MapWindow :window id))
|
||
(with-slots (x y width height) exwm--geometry
|
||
;; Center window of type _NET_WM_WINDOW_TYPE_SPLASH
|
||
(when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH exwm-window-type)
|
||
(with-slots ((x* x) (y* y) (width* width) (height* height))
|
||
(exwm-workspace--workarea exwm--frame)
|
||
(exwm--set-geometry id
|
||
(+ x* (/ (- width* width) 2))
|
||
(+ y* (/ (- height* height) 2))
|
||
nil
|
||
nil))))
|
||
;; Check for desktop.
|
||
(when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DESKTOP exwm-window-type)
|
||
;; There should be only one desktop X window.
|
||
(setq exwm-manage--desktop id)
|
||
;; Put it at bottom.
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ConfigureWindow
|
||
:window id
|
||
:value-mask xcb:ConfigWindow:StackMode
|
||
: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)
|
||
(exwm-input--skip-buffer-list-update t))
|
||
(kill-buffer (current-buffer)))
|
||
(throw 'return 'ignored))
|
||
(let ((index (plist-get exwm--configurations 'workspace)))
|
||
(when (and index (< index (length exwm-workspace--list)))
|
||
(setq exwm--frame (elt exwm-workspace--list index))))
|
||
;; Manage the window
|
||
(exwm--log "Manage #x%x" id)
|
||
(xcb:+request exwm--connection ;remove border
|
||
(make-instance 'xcb:ConfigureWindow
|
||
:window id :value-mask xcb:ConfigWindow:BorderWidth
|
||
:border-width 0))
|
||
(dolist (button ;grab buttons to set focus / move / resize
|
||
(list xcb:ButtonIndex:1 xcb:ButtonIndex:2 xcb:ButtonIndex:3))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:GrabButton
|
||
:owner-events 0 :grab-window id
|
||
:event-mask xcb:EventMask:ButtonPress
|
||
:pointer-mode xcb:GrabMode:Sync
|
||
:keyboard-mode xcb:GrabMode:Async
|
||
:confine-to xcb:Window:None :cursor xcb:Cursor:None
|
||
:button button :modifiers xcb:ModMask:Any)))
|
||
(exwm-manage--set-client-list)
|
||
(xcb:flush exwm--connection)
|
||
(if (plist-member exwm--configurations 'floating)
|
||
;; User has specified whether it should be floating.
|
||
(if (plist-get exwm--configurations 'floating)
|
||
(exwm-floating--set-floating id)
|
||
(with-selected-window (frame-selected-window exwm--frame)
|
||
(exwm-floating--unset-floating id)))
|
||
;; Try to determine if it should be floating.
|
||
(if (and (not exwm-manage-force-tiling)
|
||
(or exwm-transient-for exwm--fixed-size
|
||
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY
|
||
exwm-window-type)
|
||
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG
|
||
exwm-window-type)))
|
||
(exwm-floating--set-floating id)
|
||
(with-selected-window (frame-selected-window exwm--frame)
|
||
(exwm-floating--unset-floating id))))
|
||
(if (plist-get exwm--configurations 'char-mode)
|
||
(exwm-input-release-keyboard id)
|
||
(exwm-input-grab-keyboard id))
|
||
(when-let ((simulation-keys (plist-get exwm--configurations 'simulation-keys)))
|
||
(exwm-input-set-local-simulation-keys simulation-keys))
|
||
(when-let ((prefix-keys (plist-get exwm--configurations 'prefix-keys)))
|
||
(setq-local exwm-input-prefix-keys prefix-keys))
|
||
(setq exwm-workspace--switch-history-outdated t)
|
||
(exwm--update-desktop id)
|
||
(exwm-manage--update-ewmh-state id)
|
||
(exwm-manage--update-default-directory id)
|
||
(when (or (plist-get exwm--configurations 'fullscreen)
|
||
(exwm-layout--fullscreen-p))
|
||
(setq exwm--ewmh-state (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN
|
||
exwm--ewmh-state))
|
||
(exwm-layout-set-fullscreen id))
|
||
(run-hooks 'exwm-manage-finish-hook))))
|
||
|
||
(defun exwm-manage--unmanage-window (id &optional withdraw-only)
|
||
"Unmanage window ID.
|
||
|
||
If WITHDRAW-ONLY is non-nil, the X window will be properly placed back to the
|
||
root window. Set WITHDRAW-ONLY to `quit' if this functions is used when window
|
||
manager is shutting down."
|
||
(let ((buffer (exwm--id->buffer id)))
|
||
(exwm--log "Unmanage #x%x (buffer: %s, widthdraw: %s)"
|
||
id buffer withdraw-only)
|
||
(setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist))
|
||
;; Update workspaces when a dock is destroyed.
|
||
(when (and (null withdraw-only)
|
||
(assq id exwm-workspace--id-struts-alist))
|
||
(setq exwm-workspace--id-struts-alist
|
||
(assq-delete-all id exwm-workspace--id-struts-alist))
|
||
(exwm-workspace--update-struts)
|
||
(exwm-workspace--update-workareas)
|
||
(dolist (f exwm-workspace--list)
|
||
(exwm-workspace--set-fullscreen f)))
|
||
(when (and (buffer-live-p buffer)
|
||
;; Invoked from `exwm-manage--exit' upon disconnection.
|
||
(slot-value exwm--connection 'connected))
|
||
(with-current-buffer buffer
|
||
;; Unmap the X window.
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:UnmapWindow :window id))
|
||
;;
|
||
(setq exwm-workspace--switch-history-outdated t)
|
||
;;
|
||
(when withdraw-only
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ChangeWindowAttributes
|
||
:window id :value-mask xcb:CW:EventMask
|
||
:event-mask xcb:EventMask:NoEvent))
|
||
;; Delete WM_STATE property
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:DeleteProperty
|
||
:window id :property xcb:Atom:WM_STATE))
|
||
(cond
|
||
((eq withdraw-only 'quit)
|
||
;; Remap the window when exiting.
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:MapWindow :window id)))
|
||
(t
|
||
;; Remove _NET_WM_DESKTOP.
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:DeleteProperty
|
||
:window id
|
||
:property xcb:Atom:_NET_WM_DESKTOP)))))
|
||
(when exwm--floating-frame
|
||
;; Unmap the floating frame before destroying its container.
|
||
(let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id))
|
||
(container (frame-parameter exwm--floating-frame
|
||
'exwm-container)))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:UnmapWindow :window window))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ReparentWindow
|
||
:window window :parent exwm--root :x 0 :y 0))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:DestroyWindow :window container))))
|
||
(when (exwm-layout--fullscreen-p)
|
||
(let ((window (get-buffer-window)))
|
||
(when window
|
||
(set-window-dedicated-p window nil))))
|
||
(exwm-manage--set-client-list)
|
||
(xcb:flush exwm--connection))
|
||
(let ((kill-buffer-func
|
||
(lambda (buffer)
|
||
(when (buffer-local-value 'exwm--floating-frame buffer)
|
||
(select-window
|
||
(frame-selected-window exwm-workspace--current)))
|
||
(with-current-buffer buffer
|
||
(let ((kill-buffer-query-functions nil))
|
||
(kill-buffer buffer))))))
|
||
(exwm--defer 0 kill-buffer-func buffer)
|
||
(when (active-minibuffer-window)
|
||
(exit-minibuffer))))))
|
||
|
||
(defun exwm-manage--scan ()
|
||
"Search for existing windows and try to manage them."
|
||
(exwm--log)
|
||
(let* ((tree (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:QueryTree
|
||
:window exwm--root)))
|
||
reply)
|
||
(dolist (i (slot-value tree 'children))
|
||
(setq reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:GetWindowAttributes
|
||
:window i)))
|
||
;; It's possible the X window has been destroyed.
|
||
(when reply
|
||
(with-slots (override-redirect map-state) reply
|
||
(when (and (= 0 override-redirect)
|
||
(= xcb:MapState:Viewable map-state))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:UnmapWindow
|
||
:window i))
|
||
(xcb:flush exwm--connection)
|
||
(exwm-manage--manage-window i)))))))
|
||
|
||
(defun exwm-manage--kill-buffer-query-function ()
|
||
"Run in `kill-buffer-query-functions'."
|
||
(exwm--log "id=#x%x; buffer=%s" (or exwm--id 0) (current-buffer))
|
||
(catch 'return
|
||
(when (or (not exwm--connection)
|
||
(not (slot-value exwm--connection 'connected)))
|
||
(throw 'return t))
|
||
(when (or (not exwm--id)
|
||
(xcb:+request-checked+request-check exwm--connection
|
||
(make-instance 'xcb:ChangeWindowAttributes
|
||
:window exwm--id
|
||
:value-mask xcb:CW:EventMask
|
||
:event-mask (exwm--get-client-event-mask))))
|
||
;; The X window is no longer alive so just close the buffer.
|
||
(when exwm--floating-frame
|
||
(let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id))
|
||
(container (frame-parameter exwm--floating-frame
|
||
'exwm-container)))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:UnmapWindow :window window))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ReparentWindow
|
||
:window window
|
||
:parent exwm--root
|
||
:x 0 :y 0))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:DestroyWindow
|
||
:window container))))
|
||
(xcb:flush exwm--connection)
|
||
(throw 'return t))
|
||
(unless (memq xcb:Atom:WM_DELETE_WINDOW exwm--protocols)
|
||
;; The X window does not support WM_DELETE_WINDOW; destroy it.
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:DestroyWindow :window exwm--id))
|
||
(xcb:flush exwm--connection)
|
||
;; Wait for DestroyNotify event.
|
||
(throw 'return nil))
|
||
(let ((id exwm--id))
|
||
;; Try to close the X window with WM_DELETE_WINDOW client message.
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:icccm:SendEvent
|
||
:destination id
|
||
:event (xcb:marshal
|
||
(make-instance 'xcb:icccm:WM_DELETE_WINDOW
|
||
:window id)
|
||
exwm--connection)))
|
||
(xcb:flush exwm--connection)
|
||
;;
|
||
(unless (memq xcb:Atom:_NET_WM_PING exwm--protocols)
|
||
;; For X windows without _NET_WM_PING support, we'd better just
|
||
;; wait for DestroyNotify events.
|
||
(throw 'return nil))
|
||
;; Try to determine if the X window is dead with _NET_WM_PING.
|
||
(setq exwm-manage--ping-lock t)
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:SendEvent
|
||
:propagate 0
|
||
:destination id
|
||
:event-mask xcb:EventMask:NoEvent
|
||
:event (xcb:marshal
|
||
(make-instance 'xcb:ewmh:_NET_WM_PING
|
||
:window id
|
||
:timestamp 0
|
||
:client-window id)
|
||
exwm--connection)))
|
||
(xcb:flush exwm--connection)
|
||
(with-timeout (exwm-manage-ping-timeout
|
||
(if (y-or-n-p (format "'%s' is not responding. \
|
||
Would you like to kill it? "
|
||
(buffer-name)))
|
||
(progn (exwm-manage--kill-client id)
|
||
;; Kill the unresponsive X window and
|
||
;; wait for DestroyNotify event.
|
||
(throw 'return nil))
|
||
;; Give up.
|
||
(throw 'return nil)))
|
||
(while (and exwm-manage--ping-lock
|
||
(exwm--id->buffer id)) ;may have been destroyed.
|
||
(accept-process-output nil 0.1))
|
||
;; Give up.
|
||
(throw 'return nil)))))
|
||
|
||
(defun exwm-manage--kill-client (&optional id)
|
||
"Kill X client ID.
|
||
If ID is nil, kill X window corresponding to current buffer."
|
||
(unless id (setq id (exwm--buffer->id (current-buffer))))
|
||
(exwm--log "id=#x%x" id)
|
||
(let* ((response (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:ewmh:get-_NET_WM_PID :window id)))
|
||
(pid (and response (slot-value response 'value)))
|
||
(request (make-instance 'xcb:KillClient :resource id)))
|
||
(if (not pid)
|
||
(xcb:+request exwm--connection request)
|
||
;; What if the PID is fake/wrong?
|
||
(signal-process pid 'SIGKILL)
|
||
;; Ensure it's dead
|
||
(run-with-timer exwm-manage-ping-timeout nil
|
||
(lambda ()
|
||
(xcb:+request exwm--connection request))))
|
||
(xcb:flush exwm--connection)))
|
||
|
||
(defun exwm-manage--add-frame (frame)
|
||
"Run in `after-make-frame-functions'.
|
||
FRAME is the newly created frame."
|
||
(exwm--log "frame=%s" frame)
|
||
(when (display-graphic-p frame)
|
||
(push (string-to-number (frame-parameter frame 'outer-window-id))
|
||
exwm-manage--frame-outer-id-list)))
|
||
|
||
(defun exwm-manage--remove-frame (frame)
|
||
"Run in `delete-frame-functions'.
|
||
FRAME is the frame to be deleted."
|
||
(exwm--log "frame=%s" frame)
|
||
(when (display-graphic-p frame)
|
||
(setq exwm-manage--frame-outer-id-list
|
||
(delq (string-to-number (frame-parameter frame 'outer-window-id))
|
||
exwm-manage--frame-outer-id-list))))
|
||
|
||
(defun exwm-manage--on-ConfigureRequest (data _synthetic)
|
||
"Handle ConfigureRequest event.
|
||
DATA contains unmarshalled ConfigureRequest event data."
|
||
(exwm--log)
|
||
(let ((obj (make-instance 'xcb:ConfigureRequest))
|
||
buffer edges width-delta height-delta)
|
||
(xcb:unmarshal obj data)
|
||
(with-slots (window x y width height
|
||
border-width sibling stack-mode value-mask)
|
||
obj
|
||
(exwm--log "#x%x (#x%x) @%dx%d%+d%+d; \
|
||
border-width: %d; sibling: #x%x; stack-mode: %d"
|
||
window value-mask width height x y
|
||
border-width sibling stack-mode)
|
||
(if (and (setq buffer (exwm--id->buffer window))
|
||
(with-current-buffer buffer
|
||
(or (exwm-layout--fullscreen-p)
|
||
;; Make sure it's a floating X window wanting to resize
|
||
;; itself.
|
||
(or (not exwm--floating-frame)
|
||
(progn
|
||
(setq edges
|
||
(window-inside-pixel-edges
|
||
(get-buffer-window buffer t))
|
||
width-delta (- width (- (elt edges 2)
|
||
(elt edges 0)))
|
||
height-delta (- height (- (elt edges 3)
|
||
(elt edges 1))))
|
||
;; We cannot do resizing precisely for now.
|
||
(and (if (= 0 (logand value-mask
|
||
xcb:ConfigWindow:Width))
|
||
t
|
||
(< (abs width-delta)
|
||
exwm-manage--width-delta-min))
|
||
(if (= 0 (logand value-mask
|
||
xcb:ConfigWindow:Height))
|
||
t
|
||
(< (abs height-delta)
|
||
exwm-manage--height-delta-min))))))))
|
||
;; Send client message for managed windows
|
||
(with-current-buffer buffer
|
||
(setq edges
|
||
(if (exwm-layout--fullscreen-p)
|
||
(with-slots (x y width height)
|
||
(exwm-workspace--get-geometry exwm--frame)
|
||
(list x y width height))
|
||
(window-inside-absolute-pixel-edges
|
||
(get-buffer-window buffer t))))
|
||
(exwm--log "Reply with ConfigureNotify (edges): %s" edges)
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:SendEvent
|
||
:propagate 0 :destination window
|
||
:event-mask xcb:EventMask:StructureNotify
|
||
:event (xcb:marshal
|
||
(make-instance
|
||
'xcb:ConfigureNotify
|
||
:event window :window window
|
||
:above-sibling xcb:Window:None
|
||
:x (elt edges 0) :y (elt edges 1)
|
||
:width (- (elt edges 2) (elt edges 0))
|
||
:height (- (elt edges 3) (elt edges 1))
|
||
:border-width 0 :override-redirect 0)
|
||
exwm--connection))))
|
||
(if buffer
|
||
(with-current-buffer buffer
|
||
(exwm--log "ConfigureWindow (resize floating X window)")
|
||
(exwm--set-geometry (frame-parameter exwm--floating-frame
|
||
'exwm-outer-id)
|
||
nil
|
||
nil
|
||
(+ (frame-pixel-width exwm--floating-frame)
|
||
width-delta)
|
||
(+ (frame-pixel-height exwm--floating-frame)
|
||
height-delta)))
|
||
(exwm--log "ConfigureWindow (preserve geometry)")
|
||
;; Configure the unmanaged window.
|
||
;; But Emacs frames should be excluded. Generally we don't
|
||
;; receive ConfigureRequest events from Emacs frames since we
|
||
;; have set OverrideRedirect on them, but this is not true for
|
||
;; Lucid build (as of 25.1).
|
||
(unless (memq window exwm-manage--frame-outer-id-list)
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ConfigureWindow
|
||
:window window
|
||
:value-mask value-mask
|
||
:x x :y y :width width :height height
|
||
:border-width border-width
|
||
:sibling sibling
|
||
:stack-mode stack-mode)))))))
|
||
(xcb:flush exwm--connection))
|
||
|
||
(defun exwm-manage--on-MapRequest (data _synthetic)
|
||
"Handle MapRequest event.
|
||
DATA contains unmarshalled MapRequest event data."
|
||
(let ((obj (make-instance 'xcb:MapRequest)))
|
||
(xcb:unmarshal obj data)
|
||
(with-slots (parent window) obj
|
||
(exwm--log "id=#x%x parent=#x%x" window parent)
|
||
(if (assoc window exwm--id-buffer-alist)
|
||
(with-current-buffer (exwm--id->buffer window)
|
||
(if (exwm-layout--iconic-state-p)
|
||
;; State change: iconic => normal.
|
||
(when (eq exwm--frame exwm-workspace--current)
|
||
(pop-to-buffer-same-window (current-buffer)))
|
||
(exwm--log "#x%x is already managed" window)))
|
||
(if (/= exwm--root parent)
|
||
(progn (xcb:+request exwm--connection
|
||
(make-instance 'xcb:MapWindow :window window))
|
||
(xcb:flush exwm--connection))
|
||
(exwm--log "#x%x" window)
|
||
(exwm-manage--manage-window window))))))
|
||
|
||
(defun exwm-manage--on-UnmapNotify (data _synthetic)
|
||
"Handle UnmapNotify event.
|
||
DATA contains unmarshalled UnmapNotify event data."
|
||
(let ((obj (make-instance 'xcb:UnmapNotify)))
|
||
(xcb:unmarshal obj data)
|
||
(with-slots (window) obj
|
||
(exwm--log "id=#x%x" window)
|
||
(exwm-manage--unmanage-window window t))))
|
||
|
||
(defun exwm-manage--on-MapNotify (data _synthetic)
|
||
"Handle MapNotify event.
|
||
DATA contains unmarshalled MapNotify event data."
|
||
(let ((obj (make-instance 'xcb:MapNotify)))
|
||
(xcb:unmarshal obj data)
|
||
(with-slots (window) obj
|
||
(when (assoc window exwm--id-buffer-alist)
|
||
(exwm--log "id=#x%x" window)
|
||
;; With this we ensure that a "window hierarchy change" happens after
|
||
;; mapping the window, as some servers (XQuartz) do not generate it.
|
||
(with-current-buffer (exwm--id->buffer window)
|
||
(if exwm--floating-frame
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ConfigureWindow
|
||
:window window
|
||
:value-mask xcb:ConfigWindow:StackMode
|
||
:stack-mode xcb:StackMode:Above))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ConfigureWindow
|
||
:window window
|
||
:value-mask (logior xcb:ConfigWindow:Sibling
|
||
xcb:ConfigWindow:StackMode)
|
||
:sibling exwm--guide-window
|
||
:stack-mode xcb:StackMode:Above))))
|
||
(xcb:flush exwm--connection)))))
|
||
|
||
(defun exwm-manage--on-DestroyNotify (data synthetic)
|
||
"Handle DestroyNotify event.
|
||
DATA contains unmarshalled DestroyNotify event data.
|
||
SYNTHETIC indicates whether the event is a synthetic event."
|
||
(unless synthetic
|
||
(exwm--log)
|
||
(let ((obj (make-instance 'xcb:DestroyNotify)))
|
||
(xcb:unmarshal obj data)
|
||
(exwm--log "#x%x" (slot-value obj 'window))
|
||
(exwm-manage--unmanage-window (slot-value obj 'window)))))
|
||
|
||
(defun exwm-manage--init ()
|
||
"Initialize manage module."
|
||
;; Intern _MOTIF_WM_HINTS
|
||
(exwm--log)
|
||
(setq exwm-manage--_MOTIF_WM_HINTS (exwm--intern-atom "_MOTIF_WM_HINTS"))
|
||
(add-hook 'after-make-frame-functions #'exwm-manage--add-frame)
|
||
(add-hook 'delete-frame-functions #'exwm-manage--remove-frame)
|
||
(xcb:+event exwm--connection 'xcb:ConfigureRequest
|
||
#'exwm-manage--on-ConfigureRequest)
|
||
(xcb:+event exwm--connection 'xcb:MapRequest #'exwm-manage--on-MapRequest)
|
||
(xcb:+event exwm--connection 'xcb:UnmapNotify #'exwm-manage--on-UnmapNotify)
|
||
(xcb:+event exwm--connection 'xcb:MapNotify #'exwm-manage--on-MapNotify)
|
||
(xcb:+event exwm--connection 'xcb:DestroyNotify
|
||
#'exwm-manage--on-DestroyNotify))
|
||
|
||
(defun exwm-manage--exit ()
|
||
"Exit the manage module."
|
||
(exwm--log)
|
||
(dolist (pair exwm--id-buffer-alist)
|
||
(exwm-manage--unmanage-window (car pair) 'quit))
|
||
(remove-hook 'after-make-frame-functions #'exwm-manage--add-frame)
|
||
(remove-hook 'delete-frame-functions #'exwm-manage--remove-frame)
|
||
(setq exwm-manage--_MOTIF_WM_HINTS nil))
|
||
|
||
|
||
|
||
(provide 'exwm-manage)
|
||
|
||
;;; exwm-manage.el ends here
|