diff options
Diffstat (limited to 'third_party/exwm/exwm-manage.el')
-rw-r--r-- | third_party/exwm/exwm-manage.el | 115 |
1 files changed, 73 insertions, 42 deletions
diff --git a/third_party/exwm/exwm-manage.el b/third_party/exwm/exwm-manage.el index e940257fc9..ab66e298ac 100644 --- a/third_party/exwm/exwm-manage.el +++ b/third_party/exwm/exwm-manage.el @@ -1,7 +1,7 @@ ;;; exwm-manage.el --- Window Management Module for -*- lexical-binding: t -*- ;;; EXWM -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. +;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng <chris.w.feng@gmail.com> @@ -30,12 +30,11 @@ (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." + "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 @@ -151,12 +150,12 @@ want to match against EXWM internal variables such as `exwm-title', (defvar exwm-manage--ping-lock nil "Non-nil indicates EXWM is pinging a window.") +(defvar exwm-input--skip-buffer-list-update) (defvar exwm-input-prefix-keys) (defvar exwm-workspace--current) (defvar exwm-workspace--id-struts-alist) (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)) @@ -169,17 +168,22 @@ want to match against EXWM internal variables such as `exwm-title', (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-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 window geometry." + "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)) @@ -195,7 +199,7 @@ want to match against EXWM internal variables such as `exwm-title', :height (/ (x-display-pixel-height) 2)))))))) (defun exwm-manage--update-ewmh-state (id) - "Update _NET_WM_STATE." + "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 @@ -206,7 +210,8 @@ want to match against EXWM internal variables such as `exwm-title', (setq exwm--ewmh-state (append (slot-value reply 'value) nil))))))) (defun exwm-manage--update-mwm-hints (id &optional force) - "Update _MOTIF_WM_HINTS." + "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)) @@ -229,6 +234,23 @@ want to match against EXWM internal variables such as `exwm-title', (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) @@ -262,7 +284,8 @@ want to match against EXWM internal variables such as `exwm-title', (make-instance 'xcb:ChangeSaveSet :mode xcb:SetMode:Insert :window id)) - (with-current-buffer (generate-new-buffer "*EXWM*") + (with-current-buffer (let ((exwm-input--skip-buffer-list-update t)) + (generate-new-buffer "*EXWM*")) ;; Keep the oldest X window first. (setq exwm--id-buffer-alist (nconc exwm--id-buffer-alist `((,id . ,(current-buffer))))) @@ -324,12 +347,8 @@ want to match against EXWM internal variables such as `exwm-title', (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))) + (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)) @@ -347,7 +366,8 @@ want to match against EXWM internal variables such as `exwm-title', :stack-mode xcb:StackMode:Below))) (xcb:flush exwm--connection) (setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist)) - (let ((kill-buffer-query-functions nil)) + (let ((kill-buffer-query-functions nil) + (exwm-input--skip-buffer-list-update t)) (kill-buffer (current-buffer))) (throw 'return 'ignored)) (let ((index (plist-get exwm--configurations 'workspace))) @@ -390,29 +410,26 @@ want to match against EXWM internal variables such as `exwm-title', (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)))) + (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) - (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))))) + (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 +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)" @@ -427,7 +444,9 @@ manager is shutting down." (exwm-workspace--update-workareas) (dolist (f exwm-workspace--list) (exwm-workspace--set-fullscreen f))) - (when (buffer-live-p buffer) + (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 @@ -509,8 +528,11 @@ manager is shutting down." (defun exwm-manage--kill-buffer-query-function () "Run in `kill-buffer-query-functions'." - (exwm--log "id=#x%x; buffer=%s" exwm--id (current-buffer)) + (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 @@ -587,7 +609,8 @@ Would you like to kill it? " (throw 'return nil))))) (defun exwm-manage--kill-client (&optional id) - "Kill an X client." + "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 @@ -605,14 +628,16 @@ Would you like to kill it? " (xcb:flush exwm--connection))) (defun exwm-manage--add-frame (frame) - "Run in `after-make-frame-functions'." + "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'." + "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 @@ -620,7 +645,8 @@ Would you like to kill it? " exwm-manage--frame-outer-id-list)))) (defun exwm-manage--on-ConfigureRequest (data _synthetic) - "Handle ConfigureRequest event." + "Handle ConfigureRequest event. +DATA contains unmarshalled ConfigureRequest event data." (exwm--log) (let ((obj (make-instance 'xcb:ConfigureRequest)) buffer edges width-delta height-delta) @@ -710,7 +736,8 @@ border-width: %d; sibling: #x%x; stack-mode: %d" (xcb:flush exwm--connection)) (defun exwm-manage--on-MapRequest (data _synthetic) - "Handle MapRequest event." + "Handle MapRequest event. +DATA contains unmarshalled MapRequest event data." (let ((obj (make-instance 'xcb:MapRequest))) (xcb:unmarshal obj data) (with-slots (parent window) obj @@ -730,7 +757,8 @@ border-width: %d; sibling: #x%x; stack-mode: %d" (exwm-manage--manage-window window)))))) (defun exwm-manage--on-UnmapNotify (data _synthetic) - "Handle UnmapNotify event." + "Handle UnmapNotify event. +DATA contains unmarshalled UnmapNotify event data." (let ((obj (make-instance 'xcb:UnmapNotify))) (xcb:unmarshal obj data) (with-slots (window) obj @@ -738,7 +766,8 @@ border-width: %d; sibling: #x%x; stack-mode: %d" (exwm-manage--unmanage-window window t)))) (defun exwm-manage--on-MapNotify (data _synthetic) - "Handle MapNotify event." + "Handle MapNotify event. +DATA contains unmarshalled MapNotify event data." (let ((obj (make-instance 'xcb:MapNotify))) (xcb:unmarshal obj data) (with-slots (window) obj @@ -763,7 +792,9 @@ border-width: %d; sibling: #x%x; stack-mode: %d" (xcb:flush exwm--connection))))) (defun exwm-manage--on-DestroyNotify (data synthetic) - "Handle DestroyNotify event." + "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))) |