805 lines
38 KiB
EmacsLisp
805 lines
38 KiB
EmacsLisp
;;; exwm-manage.el --- Window Management Module for -*- lexical-binding: t -*-
|
||
;;; EXWM
|
||
|
||
;; Copyright (C) 2015-2020 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."
|
||
:version "25.3"
|
||
:group 'exwm)
|
||
|
||
(defcustom exwm-manage-finish-hook nil
|
||
"Normal hook run after a window is just managed, in the context of the
|
||
corresponding buffer."
|
||
: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--workareas)
|
||
(defvar exwm-workspace-current-index)
|
||
(declare-function exwm--update-class "exwm.el" (id &optional force))
|
||
(declare-function exwm--update-hints "exwm.el" (id &optional force))
|
||
(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")
|
||
(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-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" ())
|
||
|
||
(defun exwm-manage--update-geometry (id &optional force)
|
||
"Update window geometry."
|
||
(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."
|
||
(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."
|
||
(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--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)
|
||
(let* ((workarea (elt exwm-workspace--workareas
|
||
(exwm-workspace--position exwm--frame)))
|
||
(x* (aref workarea 0))
|
||
(y* (aref workarea 1))
|
||
(width* (aref workarea 2))
|
||
(height* (aref workarea 3)))
|
||
(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))
|
||
(let ((simulation-keys (plist-get exwm--configurations 'simulation-keys))
|
||
(prefix-keys (plist-get exwm--configurations 'prefix-keys)))
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(when simulation-keys
|
||
(exwm-input-set-local-simulation-keys simulation-keys))
|
||
(when prefix-keys
|
||
(setq-local exwm-input-prefix-keys prefix-keys))))
|
||
(setq exwm-workspace--switch-history-outdated t)
|
||
(exwm--update-desktop id)
|
||
(exwm-manage--update-ewmh-state id)
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(when (or (plist-get exwm--configurations 'fullscreen)
|
||
(exwm-layout--fullscreen-p))
|
||
(setq exwm--ewmh-state (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN
|
||
exwm--ewmh-state))
|
||
(exwm-layout-set-fullscreen id))
|
||
(run-hooks 'exwm-manage-finish-hook)))))
|
||
|
||
(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 (buffer-live-p buffer)
|
||
(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" exwm--id (current-buffer))
|
||
(catch 'return
|
||
(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 an X client."
|
||
(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'."
|
||
(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'."
|
||
(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."
|
||
(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."
|
||
(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."
|
||
(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."
|
||
(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."
|
||
(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
|