diff options
Diffstat (limited to 'third_party/exwm/exwm-manage.el')
| -rw-r--r-- | third_party/exwm/exwm-manage.el | 820 |
1 files changed, 820 insertions, 0 deletions
diff --git a/third_party/exwm/exwm-manage.el b/third_party/exwm/exwm-manage.el new file mode 100644 index 000000000000..4771c3c088db --- /dev/null +++ b/third_party/exwm/exwm-manage.el @@ -0,0 +1,820 @@ +;;; exwm-manage.el --- Window Management Module for -*- lexical-binding: t -*- +;;; EXWM + +;; Copyright (C) 2015-2023 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. +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--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)) + (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 (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 |