pax_global_header00006660000000000000000000000064141426056000014510gustar00rootroot0000000000000052 comment=10bd12234e896d35a2c4eafabc62a31126d23bf3 exwm-0.26/000077500000000000000000000000001414260560000124175ustar00rootroot00000000000000exwm-0.26/.elpaignore000066400000000000000000000000121414260560000145360ustar00rootroot00000000000000README.md exwm-0.26/.gitignore000066400000000000000000000000361414260560000144060ustar00rootroot00000000000000*.elc *-pkg.el *-autoloads.el exwm-0.26/README.md000066400000000000000000000014161414260560000137000ustar00rootroot00000000000000# Emacs X Window Manager EXWM (Emacs X Window Manager) is a full-featured tiling X window manager for Emacs built on top of [XELB](https://github.com/ch11ng/xelb). It features: + Fully keyboard-driven operations + Hybrid layout modes (tiling & stacking) + Dynamic workspace support + ICCCM/EWMH compliance + (Optional) RandR (multi-monitor) support + (Optional) Builtin system tray + (Optional) Builtin input method Please check out the [screenshots](https://github.com/ch11ng/exwm/wiki/Screenshots) to get an overview of what EXWM is capable of, and the [user guide](https://github.com/ch11ng/exwm/wiki) for a detailed explanation of its usage. **Note**: If you install EXWM from source, it's recommended to install XELB also from source (otherwise install both from GNU ELPA). exwm-0.26/exwm-cm.el000066400000000000000000000026251414260560000143230ustar00rootroot00000000000000;;; exwm-cm.el --- Compositing Manager for EXWM -*- lexical-binding: t -*- ;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module is obsolete since EXWM now supports third-party compositors. ;;; Code: (make-obsolete-variable 'exwm-cm-opacity "This variable should no longer be used." "26") (defun exwm-cm-set-opacity (&rest _args) (declare (obsolete nil "26"))) (defun exwm-cm-enable () (declare (obsolete nil "26"))) (defun exwm-cm-start () (declare (obsolete nil "26"))) (defun exwm-cm-stop () (declare (obsolete nil "26"))) (defun exwm-cm-toggle () (declare (obsolete nil "26"))) (provide 'exwm-cm) ;;; exwm-cm.el ends here exwm-0.26/exwm-config.el000066400000000000000000000113271414260560000151700ustar00rootroot00000000000000;;; exwm-config.el --- Predefined configurations -*- lexical-binding: t -*- ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module contains typical (yet minimal) configurations of EXWM. ;;; Code: (require 'exwm) (require 'ido) (define-obsolete-function-alias 'exwm-config-default #'exwm-config-example "27.1") (defun exwm-config-example () "Default configuration of EXWM." ;; Set the initial workspace number. (unless (get 'exwm-workspace-number 'saved-value) (setq exwm-workspace-number 4)) ;; Make class name the buffer name (add-hook 'exwm-update-class-hook (lambda () (exwm-workspace-rename-buffer exwm-class-name))) ;; Global keybindings. (unless (get 'exwm-input-global-keys 'saved-value) (setq exwm-input-global-keys `( ;; 's-r': Reset (to line-mode). ([?\s-r] . exwm-reset) ;; 's-w': Switch workspace. ([?\s-w] . exwm-workspace-switch) ;; 's-&': Launch application. ([?\s-&] . (lambda (command) (interactive (list (read-shell-command "$ "))) (start-process-shell-command command nil command))) ;; 's-N': Switch to certain workspace. ,@(mapcar (lambda (i) `(,(kbd (format "s-%d" i)) . (lambda () (interactive) (exwm-workspace-switch-create ,i)))) (number-sequence 0 9))))) ;; Line-editing shortcuts (unless (get 'exwm-input-simulation-keys 'saved-value) (setq exwm-input-simulation-keys '(([?\C-b] . [left]) ([?\C-f] . [right]) ([?\C-p] . [up]) ([?\C-n] . [down]) ([?\C-a] . [home]) ([?\C-e] . [end]) ([?\M-v] . [prior]) ([?\C-v] . [next]) ([?\C-d] . [delete]) ([?\C-k] . [S-end delete])))) ;; Enable EXWM (exwm-enable) ;; Configure Ido (exwm-config-ido) ;; Other configurations (exwm-config-misc)) (defun exwm-config--fix/ido-buffer-window-other-frame () "Fix `ido-buffer-window-other-frame'." (defalias 'exwm-config-ido-buffer-window-other-frame (symbol-function #'ido-buffer-window-other-frame)) (defun ido-buffer-window-other-frame (buffer) "This is a version redefined by EXWM. You can find the original one at `exwm-config-ido-buffer-window-other-frame'." (with-current-buffer (window-buffer (selected-window)) (if (and (derived-mode-p 'exwm-mode) exwm--floating-frame) ;; Switch from a floating frame. (with-current-buffer buffer (if (and (derived-mode-p 'exwm-mode) exwm--floating-frame (eq exwm--frame exwm-workspace--current)) ;; Switch to another floating frame. (frame-root-window exwm--floating-frame) ;; Do not switch if the buffer is not on the current workspace. (or (get-buffer-window buffer exwm-workspace--current) (selected-window)))) (with-current-buffer buffer (when (derived-mode-p 'exwm-mode) (if (eq exwm--frame exwm-workspace--current) (when exwm--floating-frame ;; Switch to a floating frame on the current workspace. (frame-selected-window exwm--floating-frame)) ;; Do not switch to exwm-mode buffers on other workspace (which ;; won't work unless `exwm-layout-show-all-buffers' is set) (unless exwm-layout-show-all-buffers (selected-window))))))))) (defun exwm-config-ido () "Configure Ido to work with EXWM." (ido-mode 1) (add-hook 'exwm-init-hook #'exwm-config--fix/ido-buffer-window-other-frame)) (defun exwm-config-misc () "Other configurations." ;; Make more room (menu-bar-mode -1) (tool-bar-mode -1) (scroll-bar-mode -1) (fringe-mode 1)) (provide 'exwm-config) ;;; exwm-config.el ends here exwm-0.26/exwm-core.el000066400000000000000000000346041414260560000146560ustar00rootroot00000000000000;;; exwm-core.el --- Core definitions -*- lexical-binding: t -*- ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module includes core definitions of variables, macros, functions, etc ;; shared by various other modules. ;;; Code: (require 'kmacro) (require 'xcb) (require 'xcb-icccm) (require 'xcb-ewmh) (require 'xcb-debug) (defcustom exwm-debug-log-time-function #'exwm-debug-log-uptime "Function used for generating timestamps in `exwm-debug' logs. Here are some predefined candidates: `exwm-debug-log-uptime': Display the uptime of this Emacs instance. `exwm-debug-log-time': Display time of day. `nil': Disable timestamp." :group 'exwm-debug :type `(choice (const :tag "Emacs uptime" ,#'exwm-debug-log-uptime) (const :tag "Time of day" ,#'exwm-debug-log-time) (const :tag "Off" nil) (function :tag "Other")) :set (lambda (symbol value) (set-default symbol value) ;; Also change the format for XELB to make logs consistent ;; (as they share the same buffer). (setq xcb-debug:log-time-function value))) (defalias 'exwm-debug-log-uptime 'xcb-debug:log-uptime "Add uptime to `exwm-debug' logs.") (defalias 'exwm-debug-log-time 'xcb-debug:log-time "Add time of day to `exwm-debug' logs.") (defvar exwm--connection nil "X connection.") (defvar exwm--wmsn-window nil "An X window owning the WM_S0 selection.") (defvar exwm--wmsn-acquire-timeout 3 "Number of seconds to wait for other window managers to release the selection.") (defvar exwm--guide-window nil "An X window separating workspaces and X windows.") (defvar exwm--id-buffer-alist nil "Alist of ( . ).") (defvar exwm--root nil "Root window.") (defvar exwm-input--global-prefix-keys) (defvar exwm-input--simulation-keys) (defvar exwm-input-line-mode-passthrough) (defvar exwm-input-prefix-keys) (declare-function exwm-input--fake-key "exwm-input.el" (event)) (declare-function exwm-input--on-KeyPress-line-mode "exwm-input.el" (key-press raw-data)) (declare-function exwm-floating-hide "exwm-floating.el") (declare-function exwm-floating-toggle-floating "exwm-floating.el") (declare-function exwm-input-release-keyboard "exwm-input.el") (declare-function exwm-input-send-next-key "exwm-input.el" (times)) (declare-function exwm-layout-set-fullscreen "exwm-layout.el" (&optional id)) (declare-function exwm-layout-toggle-mode-line "exwm-layout.el") (declare-function exwm-manage--kill-buffer-query-function "exwm-manage.el") (declare-function exwm-workspace-move-window "exwm-workspace.el" (frame-or-index &optional id)) (define-minor-mode exwm-debug "Debug-logging enabled if non-nil" :global t) (defmacro exwm--debug (&rest forms) (when exwm-debug `(progn ,@forms))) (defmacro exwm--log (&optional format-string &rest objects) "Emit a message prepending the name of the function being executed. FORMAT-STRING is a string specifying the message to output, as in `format'. The OBJECTS arguments specify the substitutions." (unless format-string (setq format-string "")) `(when exwm-debug (xcb-debug:message ,(concat "%s%s:\t" format-string "\n") (if exwm-debug-log-time-function (funcall exwm-debug-log-time-function) "") (xcb-debug:compile-time-function-name) ,@objects) nil)) (defsubst exwm--id->buffer (id) "X window ID => Emacs buffer." (cdr (assoc id exwm--id-buffer-alist))) (defsubst exwm--buffer->id (buffer) "Emacs buffer BUFFER => X window ID." (car (rassoc buffer exwm--id-buffer-alist))) (defun exwm--lock (&rest _args) "Lock (disable all events)." (exwm--log) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window exwm--root :value-mask xcb:CW:EventMask :event-mask xcb:EventMask:NoEvent)) (xcb:flush exwm--connection)) (defun exwm--unlock (&rest _args) "Unlock (enable all events)." (exwm--log) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window exwm--root :value-mask xcb:CW:EventMask :event-mask (eval-when-compile (logior xcb:EventMask:SubstructureRedirect xcb:EventMask:StructureNotify)))) (xcb:flush exwm--connection)) (defun exwm--set-geometry (xwin x y width height) "Set the geometry of X window XWIN to WIDTHxHEIGHT+X+Y. Nil can be passed as placeholder." (exwm--log "Setting #x%x to %sx%s+%s+%s" xwin width height x y) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window xwin :value-mask (logior (if x xcb:ConfigWindow:X 0) (if y xcb:ConfigWindow:Y 0) (if width xcb:ConfigWindow:Width 0) (if height xcb:ConfigWindow:Height 0)) :x x :y y :width width :height height))) (defun exwm--intern-atom (atom) "Intern X11 ATOM." (slot-value (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:InternAtom :only-if-exists 0 :name-len (length atom) :name atom)) 'atom)) (defmacro exwm--defer (secs function &rest args) "Defer the execution of FUNCTION. The action is to call FUNCTION with arguments ARGS. If Emacs is not idle, defer the action until Emacs is idle. Otherwise, defer the action until at least SECS seconds later." `(run-with-idle-timer (+ (float-time (or (current-idle-time) (seconds-to-time (- ,secs)))) ,secs) nil ,function ,@args)) (defun exwm--get-client-event-mask () "Return event mask set on all managed windows." (logior xcb:EventMask:StructureNotify xcb:EventMask:PropertyChange (if mouse-autoselect-window xcb:EventMask:EnterWindow 0))) (defun exwm--color->pixel (color) "Convert COLOR to PIXEL (index in TrueColor colormap)." (when (and color (eq (x-display-visual-class) 'true-color)) (let ((rgb (x-color-values color))) (logior (lsh (lsh (pop rgb) -8) 16) (lsh (lsh (pop rgb) -8) 8) (lsh (pop rgb) -8))))) ;; Internal variables (defvar-local exwm--id nil) ;window ID (defvar-local exwm--configurations nil) ;initial configurations. (defvar-local exwm--frame nil) ;workspace frame (defvar-local exwm--floating-frame nil) ;floating frame (defvar-local exwm--mode-line-format nil) ;save mode-line-format (defvar-local exwm--floating-frame-position nil) ;set when hidden. (defvar-local exwm--fixed-size nil) ;fixed size (defvar-local exwm--selected-input-mode 'line-mode "Input mode as selected by the user. One of `line-mode' or `char-mode'.") (defvar-local exwm--input-mode 'line-mode "Actual input mode, i.e. whether mouse and keyboard are grabbed.") ;; Properties (defvar-local exwm--desktop nil "_NET_WM_DESKTOP.") (defvar-local exwm-window-type nil "_NET_WM_WINDOW_TYPE.") (defvar-local exwm--geometry nil) (defvar-local exwm-class-name nil "Class name in WM_CLASS.") (defvar-local exwm-instance-name nil "Instance name in WM_CLASS.") (defvar-local exwm-title nil "Window title (either _NET_WM_NAME or WM_NAME)") (defvar-local exwm--title-is-utf8 nil) (defvar-local exwm-transient-for nil "WM_TRANSIENT_FOR.") (defvar-local exwm--protocols nil) (defvar-local exwm-state xcb:icccm:WM_STATE:NormalState "WM_STATE.") (defvar-local exwm--ewmh-state nil "_NET_WM_STATE.") ;; _NET_WM_NORMAL_HINTS (defvar-local exwm--normal-hints-x nil) (defvar-local exwm--normal-hints-y nil) (defvar-local exwm--normal-hints-width nil) (defvar-local exwm--normal-hints-height nil) (defvar-local exwm--normal-hints-min-width nil) (defvar-local exwm--normal-hints-min-height nil) (defvar-local exwm--normal-hints-max-width nil) (defvar-local exwm--normal-hints-max-height nil) ;; (defvar-local exwm--normal-hints-win-gravity nil) ;; WM_HINTS (defvar-local exwm--hints-input nil) (defvar-local exwm--hints-urgency nil) ;; _MOTIF_WM_HINTS (defvar-local exwm--mwm-hints-decorations t) (defvar exwm-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-d\C-l" #'xcb-debug:clear) (define-key map "\C-c\C-d\C-m" #'xcb-debug:mark) (define-key map "\C-c\C-d\C-t" #'exwm-debug) (define-key map "\C-c\C-f" #'exwm-layout-set-fullscreen) (define-key map "\C-c\C-h" #'exwm-floating-hide) (define-key map "\C-c\C-k" #'exwm-input-release-keyboard) (define-key map "\C-c\C-m" #'exwm-workspace-move-window) (define-key map "\C-c\C-q" #'exwm-input-send-next-key) (define-key map "\C-c\C-t\C-f" #'exwm-floating-toggle-floating) (define-key map "\C-c\C-t\C-m" #'exwm-layout-toggle-mode-line) map) "Keymap for `exwm-mode'.") (defvar exwm--kmacro-map (let ((map (make-sparse-keymap))) (define-key map [t] (lambda () (interactive) (cond ((or exwm-input-line-mode-passthrough ;; Do not test `exwm-input--during-command'. (active-minibuffer-window) (memq last-input-event exwm-input--global-prefix-keys) (memq last-input-event exwm-input-prefix-keys) (lookup-key exwm-mode-map (vector last-input-event)) (gethash last-input-event exwm-input--simulation-keys)) (set-transient-map (make-composed-keymap (list exwm-mode-map global-map))) (push last-input-event unread-command-events)) (t (exwm-input--fake-key last-input-event))))) map) "Keymap used when executing keyboard macros.") ;; This menu mainly acts as an reminder for users. Thus it should be as ;; detailed as possible, even some entries do not make much sense here. ;; Also, inactive entries should be disabled rather than hidden. (easy-menu-define exwm-mode-menu exwm-mode-map "Menu for `exwm-mode'." '("EXWM" "---" "*General*" "---" ["Toggle floating" exwm-floating-toggle-floating] ["Toggle fullscreen mode" exwm-layout-toggle-fullscreen] ["Hide window" exwm-floating-hide exwm--floating-frame] ["Close window" (kill-buffer (current-buffer))] "---" "*Resizing*" "---" ["Toggle mode-line" exwm-layout-toggle-mode-line] ["Enlarge window vertically" exwm-layout-enlarge-window] ["Enlarge window horizontally" exwm-layout-enlarge-window-horizontally] ["Shrink window vertically" exwm-layout-shrink-window] ["Shrink window horizontally" exwm-layout-shrink-window-horizontally] "---" "*Keyboard*" "---" ["Toggle keyboard mode" exwm-input-toggle-keyboard] ["Send key" exwm-input-send-next-key (eq exwm--input-mode 'line-mode)] ;; This is merely a reference. ("Send simulation key" :filter (lambda (&rest _args) (let (result) (maphash (lambda (key value) (when (sequencep key) (setq result (append result `([ ,(format "Send '%s'" (key-description value)) (lambda () (interactive) (dolist (i ',value) (exwm-input--fake-key i))) :keys ,(key-description key)]))))) exwm-input--simulation-keys) result))) ["Define global binding" exwm-input-set-key] "---" "*Workspace*" "---" ["Add workspace" exwm-workspace-add] ["Delete current workspace" exwm-workspace-delete] ["Move workspace to" exwm-workspace-move] ["Swap workspaces" exwm-workspace-swap] ["Move X window to" exwm-workspace-move-window] ["Move X window from" exwm-workspace-switch-to-buffer] ["Toggle minibuffer" exwm-workspace-toggle-minibuffer] ["Switch workspace" exwm-workspace-switch] ;; Place this entry at bottom to avoid selecting others by accident. ("Switch to" :filter (lambda (&rest _args) (mapcar (lambda (i) `[,(format "Workspace %d" i) (lambda () (interactive) (exwm-workspace-switch ,i)) (/= ,i exwm-workspace-current-index)]) (number-sequence 0 (1- (exwm-workspace--count)))))))) (define-derived-mode exwm-mode nil "EXWM" "Major mode for managing X windows. \\{exwm-mode-map}" ;; (setq mode-name '(:eval (propertize "EXWM" 'face (when (cl-some (lambda (i) (frame-parameter i 'exwm-urgency)) exwm-workspace--list) 'font-lock-warning-face)))) ;; Change major-mode is not allowed (add-hook 'change-major-mode-hook #'kill-buffer nil t) ;; Kill buffer -> close window (add-hook 'kill-buffer-query-functions #'exwm-manage--kill-buffer-query-function nil t) ;; Redirect events when executing keyboard macros. (push `(executing-kbd-macro . ,exwm--kmacro-map) minor-mode-overriding-map-alist) (setq buffer-read-only t cursor-type nil left-margin-width nil right-margin-width nil left-fringe-width 0 right-fringe-width 0 vertical-scroll-bar nil)) (provide 'exwm-core) ;;; exwm-core.el ends here exwm-0.26/exwm-floating.el000066400000000000000000001126211414260560000155250ustar00rootroot00000000000000;;; exwm-floating.el --- Floating Module for EXWM -*- lexical-binding: t -*- ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module deals with the conversion between floating and non-floating ;; states and implements moving/resizing operations on floating windows. ;;; Code: (require 'xcb-cursor) (require 'exwm-core) (defgroup exwm-floating nil "Floating." :version "25.3" :group 'exwm) (defcustom exwm-floating-setup-hook nil "Normal hook run when an X window has been made floating, in the context of the corresponding buffer." :type 'hook) (defcustom exwm-floating-exit-hook nil "Normal hook run when an X window has exited floating state, in the context of the corresponding buffer." :type 'hook) (defcustom exwm-floating-border-color "navy" "Border color of floating windows." :type 'color :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) ;; Change border color for all floating X windows. (when exwm--connection (let ((border-pixel (exwm--color->pixel value))) (when border-pixel (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (when exwm--floating-frame (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window (frame-parameter exwm--floating-frame 'exwm-container) :value-mask xcb:CW:BorderPixel :border-pixel border-pixel))))) (xcb:flush exwm--connection)))))) (defcustom exwm-floating-border-width 1 "Border width of floating windows." :type '(integer :validate (lambda (widget) (when (< (widget-value widget) 0) (widget-put widget :error "Border width is at least 0") widget))) :initialize #'custom-initialize-default :set (lambda (symbol value) (let ((delta (- value exwm-floating-border-width)) container) (set-default symbol value) ;; Change border width for all floating X windows. (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (when exwm--floating-frame (setq container (frame-parameter exwm--floating-frame 'exwm-container)) (with-slots (x y) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable container)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window container :value-mask (logior xcb:ConfigWindow:X xcb:ConfigWindow:Y xcb:ConfigWindow:BorderWidth) :border-width value :x (- x delta) :y (- y delta))))))) (when exwm--connection (xcb:flush exwm--connection))))) ;; Cursors for moving/resizing a window (defvar exwm-floating--cursor-move nil) (defvar exwm-floating--cursor-top-left nil) (defvar exwm-floating--cursor-top nil) (defvar exwm-floating--cursor-top-right nil) (defvar exwm-floating--cursor-right nil) (defvar exwm-floating--cursor-bottom-right nil) (defvar exwm-floating--cursor-bottom nil) (defvar exwm-floating--cursor-bottom-left nil) (defvar exwm-floating--cursor-left nil) (defvar exwm-floating--moveresize-calculate nil "Calculate move/resize parameters [buffer event-mask x y width height].") (defvar exwm-workspace--current) (defvar exwm-workspace--frame-y-offset) (defvar exwm-workspace--window-y-offset) (defvar exwm-workspace--workareas) (declare-function exwm-layout--hide "exwm-layout.el" (id)) (declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) (declare-function exwm-layout--refresh "exwm-layout.el" ()) (declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) (declare-function exwm-workspace--position "exwm-workspace.el" (frame)) (declare-function exwm-workspace--update-offsets "exwm-workspace.el" ()) (defun exwm-floating--set-allowed-actions (id tilling) "Set _NET_WM_ALLOWED_ACTIONS." (exwm--log "#x%x" id) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_ALLOWED_ACTIONS :window id :data (if tilling (vector xcb:Atom:_NET_WM_ACTION_MINIMIZE xcb:Atom:_NET_WM_ACTION_FULLSCREEN xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP xcb:Atom:_NET_WM_ACTION_CLOSE) (vector xcb:Atom:_NET_WM_ACTION_MOVE xcb:Atom:_NET_WM_ACTION_RESIZE xcb:Atom:_NET_WM_ACTION_MINIMIZE xcb:Atom:_NET_WM_ACTION_FULLSCREEN xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP xcb:Atom:_NET_WM_ACTION_CLOSE))))) (defun exwm-floating--set-floating (id) "Make window ID floating." (let ((window (get-buffer-window (exwm--id->buffer id)))) (when window ;; Hide the non-floating X window first. (set-window-buffer window (other-buffer nil t)))) (let* ((original-frame (buffer-local-value 'exwm--frame (exwm--id->buffer id))) ;; Create new frame (frame (with-current-buffer (or (get-buffer "*scratch*") (progn (set-buffer-major-mode (get-buffer-create "*scratch*")) (get-buffer "*scratch*"))) (make-frame `((minibuffer . ,(minibuffer-window exwm--frame)) (left . ,(* window-min-width -10000)) (top . ,(* window-min-height -10000)) (width . ,window-min-width) (height . ,window-min-height) (unsplittable . t))))) ;and fix the size later (outer-id (string-to-number (frame-parameter frame 'outer-window-id))) (window-id (string-to-number (frame-parameter frame 'window-id))) (frame-container (xcb:generate-id exwm--connection)) (window (frame-first-window frame)) ;and it's the only window (x (slot-value exwm--geometry 'x)) (y (slot-value exwm--geometry 'y)) (width (slot-value exwm--geometry 'width)) (height (slot-value exwm--geometry 'height))) ;; Force drawing menu-bar & tool-bar. (redisplay t) (exwm-workspace--update-offsets) (exwm--log "Floating geometry (original): %dx%d%+d%+d" width height x y) ;; Save frame parameters. (set-frame-parameter frame 'exwm-outer-id outer-id) (set-frame-parameter frame 'exwm-id window-id) (set-frame-parameter frame 'exwm-container frame-container) ;; Fix illegal parameters ;; FIXME: check normal hints restrictions (let* ((workarea (elt exwm-workspace--workareas (exwm-workspace--position original-frame))) (x* (aref workarea 0)) (y* (aref workarea 1)) (width* (aref workarea 2)) (height* (aref workarea 3))) ;; Center floating windows (when (and (or (= x 0) (= x x*)) (or (= y 0) (= y y*))) (let ((buffer (exwm--id->buffer exwm-transient-for)) window edges) (when (and buffer (setq window (get-buffer-window buffer))) (setq edges (window-inside-absolute-pixel-edges window)) (unless (and (<= width (- (elt edges 2) (elt edges 0))) (<= height (- (elt edges 3) (elt edges 1)))) (setq edges nil))) (if edges ;; Put at the center of leading window (setq x (+ x* (/ (- (elt edges 2) (elt edges 0) width) 2)) y (+ y* (/ (- (elt edges 3) (elt edges 1) height) 2))) ;; Put at the center of screen (setq x (/ (- width* width) 2) y (/ (- height* height) 2))))) (if (> width width*) ;; Too wide (progn (setq x x* width width*)) ;; Invalid width (when (= 0 width) (setq width (/ width* 2))) ;; Make sure at least half of the window is visible (unless (< x* (+ x (/ width 2)) (+ x* width*)) (setq x (+ x* (/ (- width* width) 2))))) (if (> height height*) ;; Too tall (setq y y* height height*) ;; Invalid height (when (= 0 height) (setq height (/ height* 2))) ;; Make sure at least half of the window is visible (unless (< y* (+ y (/ height 2)) (+ y* height*)) (setq y (+ y* (/ (- height* height) 2))))) ;; The geometry can be overridden by user options. (let ((x** (plist-get exwm--configurations 'x)) (y** (plist-get exwm--configurations 'y)) (width** (plist-get exwm--configurations 'width)) (height** (plist-get exwm--configurations 'height))) (if (integerp x**) (setq x (+ x* x**)) (when (and (floatp x**) (>= 1 x** 0)) (setq x (+ x* (round (* x** width*)))))) (if (integerp y**) (setq y (+ y* y**)) (when (and (floatp y**) (>= 1 y** 0)) (setq y (+ y* (round (* y** height*)))))) (if (integerp width**) (setq width width**) (when (and (floatp width**) (> 1 width** 0)) (setq width (max 1 (round (* width** width*)))))) (if (integerp height**) (setq height height**) (when (and (floatp height**) (> 1 height** 0)) (setq height (max 1 (round (* height** height*)))))))) (exwm--set-geometry id x y nil nil) (xcb:flush exwm--connection) (exwm--log "Floating geometry (corrected): %dx%d%+d%+d" width height x y) ;; Fit frame to client ;; It seems we have to make the frame invisible in order to resize it ;; timely. ;; The frame will be made visible by `select-frame-set-input-focus'. (make-frame-invisible frame) (let* ((edges (window-inside-pixel-edges window)) (frame-width (+ width (- (frame-pixel-width frame) (- (elt edges 2) (elt edges 0))))) (frame-height (+ height (- (frame-pixel-height frame) (- (elt edges 3) (elt edges 1))) ;; Use `frame-outer-height' in the future. exwm-workspace--frame-y-offset)) (floating-mode-line (plist-get exwm--configurations 'floating-mode-line)) (floating-header-line (plist-get exwm--configurations 'floating-header-line)) (border-pixel (exwm--color->pixel exwm-floating-border-color))) (if floating-mode-line (setq exwm--mode-line-format (or exwm--mode-line-format mode-line-format) mode-line-format floating-mode-line) (if (and (not (plist-member exwm--configurations 'floating-mode-line)) exwm--mwm-hints-decorations) (when exwm--mode-line-format (setq mode-line-format exwm--mode-line-format)) ;; The mode-line need to be hidden in floating mode. (setq frame-height (- frame-height (window-mode-line-height (frame-root-window frame))) exwm--mode-line-format (or exwm--mode-line-format mode-line-format) mode-line-format nil))) (if floating-header-line (setq header-line-format floating-header-line) (if (and (not (plist-member exwm--configurations 'floating-header-line)) exwm--mwm-hints-decorations) (setq header-line-format nil) ;; The header-line need to be hidden in floating mode. (setq frame-height (- frame-height (window-header-line-height (frame-root-window frame))) header-line-format nil))) (set-frame-size frame frame-width frame-height t) ;; Create the frame container as the parent of the frame. (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 :wid frame-container :parent exwm--root :x x :y (- y exwm-workspace--window-y-offset) :width width :height height :border-width (with-current-buffer (exwm--id->buffer id) (let ((border-witdh (plist-get exwm--configurations 'border-width))) (if (and (integerp border-witdh) (>= border-witdh 0)) border-witdh exwm-floating-border-width))) :class xcb:WindowClass:InputOutput :visual 0 :value-mask (logior xcb:CW:BackPixmap (if border-pixel xcb:CW:BorderPixel 0) xcb:CW:OverrideRedirect) :background-pixmap xcb:BackPixmap:ParentRelative :border-pixel border-pixel :override-redirect 1)) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window frame-container :data (format "EXWM floating frame container for 0x%x" id))) ;; Map it. (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window frame-container)) ;; Put the X window right above this frame container. (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window id :value-mask (logior xcb:ConfigWindow:Sibling xcb:ConfigWindow:StackMode) :sibling frame-container :stack-mode xcb:StackMode:Above))) ;; Reparent this frame to its container. (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window outer-id :parent frame-container :x 0 :y 0)) (exwm-floating--set-allowed-actions id nil) (xcb:flush exwm--connection) ;; Set window/buffer (with-current-buffer (exwm--id->buffer id) (setq window-size-fixed exwm--fixed-size exwm--floating-frame frame) ;; Do the refresh manually. (remove-hook 'window-configuration-change-hook #'exwm-layout--refresh) (set-window-buffer window (current-buffer)) ;this changes current buffer (add-hook 'window-configuration-change-hook #'exwm-layout--refresh) (set-window-dedicated-p window t) (exwm-layout--show id window)) (with-current-buffer (exwm--id->buffer id) (if (exwm-layout--iconic-state-p id) ;; Hide iconic floating X windows. (exwm-floating-hide) (with-selected-frame exwm--frame (exwm-layout--refresh))) (select-frame-set-input-focus frame)) ;; FIXME: Strangely, the Emacs frame can move itself at this point ;; when there are left/top struts set. Force resetting its ;; position seems working, but it'd better to figure out why. ;; FIXME: This also happens in another case (#220) where the cause is ;; still unclear. (exwm--set-geometry outer-id 0 0 nil nil) (xcb:flush exwm--connection)) (with-current-buffer (exwm--id->buffer id) (run-hooks 'exwm-floating-setup-hook)) ;; Redraw the frame. (redisplay t)) (defun exwm-floating--unset-floating (id) "Make window ID non-floating." (exwm--log "#x%x" id) (let ((buffer (exwm--id->buffer id))) (with-current-buffer buffer (when exwm--floating-frame ;; The X window is already mapped. ;; Unmap the X window. (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window id :value-mask xcb:CW:EventMask :event-mask xcb:EventMask:NoEvent)) (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window id)) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window id :value-mask xcb:CW:EventMask :event-mask (exwm--get-client-event-mask))) ;; Reparent the floating frame back to the root window. (let ((frame-id (frame-parameter exwm--floating-frame 'exwm-outer-id)) (frame-container (frame-parameter exwm--floating-frame 'exwm-container))) (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window frame-id)) (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window frame-id :parent exwm--root :x 0 :y 0)) ;; Also destroy its container. (xcb:+request exwm--connection (make-instance 'xcb:DestroyWindow :window frame-container)))) ;; Place the X window just above the reference X window. ;; (the stacking order won't change from now on). ;; Also hide the possible floating border. (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window id :value-mask (logior xcb:ConfigWindow:BorderWidth xcb:ConfigWindow:Sibling xcb:ConfigWindow:StackMode) :border-width 0 :sibling exwm--guide-window :stack-mode xcb:StackMode:Above))) (exwm-floating--set-allowed-actions id t) (xcb:flush exwm--connection) (with-current-buffer buffer (when exwm--floating-frame ;from floating to non-floating (set-window-dedicated-p (frame-first-window exwm--floating-frame) nil) ;; Select a tiling window and delete the old frame. (select-window (frame-selected-window exwm-workspace--current)) (with-current-buffer buffer (delete-frame exwm--floating-frame)))) (with-current-buffer buffer (setq window-size-fixed nil exwm--floating-frame nil) (if (not (plist-member exwm--configurations 'tiling-mode-line)) (when exwm--mode-line-format (setq mode-line-format exwm--mode-line-format)) (setq exwm--mode-line-format (or exwm--mode-line-format mode-line-format) mode-line-format (plist-get exwm--configurations 'tiling-mode-line))) (if (not (plist-member exwm--configurations 'tiling-header-line)) (setq header-line-format nil) (setq header-line-format (plist-get exwm--configurations 'tiling-header-line)))) ;; Only show X windows in normal state. (unless (exwm-layout--iconic-state-p) (pop-to-buffer-same-window buffer))) (with-current-buffer (exwm--id->buffer id) (run-hooks 'exwm-floating-exit-hook))) ;;;###autoload (cl-defun exwm-floating-toggle-floating () "Toggle the current window between floating and non-floating states." (interactive) (exwm--log) (unless (derived-mode-p 'exwm-mode) (cl-return-from exwm-floating-toggle-floating)) (with-current-buffer (window-buffer) (if exwm--floating-frame (exwm-floating--unset-floating exwm--id) (exwm-floating--set-floating exwm--id)))) ;;;###autoload (defun exwm-floating-hide () "Hide the current floating X window (which would show again when selected)." (interactive) (exwm--log) (when (and (derived-mode-p 'exwm-mode) exwm--floating-frame) (exwm-layout--hide exwm--id) (select-frame-set-input-focus exwm-workspace--current))) (defun exwm-floating--start-moveresize (id &optional type) "Start move/resize." (exwm--log "#x%x" id) (let ((buffer-or-id (or (exwm--id->buffer id) id)) frame container-or-id x y width height cursor) (if (bufferp buffer-or-id) ;; Managed. (with-current-buffer buffer-or-id (setq frame exwm--floating-frame container-or-id (frame-parameter exwm--floating-frame 'exwm-container))) ;; Unmanaged. (setq container-or-id id)) (when (and container-or-id ;; Test if the pointer can be grabbed (= xcb:GrabStatus:Success (slot-value (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GrabPointer :owner-events 0 :grab-window container-or-id :event-mask xcb:EventMask:NoEvent :pointer-mode xcb:GrabMode:Async :keyboard-mode xcb:GrabMode:Async :confine-to xcb:Window:None :cursor xcb:Cursor:None :time xcb:Time:CurrentTime)) 'status))) (with-slots (root-x root-y win-x win-y) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:QueryPointer :window id)) (if (not (bufferp buffer-or-id)) ;; Unmanaged. (unless (eq type xcb:ewmh:_NET_WM_MOVERESIZE_MOVE) (with-slots ((width* width) (height* height)) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable id)) (setq width width* height height*))) ;; Managed. (select-window (frame-first-window frame)) ;transfer input focus (setq width (frame-pixel-width frame) height (frame-pixel-height frame)) (unless type ;; Determine the resize type according to the pointer position ;; Clicking the center 1/3 part to resize has no effect (setq x (/ (* 3 win-x) (float width)) y (/ (* 3 win-y) (float height)) type (cond ((and (< x 1) (< y 1)) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT) ((and (> x 2) (< y 1)) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT) ((and (> x 2) (> y 2)) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT) ((and (< x 1) (> y 2)) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT) ((> x 2) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT) ((> y 2) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM) ((< x 1) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT) ((< y 1) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP))))) (if (not type) (exwm-floating--stop-moveresize) (cond ((= type xcb:ewmh:_NET_WM_MOVERESIZE_MOVE) (setq cursor exwm-floating--cursor-move exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:X xcb:ConfigWindow:Y)) (- x win-x) (- y win-y) 0 0)))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT) (setq cursor exwm-floating--cursor-top-left exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:X xcb:ConfigWindow:Y xcb:ConfigWindow:Width xcb:ConfigWindow:Height)) (- x win-x) (- y win-y) (- (+ root-x width) x) (- (+ root-y height) y))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP) (setq cursor exwm-floating--cursor-top exwm-floating--moveresize-calculate (lambda (_x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height)) 0 (- y win-y) 0 (- (+ root-y height) y))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT) (setq cursor exwm-floating--cursor-top-right exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Width xcb:ConfigWindow:Height)) 0 (- y win-y) (- x (- root-x width)) (- (+ root-y height) y))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT) (setq cursor exwm-floating--cursor-right exwm-floating--moveresize-calculate (lambda (x _y) (vector buffer-or-id xcb:ConfigWindow:Width 0 0 (- x (- root-x width)) 0)))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT) (setq cursor exwm-floating--cursor-bottom-right exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:Width xcb:ConfigWindow:Height)) 0 0 (- x (- root-x width)) (- y (- root-y height)))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM) (setq cursor exwm-floating--cursor-bottom exwm-floating--moveresize-calculate (lambda (_x y) (vector buffer-or-id xcb:ConfigWindow:Height 0 0 0 (- y (- root-y height)))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT) (setq cursor exwm-floating--cursor-bottom-left exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:X xcb:ConfigWindow:Width xcb:ConfigWindow:Height)) (- x win-x) 0 (- (+ root-x width) x) (- y (- root-y height)))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT) (setq cursor exwm-floating--cursor-left exwm-floating--moveresize-calculate (lambda (x _y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:X xcb:ConfigWindow:Width)) (- x win-x) 0 (- (+ root-x width) x) 0))))) ;; Select events and change cursor (should always succeed) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GrabPointer :owner-events 0 :grab-window container-or-id :event-mask (eval-when-compile (logior xcb:EventMask:ButtonRelease xcb:EventMask:ButtonMotion)) :pointer-mode xcb:GrabMode:Async :keyboard-mode xcb:GrabMode:Async :confine-to xcb:Window:None :cursor cursor :time xcb:Time:CurrentTime))))))) (defun exwm-floating--stop-moveresize (&rest _args) "Stop move/resize." (exwm--log) (xcb:+request exwm--connection (make-instance 'xcb:UngrabPointer :time xcb:Time:CurrentTime)) (when exwm-floating--moveresize-calculate (let (result buffer-or-id outer-id container-id) (setq result (funcall exwm-floating--moveresize-calculate 0 0) buffer-or-id (aref result 0)) (when (bufferp buffer-or-id) (with-current-buffer buffer-or-id (setq outer-id (frame-parameter exwm--floating-frame 'exwm-outer-id) container-id (frame-parameter exwm--floating-frame 'exwm-container)) (with-slots (x y width height border-width) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable container-id)) ;; Notify Emacs frame about this the position change. (xcb:+request exwm--connection (make-instance 'xcb:SendEvent :propagate 0 :destination outer-id :event-mask xcb:EventMask:StructureNotify :event (xcb:marshal (make-instance 'xcb:ConfigureNotify :event outer-id :window outer-id :above-sibling xcb:Window:None :x (+ x border-width) :y (+ y border-width) :width width :height height :border-width 0 :override-redirect 0) exwm--connection))) (xcb:flush exwm--connection)) (exwm-layout--show exwm--id (frame-root-window exwm--floating-frame))))) (setq exwm-floating--moveresize-calculate nil))) (defun exwm-floating--do-moveresize (data _synthetic) "Perform move/resize." (when exwm-floating--moveresize-calculate (let* ((obj (make-instance 'xcb:MotionNotify)) result value-mask x y width height buffer-or-id container-or-id) (xcb:unmarshal obj data) (setq result (funcall exwm-floating--moveresize-calculate (slot-value obj 'root-x) (slot-value obj 'root-y)) buffer-or-id (aref result 0) value-mask (aref result 1) x (aref result 2) y (aref result 3) width (max 1 (aref result 4)) height (max 1 (aref result 5))) (if (not (bufferp buffer-or-id)) ;; Unmanaged. (setq container-or-id buffer-or-id) ;; Managed. (setq container-or-id (with-current-buffer buffer-or-id (frame-parameter exwm--floating-frame 'exwm-container)) x (- x exwm-floating-border-width) ;; Use `frame-outer-height' in the future. y (- y exwm-floating-border-width exwm-workspace--window-y-offset) height (+ height exwm-workspace--window-y-offset))) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window container-or-id :value-mask (aref result 1) :x x :y y :width width :height height)) (when (bufferp buffer-or-id) ;; Managed. (setq value-mask (logand value-mask (logior xcb:ConfigWindow:Width xcb:ConfigWindow:Height))) (when (/= 0 value-mask) (with-current-buffer buffer-or-id (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm--floating-frame 'exwm-outer-id) :value-mask value-mask :width width :height height))))) (xcb:flush exwm--connection)))) (defun exwm-floating-move (&optional delta-x delta-y) "Move a floating window right by DELTA-X pixels and down by DELTA-Y pixels. Both DELTA-X and DELTA-Y default to 1. This command should be bound locally." (exwm--log "delta-x: %s, delta-y: %s" delta-x delta-y) (unless (and (derived-mode-p 'exwm-mode) exwm--floating-frame) (user-error "[EXWM] `exwm-floating-move' is only for floating X windows")) (unless delta-x (setq delta-x 1)) (unless delta-y (setq delta-y 1)) (unless (and (= 0 delta-x) (= 0 delta-y)) (let* ((floating-container (frame-parameter exwm--floating-frame 'exwm-container)) (geometry (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable floating-container))) (edges (window-inside-absolute-pixel-edges))) (with-slots (x y) geometry (exwm--set-geometry floating-container (+ x delta-x) (+ y delta-y) nil nil)) (exwm--set-geometry exwm--id (+ (pop edges) delta-x) (+ (pop edges) delta-y) nil nil)) (xcb:flush exwm--connection))) (defun exwm-floating--init () "Initialize floating module." (exwm--log) ;; Initialize cursors for moving/resizing a window (xcb:cursor:init exwm--connection) (setq exwm-floating--cursor-move (xcb:cursor:load-cursor exwm--connection "fleur") exwm-floating--cursor-top-left (xcb:cursor:load-cursor exwm--connection "top_left_corner") exwm-floating--cursor-top (xcb:cursor:load-cursor exwm--connection "top_side") exwm-floating--cursor-top-right (xcb:cursor:load-cursor exwm--connection "top_right_corner") exwm-floating--cursor-right (xcb:cursor:load-cursor exwm--connection "right_side") exwm-floating--cursor-bottom-right (xcb:cursor:load-cursor exwm--connection "bottom_right_corner") exwm-floating--cursor-bottom (xcb:cursor:load-cursor exwm--connection "bottom_side") exwm-floating--cursor-bottom-left (xcb:cursor:load-cursor exwm--connection "bottom_left_corner") exwm-floating--cursor-left (xcb:cursor:load-cursor exwm--connection "left_side"))) (defun exwm-floating--exit () "Exit the floating module." (exwm--log)) (provide 'exwm-floating) ;;; exwm-floating.el ends here exwm-0.26/exwm-input.el000066400000000000000000001470021414260560000150620ustar00rootroot00000000000000;;; exwm-input.el --- Input Module for EXWM -*- lexical-binding: t -*- ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module deals with key/mouse matters, including: ;; + Input focus, ;; + Key/Button event handling, ;; + Key events filtering and simulation. ;; Todo: ;; + Pointer simulation mode (e.g. 'C-c 1'/'C-c 2' for single/double click, ;; move with arrow keys). ;; + Simulation keys to mimic Emacs key bindings for text edit (redo, select, ;; cancel, clear, etc). Some of them are not present on common keyboard ;; (keycode = 0). May need to use XKB extension. ;;; Code: (require 'xcb-keysyms) (require 'exwm-core) (defgroup exwm-input nil "Input." :version "25.3" :group 'exwm) (defcustom exwm-input-prefix-keys '(?\C-x ?\C-u ?\C-h ?\M-x ?\M-` ?\M-& ?\M-:) "List of prefix keys EXWM should forward to Emacs when in line-mode. The point is to make keys like 'C-x C-f' forwarded to Emacs in line-mode. There is no need to add prefix keys for global/simulation keys or those defined in `exwm-mode-map' here." :type '(repeat key-sequence) :get (lambda (symbol) (mapcar #'vector (default-value symbol))) :set (lambda (symbol value) (set symbol (mapcar (lambda (i) (if (sequencep i) (aref i 0) i)) value)))) (defcustom exwm-input-move-event 's-down-mouse-1 "Emacs event to start moving a window." :type 'key-sequence :get (lambda (symbol) (let ((value (default-value symbol))) (if (mouse-event-p value) value (vector value)))) :set (lambda (symbol value) (set symbol (if (sequencep value) (aref value 0) value)))) (defcustom exwm-input-resize-event 's-down-mouse-3 "Emacs event to start resizing a window." :type 'key-sequence :get (lambda (symbol) (let ((value (default-value symbol))) (if (mouse-event-p value) value (vector value)))) :set (lambda (symbol value) (set symbol (if (sequencep value) (aref value 0) value)))) (defcustom exwm-input-line-mode-passthrough nil "Non-nil makes 'line-mode' forward all events to Emacs." :type 'boolean) ;; Input focus update requests should be accumulated for a short time ;; interval so that only the last one need to be processed. This not ;; improves the overall performance, but avoids the problem of input ;; focus loop, which is a result of the interaction with Emacs frames. ;; ;; FIXME: The time interval is hard to decide and perhaps machine-dependent. ;; A value too small can cause redundant updates of input focus, ;; and even worse, dead loops. OTOH a large value would bring ;; laggy experience. (defconst exwm-input--update-focus-interval 0.01 "Time interval (in seconds) for accumulating input focus update requests.") (defvar exwm-input--during-command nil "Indicate whether between `pre-command-hook' and `post-command-hook'.") (defvar exwm-input--global-keys nil "Global key bindings.") (defvar exwm-input--global-prefix-keys nil "List of prefix keys of global key bindings.") (defvar exwm-input--line-mode-cache nil "Cache for incomplete key sequence.") (defvar exwm-input--local-simulation-keys nil "Whether simulation keys are local.") (defvar exwm-input--simulation-keys nil "Simulation keys in line-mode.") (defvar exwm-input--skip-buffer-list-update nil "Skip the upcoming 'buffer-list-update'.") (defvar exwm-input--temp-line-mode nil "Non-nil indicates it's in temporary line-mode for char-mode.") (defvar exwm-input--timestamp-atom nil) (defvar exwm-input--timestamp-callback nil) (defvar exwm-input--timestamp-window nil) (defvar exwm-input--update-focus-defer-timer nil "Timer for polling the lock.") (defvar exwm-input--update-focus-lock nil "Lock for solving input focus update contention.") (defvar exwm-input--update-focus-timer nil "Timer for deferring the update of input focus.") (defvar exwm-input--update-focus-window nil "The (Emacs) window to be focused. This value should always be overwritten.") (defvar exwm-input--echo-area-timer nil "Timer for detecting echo area dirty.") (defvar exwm-input--event-hook nil "Hook to run when EXWM receives an event.") (defvar exwm-input-input-mode-change-hook nil "Hook to run when an input mode changes on an `exwm-mode' buffer. Current buffer will be the `exwm-mode' buffer when this hook runs.") (defvar exwm-workspace--current) (declare-function exwm-floating--do-moveresize "exwm-floating.el" (data _synthetic)) (declare-function exwm-floating--start-moveresize "exwm-floating.el" (id &optional type)) (declare-function exwm-floating--stop-moveresize "exwm-floating.el" (&rest _args)) (declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) (declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) (declare-function exwm-reset "exwm.el" ()) (declare-function exwm-workspace--client-p "exwm-workspace.el" (&optional frame)) (declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el") (declare-function exwm-workspace--workspace-p "exwm-workspace.el" (workspace)) (declare-function exwm-workspace-switch "exwm-workspace.el" (frame-or-index &optional force)) (defun exwm-input--set-focus (id) "Set input focus to window ID in a proper way." (let ((from (slot-value (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetInputFocus)) 'focus)) tree) (if (or (exwm--id->buffer from) (eq from id)) (exwm--log "#x%x => #x%x" (or from 0) (or id 0)) ;; Attempt to find the top-level X window for a 'focus proxy'. (unless (= from xcb:Window:None) (setq tree (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:QueryTree :window from))) (when tree (setq from (slot-value tree 'parent)))) (exwm--log "#x%x (corrected) => #x%x" (or from 0) (or id 0))) (when (and (exwm--id->buffer id) ;; Avoid redundant input focus transfer. (not (eq from id))) (with-current-buffer (exwm--id->buffer id) (exwm-input--update-timestamp (lambda (timestamp id send-input-focus wm-take-focus) (when send-input-focus (xcb:+request exwm--connection (make-instance 'xcb:SetInputFocus :revert-to xcb:InputFocus:Parent :focus id :time timestamp))) (when wm-take-focus (let ((event (make-instance 'xcb:icccm:WM_TAKE_FOCUS :window id :time timestamp))) (setq event (xcb:marshal event exwm--connection)) (xcb:+request exwm--connection (make-instance 'xcb:icccm:SendEvent :destination id :event event)))) (exwm-input--set-active-window id) (xcb:flush exwm--connection)) id (or exwm--hints-input (not (memq xcb:Atom:WM_TAKE_FOCUS exwm--protocols))) (memq xcb:Atom:WM_TAKE_FOCUS exwm--protocols)))))) (defun exwm-input--update-timestamp (callback &rest args) "Fetch the latest timestamp from the server and feed it to CALLBACK. ARGS are additional arguments to CALLBACK." (setq exwm-input--timestamp-callback (cons callback args)) (exwm--log) (xcb:+request exwm--connection (make-instance 'xcb:ChangeProperty :mode xcb:PropMode:Replace :window exwm-input--timestamp-window :property exwm-input--timestamp-atom :type xcb:Atom:CARDINAL :format 32 :data-len 0 :data nil)) (xcb:flush exwm--connection)) (defun exwm-input--on-PropertyNotify (data _synthetic) "Handle PropertyNotify events." (exwm--log) (when exwm-input--timestamp-callback (let ((obj (make-instance 'xcb:PropertyNotify))) (xcb:unmarshal obj data) (when (= exwm-input--timestamp-window (slot-value obj 'window)) (apply (car exwm-input--timestamp-callback) (slot-value obj 'time) (cdr exwm-input--timestamp-callback)) (setq exwm-input--timestamp-callback nil))))) (defvar exwm-input--last-enter-notify-position nil) (defun exwm-input--on-EnterNotify (data _synthetic) "Handle EnterNotify events." (let ((evt (make-instance 'xcb:EnterNotify)) buffer window frame frame-xid edges fake-evt) (xcb:unmarshal evt data) (with-slots (time root event root-x root-y event-x event-y state) evt (setq buffer (exwm--id->buffer event) window (get-buffer-window buffer t)) (exwm--log "buffer=%s; window=%s" buffer window) (when (and buffer window (not (eq window (selected-window))) (not (equal exwm-input--last-enter-notify-position (vector root-x root-y)))) (setq frame (window-frame window) frame-xid (frame-parameter frame 'exwm-id)) (unless (eq frame exwm-workspace--current) (if (exwm-workspace--workspace-p frame) ;; The X window is on another workspace. (exwm-workspace-switch frame) (with-current-buffer buffer (when (and (derived-mode-p 'exwm-mode) (not (eq exwm--frame exwm-workspace--current))) ;; The floating X window is on another workspace. (exwm-workspace-switch exwm--frame))))) ;; Send a fake MotionNotify event to Emacs. (setq edges (window-inside-pixel-edges window) fake-evt (make-instance 'xcb:MotionNotify :detail 0 :time time :root root :event frame-xid :child xcb:Window:None :root-x root-x :root-y root-y :event-x (+ event-x (elt edges 0)) :event-y (+ event-y (elt edges 1)) :state state :same-screen 1)) (xcb:+request exwm--connection (make-instance 'xcb:SendEvent :propagate 0 :destination frame-xid :event-mask xcb:EventMask:NoEvent :event (xcb:marshal fake-evt exwm--connection))) (xcb:flush exwm--connection)) (setq exwm-input--last-enter-notify-position (vector root-x root-y))))) (defun exwm-input--on-keysyms-update () (exwm--log) (let ((exwm-input--global-prefix-keys nil)) (exwm-input--update-global-prefix-keys))) (defun exwm-input--on-buffer-list-update () "Run in `buffer-list-update-hook' to track input focus." (when (and (not (exwm-workspace--client-p)) (not exwm-input--skip-buffer-list-update)) (exwm--log "current-buffer=%S selected-window=%S" (current-buffer) (selected-window)) (redirect-frame-focus (selected-frame) nil) (setq exwm-input--update-focus-window (selected-window)) (exwm-input--update-focus-defer))) (defun exwm-input--update-focus-defer () "Defer updating input focus." (when exwm-input--update-focus-defer-timer (cancel-timer exwm-input--update-focus-defer-timer)) (if exwm-input--update-focus-lock (setq exwm-input--update-focus-defer-timer (exwm--defer 0 #'exwm-input--update-focus-defer)) (setq exwm-input--update-focus-defer-timer nil) (when exwm-input--update-focus-timer (cancel-timer exwm-input--update-focus-timer)) (setq exwm-input--update-focus-timer ;; Attempt to accumulate successive events close enough. (run-with-timer exwm-input--update-focus-interval nil #'exwm-input--update-focus-commit exwm-input--update-focus-window)))) (defun exwm-input--update-focus-commit (window) "Commit updating input focus." (setq exwm-input--update-focus-lock t) (unwind-protect (exwm-input--update-focus window) (setq exwm-input--update-focus-lock nil))) (defun exwm-input--update-focus (window) "Update input focus." (when (window-live-p window) (exwm--log "focus-window=%s focus-buffer=%s" window (window-buffer window)) (with-current-buffer (window-buffer window) (if (derived-mode-p 'exwm-mode) (if (not (eq exwm--frame exwm-workspace--current)) (progn (set-frame-parameter exwm--frame 'exwm-selected-window window) (exwm--defer 0 #'exwm-workspace-switch exwm--frame)) (exwm--log "Set focus on #x%x" exwm--id) (when exwm--floating-frame ;; Adjust stacking orders of the floating X window. (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window exwm--id :value-mask xcb:ConfigWindow:StackMode :stack-mode xcb:StackMode:TopIf)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm--floating-frame 'exwm-container) :value-mask (logior xcb:ConfigWindow:Sibling xcb:ConfigWindow:StackMode) :sibling exwm--id :stack-mode xcb:StackMode:Below)) ;; This floating X window might be hide by `exwm-floating-hide'. (when (exwm-layout--iconic-state-p) (exwm-layout--show exwm--id window)) (xcb:flush exwm--connection)) (exwm-input--set-focus exwm--id)) (when (eq (selected-window) window) (exwm--log "Focus on %s" window) (if (and (exwm-workspace--workspace-p (selected-frame)) (not (eq (selected-frame) exwm-workspace--current))) ;; The focus is on another workspace (e.g. it got clicked) ;; so switch to it. (progn (exwm--log "Switching to %s's workspace %s (%s)" window (window-frame window) (selected-frame)) (set-frame-parameter (selected-frame) 'exwm-selected-window window) (exwm--defer 0 #'exwm-workspace-switch (selected-frame))) ;; The focus is still on the current workspace. (if (not (and (exwm-workspace--minibuffer-own-frame-p) (minibufferp))) (x-focus-frame (window-frame window)) ;; X input focus should be set on the previously selected ;; frame. (x-focus-frame (window-frame (minibuffer-window)))) (exwm-input--set-active-window) (xcb:flush exwm--connection))))))) (defun exwm-input--set-active-window (&optional id) "Set _NET_ACTIVE_WINDOW." (exwm--log) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_ACTIVE_WINDOW :window exwm--root :data (or id xcb:Window:None)))) (defun exwm-input--on-ButtonPress (data _synthetic) "Handle ButtonPress event." (let ((obj (make-instance 'xcb:ButtonPress)) (mode xcb:Allow:SyncPointer) button-event window buffer frame fake-last-command) (xcb:unmarshal obj data) (exwm--log "major-mode=%s buffer=%s" major-mode (buffer-name (current-buffer))) (with-slots (detail event state) obj (setq button-event (xcb:keysyms:keysym->event exwm--connection detail state) buffer (exwm--id->buffer event) window (get-buffer-window buffer t)) (cond ((and (eq button-event exwm-input-move-event) buffer ;; Either an undecorated or a floating X window. (with-current-buffer buffer (or (not (derived-mode-p 'exwm-mode)) exwm--floating-frame))) ;; Move (exwm-floating--start-moveresize event xcb:ewmh:_NET_WM_MOVERESIZE_MOVE)) ((and (eq button-event exwm-input-resize-event) buffer (with-current-buffer buffer (or (not (derived-mode-p 'exwm-mode)) exwm--floating-frame))) ;; Resize (exwm-floating--start-moveresize event)) (buffer ;; Click to focus (setq fake-last-command t) (unless (eq window (selected-window)) (setq frame (window-frame window)) (unless (eq frame exwm-workspace--current) (if (exwm-workspace--workspace-p frame) ;; The X window is on another workspace (exwm-workspace-switch frame) (with-current-buffer buffer (when (and (derived-mode-p 'exwm-mode) (not (eq exwm--frame exwm-workspace--current))) ;; The floating X window is on another workspace (exwm-workspace-switch exwm--frame))))) ;; It has been reported that the `window' may have be deleted (if (window-live-p window) (select-window window) (setq window (get-buffer-window buffer t)) (when window (select-window window)))) ;; Also process keybindings. (with-current-buffer buffer (when (derived-mode-p 'exwm-mode) (cl-case exwm--input-mode (line-mode (setq mode (exwm-input--on-ButtonPress-line-mode buffer button-event))) (char-mode (setq mode (exwm-input--on-ButtonPress-char-mode))))))) (t ;; Replay this event by default. (setq fake-last-command t) (setq mode xcb:Allow:ReplayPointer)))) (when fake-last-command (exwm-input--fake-last-command)) (xcb:+request exwm--connection (make-instance 'xcb:AllowEvents :mode mode :time xcb:Time:CurrentTime)) (xcb:flush exwm--connection)) (run-hooks 'exwm-input--event-hook)) (defun exwm-input--on-KeyPress (data _synthetic) "Handle KeyPress event." (with-current-buffer (window-buffer (selected-window)) (let ((obj (make-instance 'xcb:KeyPress))) (xcb:unmarshal obj data) (exwm--log "major-mode=%s buffer=%s" major-mode (buffer-name (current-buffer))) (if (derived-mode-p 'exwm-mode) (cl-case exwm--input-mode (line-mode (exwm-input--on-KeyPress-line-mode obj data)) (char-mode (exwm-input--on-KeyPress-char-mode obj data))) (exwm-input--on-KeyPress-char-mode obj))) (run-hooks 'exwm-input--event-hook))) (defun exwm-input--on-CreateNotify (data _synthetic) "Handle CreateNotify events." (exwm--log) (let ((evt (make-instance 'xcb:CreateNotify))) (xcb:unmarshal evt data) (with-slots (window) evt (exwm-input--grab-global-prefix-keys window)))) (defun exwm-input--update-global-prefix-keys () "Update `exwm-input--global-prefix-keys'." (exwm--log) (when exwm--connection (let ((original exwm-input--global-prefix-keys)) (setq exwm-input--global-prefix-keys nil) (dolist (i exwm-input--global-keys) (cl-pushnew (elt i 0) exwm-input--global-prefix-keys)) (unless (equal original exwm-input--global-prefix-keys) (apply #'exwm-input--grab-global-prefix-keys (slot-value (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:QueryTree :window exwm--root)) 'children)))))) (defun exwm-input--grab-global-prefix-keys (&rest xwins) (exwm--log) (let ((req (make-instance 'xcb:GrabKey :owner-events 0 :grab-window nil :modifiers nil :key nil :pointer-mode xcb:GrabMode:Async :keyboard-mode xcb:GrabMode:Async)) keysyms keycode alt-modifier) (dolist (k exwm-input--global-prefix-keys) (setq keysyms (xcb:keysyms:event->keysyms exwm--connection k)) (if (not keysyms) (warn "Key unavailable: %s" (key-description (vector k))) (setq keycode (xcb:keysyms:keysym->keycode exwm--connection (caar keysyms))) (exwm--log "Grabbing key=%s (keysyms=%s keycode=%s)" (single-key-description k) keysyms keycode) (dolist (keysym keysyms) (setf (slot-value req 'modifiers) (cdr keysym) (slot-value req 'key) keycode) ;; Also grab this key with num-lock mask set. (when (and (/= 0 xcb:keysyms:num-lock-mask) (= 0 (logand (cdr keysym) xcb:keysyms:num-lock-mask))) (setf alt-modifier (logior (cdr keysym) xcb:keysyms:num-lock-mask))) (dolist (xwin xwins) (setf (slot-value req 'grab-window) xwin) (xcb:+request exwm--connection req) (when alt-modifier (setf (slot-value req 'modifiers) alt-modifier) (xcb:+request exwm--connection req)))))) (xcb:flush exwm--connection))) (defun exwm-input--set-key (key command) (exwm--log "key: %s, command: %s" key command) (global-set-key key command) (cl-pushnew key exwm-input--global-keys)) (defcustom exwm-input-global-keys nil "Global keys. It is an alist of the form (key . command), meaning giving KEY (a key sequence) a global binding as COMMAND. Notes: * Setting the value directly (rather than customizing it) after EXWM finishes initialization has no effect." :type '(alist :key-type key-sequence :value-type function) :set (lambda (symbol value) (when (boundp symbol) (dolist (i (symbol-value symbol)) (global-unset-key (car i)))) (set symbol value) (setq exwm-input--global-keys nil) (dolist (i value) (exwm-input--set-key (car i) (cdr i))) (when exwm--connection (exwm-input--update-global-prefix-keys)))) ;;;###autoload (defun exwm-input-set-key (key command) "Set a global key binding. The new key binding only takes effect in real time when this command is called interactively, and is lost when this session ends unless it's specifically saved in the Customize interface for `exwm-input-global-keys'. In configuration you should customize or set `exwm-input-global-keys' instead." (interactive "KSet key globally: \nCSet key %s to command: ") (exwm--log) (setq exwm-input-global-keys (append exwm-input-global-keys (list (cons key command)))) (exwm-input--set-key key command) (when (called-interactively-p 'any) (exwm-input--update-global-prefix-keys))) ;; Putting (t . EVENT) into `unread-command-events' does not really work ;; as documented for Emacs < 26.2. (eval-and-compile (if (or (< emacs-major-version 26) (and (= emacs-major-version 26) (< emacs-minor-version 2))) (defsubst exwm-input--unread-event (event) (setq unread-command-events (append unread-command-events (list event)))) (defsubst exwm-input--unread-event (event) (setq unread-command-events (append unread-command-events `((t . ,event))))))) (defun exwm-input--mimic-read-event (event) "Process EVENT as if it were returned by `read-event'." (exwm--log) (unless (eq 0 extra-keyboard-modifiers) (setq event (event-convert-list (append (event-modifiers extra-keyboard-modifiers) event)))) (when (characterp event) (let ((event* (when keyboard-translate-table (aref keyboard-translate-table event)))) (when event* (setq event event*)))) event) (cl-defun exwm-input--translate (key) (let (translation) (dolist (map (list input-decode-map local-function-key-map key-translation-map)) (setq translation (lookup-key map key)) (if (functionp translation) (cl-return-from exwm-input--translate (funcall translation nil)) (when (vectorp translation) (cl-return-from exwm-input--translate translation))))) key) (defun exwm-input--cache-event (event &optional temp-line-mode) "Cache EVENT." (exwm--log "%s" event) (setq exwm-input--line-mode-cache (vconcat exwm-input--line-mode-cache (vector event))) ;; Attempt to translate this key sequence. (setq exwm-input--line-mode-cache (exwm-input--translate exwm-input--line-mode-cache)) ;; When the key sequence is complete (not a keymap). ;; Note that `exwm-input--line-mode-cache' might get translated to nil, for ;; example 'mouse--down-1-maybe-follows-link' does this. (if (and exwm-input--line-mode-cache (keymapp (key-binding exwm-input--line-mode-cache))) ;; Grab keyboard temporarily to intercept the complete key sequence. (when temp-line-mode (setq exwm-input--temp-line-mode t) (exwm-input--grab-keyboard)) (setq exwm-input--line-mode-cache nil) (when exwm-input--temp-line-mode (setq exwm-input--temp-line-mode nil) (exwm-input--release-keyboard)))) (defun exwm-input--event-passthrough-p (event) "Whether EVENT should be passed to Emacs. Current buffer must be an `exwm-mode' buffer." (or exwm-input-line-mode-passthrough exwm-input--during-command ;; Forward the event when there is an incomplete key ;; sequence or when the minibuffer is active. exwm-input--line-mode-cache (eq (active-minibuffer-window) (selected-window)) ;; (memq event exwm-input--global-prefix-keys) (memq event exwm-input-prefix-keys) (when overriding-terminal-local-map (lookup-key overriding-terminal-local-map (vector event))) (lookup-key (current-local-map) (vector event)) (gethash event exwm-input--simulation-keys))) (defun exwm-input--noop (&rest _args) "A placeholder command." (interactive)) (defun exwm-input--fake-last-command () "Fool some packages into thinking there is a change in the buffer." (setq last-command #'exwm-input--noop) (run-hooks 'pre-command-hook) (run-hooks 'post-command-hook)) (defun exwm-input--on-KeyPress-line-mode (key-press raw-data) "Parse X KeyPress event to Emacs key event and then feed the command loop." (with-slots (detail state) key-press (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state)) event raw-event mode) (exwm--log "%s" keysym) (when (and (/= 0 (car keysym)) (setq raw-event (xcb:keysyms:keysym->event exwm--connection (car keysym) (logand state (lognot (cdr keysym))))) (setq event (exwm-input--mimic-read-event raw-event)) (exwm-input--event-passthrough-p event)) (setq mode xcb:Allow:AsyncKeyboard) (exwm-input--cache-event event) (exwm-input--unread-event raw-event)) (unless mode (if (= 0 (logand #x6000 state)) ;Check the 13~14 bits. ;; Not an XKB state; just replay it. (setq mode xcb:Allow:ReplayKeyboard) ;; An XKB state; sent it with SendEvent. ;; FIXME: Can this also be replayed? ;; FIXME: KeyRelease events are lost. (setq mode xcb:Allow:AsyncKeyboard) (xcb:+request exwm--connection (make-instance 'xcb:SendEvent :propagate 0 :destination (slot-value key-press 'event) :event-mask xcb:EventMask:NoEvent :event raw-data))) (when event (if (not defining-kbd-macro) (exwm-input--fake-last-command) ;; Make Emacs aware of this event when defining keyboard macros. (set-transient-map `(keymap (t . ,#'exwm-input--noop))) (exwm-input--unread-event event)))) (xcb:+request exwm--connection (make-instance 'xcb:AllowEvents :mode mode :time xcb:Time:CurrentTime)) (xcb:flush exwm--connection)))) (defun exwm-input--on-KeyPress-char-mode (key-press &optional _raw-data) "Handle KeyPress event in char-mode." (with-slots (detail state) key-press (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state)) event raw-event) (exwm--log "%s" keysym) (when (and (/= 0 (car keysym)) (setq raw-event (xcb:keysyms:keysym->event exwm--connection (car keysym) (logand state (lognot (cdr keysym))))) (setq event (exwm-input--mimic-read-event raw-event))) (if (not (derived-mode-p 'exwm-mode)) (exwm-input--unread-event raw-event) (exwm-input--cache-event event t) (exwm-input--unread-event raw-event))))) (xcb:+request exwm--connection (make-instance 'xcb:AllowEvents :mode xcb:Allow:AsyncKeyboard :time xcb:Time:CurrentTime)) (xcb:flush exwm--connection)) (defun exwm-input--on-ButtonPress-line-mode (buffer button-event) "Handle button events in line mode. BUFFER is the `exwm-mode' buffer the event was generated on. BUTTON-EVENT is the X event converted into an Emacs event. The return value is used as event_mode to release the original button event." (with-current-buffer buffer (let ((read-event (exwm-input--mimic-read-event button-event))) (exwm--log "%s" read-event) (if (and read-event (exwm-input--event-passthrough-p read-event)) ;; The event should be forwarded to emacs (progn (exwm-input--cache-event read-event) (exwm-input--unread-event button-event) xcb:Allow:SyncPointer) ;; The event should be replayed xcb:Allow:ReplayPointer)))) (defun exwm-input--on-ButtonPress-char-mode () "Handle button events in char-mode. The return value is used as event_mode to release the original button event." (exwm--log) xcb:Allow:ReplayPointer) (defun exwm-input--update-mode-line (id) "Update the propertized `mode-line-process' for window ID." (exwm--log "#x%x" id) (let (help-echo cmd mode) (with-current-buffer (exwm--id->buffer id) (cl-case exwm--input-mode (line-mode (setq mode "line" help-echo "mouse-1: Switch to char-mode" cmd (lambda () (interactive) (exwm-input-release-keyboard id)))) (char-mode (setq mode "char" help-echo "mouse-1: Switch to line-mode" cmd (lambda () (interactive) (exwm-input-grab-keyboard id))))) (setq mode-line-process `(": " (:propertize ,mode help-echo ,help-echo mouse-face mode-line-highlight local-map (keymap (mode-line keymap (down-mouse-1 . ,cmd)))))) (force-mode-line-update)))) (defun exwm-input--grab-keyboard (&optional id) "Grab all key events on window ID." (unless id (setq id (exwm--buffer->id (window-buffer)))) (when id (exwm--log "id=#x%x" id) (when (xcb:+request-checked+request-check exwm--connection (make-instance 'xcb:GrabKey :owner-events 0 :grab-window id :modifiers xcb:ModMask:Any :key xcb:Grab:Any :pointer-mode xcb:GrabMode:Async :keyboard-mode xcb:GrabMode:Sync)) (exwm--log "Failed to grab keyboard for #x%x" id)) (let ((buffer (exwm--id->buffer id))) (when buffer (with-current-buffer buffer (setq exwm--input-mode 'line-mode) (run-hooks 'exwm-input-input-mode-change-hook)))))) (defun exwm-input--release-keyboard (&optional id) "Ungrab all key events on window ID." (unless id (setq id (exwm--buffer->id (window-buffer)))) (when id (exwm--log "id=#x%x" id) (when (xcb:+request-checked+request-check exwm--connection (make-instance 'xcb:UngrabKey :key xcb:Grab:Any :grab-window id :modifiers xcb:ModMask:Any)) (exwm--log "Failed to release keyboard for #x%x" id)) (exwm-input--grab-global-prefix-keys id) (let ((buffer (exwm--id->buffer id))) (when buffer (with-current-buffer buffer (setq exwm--input-mode 'char-mode) (run-hooks 'exwm-input-input-mode-change-hook)))))) ;;;###autoload (defun exwm-input-grab-keyboard (&optional id) "Switch to line-mode." (interactive (list (when (derived-mode-p 'exwm-mode) (exwm--buffer->id (window-buffer))))) (when id (exwm--log "id=#x%x" id) (setq exwm--selected-input-mode 'line-mode) (exwm-input--grab-keyboard id) (exwm-input--update-mode-line id))) ;;;###autoload (defun exwm-input-release-keyboard (&optional id) "Switch to char-mode." (interactive (list (when (derived-mode-p 'exwm-mode) (exwm--buffer->id (window-buffer))))) (when id (exwm--log "id=#x%x" id) (setq exwm--selected-input-mode 'char-mode) (exwm-input--release-keyboard id) (exwm-input--update-mode-line id))) ;;;###autoload (defun exwm-input-toggle-keyboard (&optional id) "Toggle between 'line-mode' and 'char-mode'." (interactive (list (when (derived-mode-p 'exwm-mode) (exwm--buffer->id (window-buffer))))) (when id (exwm--log "id=#x%x" id) (with-current-buffer (exwm--id->buffer id) (cl-case exwm--input-mode (line-mode (exwm-input-release-keyboard id)) (char-mode (exwm-reset)))))) (defun exwm-input--fake-key (event) "Fake a key event equivalent to Emacs event EVENT." (let* ((keysyms (xcb:keysyms:event->keysyms exwm--connection event)) keycode id) (when (= 0 (caar keysyms)) (user-error "[EXWM] Invalid key: %s" (single-key-description event))) (setq keycode (xcb:keysyms:keysym->keycode exwm--connection (caar keysyms))) (when (/= 0 keycode) (setq id (exwm--buffer->id (window-buffer (selected-window)))) (exwm--log "id=#x%x event=%s keycode" id event keycode) (dolist (class '(xcb:KeyPress xcb:KeyRelease)) (xcb:+request exwm--connection (make-instance 'xcb:SendEvent :propagate 0 :destination id :event-mask xcb:EventMask:NoEvent :event (xcb:marshal (make-instance class :detail keycode :time xcb:Time:CurrentTime :root exwm--root :event id :child 0 :root-x 0 :root-y 0 :event-x 0 :event-y 0 :state (cdar keysyms) :same-screen 1) exwm--connection))))) (xcb:flush exwm--connection))) ;;;###autoload (cl-defun exwm-input-send-next-key (times &optional end-key) "Send next key to client window. EXWM will prompt for the key to send. This command can be prefixed to send multiple keys. If END-KEY is non-nil, stop sending keys if it's pressed." (interactive "p") (exwm--log) (unless (derived-mode-p 'exwm-mode) (cl-return-from exwm-input-send-next-key)) (when (> times 12) (setq times 12)) (let (key keys) (dotimes (i times) ;; Skip events not from keyboard (let ((exwm-input-line-mode-passthrough t)) (catch 'break (while t (setq key (read-key (format "Send key: %s (%d/%d) %s" (key-description keys) (1+ i) times (if end-key (concat "To exit, press: " (key-description (list end-key))) "")))) (unless (listp key) (throw 'break nil))))) (setq keys (vconcat keys (vector key))) (when (eq key end-key) (cl-return-from exwm-input-send-next-key)) (exwm-input--fake-key key)))) (defun exwm-input--set-simulation-keys (simulation-keys &optional no-refresh) "Set simulation keys." (exwm--log "%s" simulation-keys) (unless no-refresh ;; Unbind simulation keys. (let ((hash (buffer-local-value 'exwm-input--simulation-keys (current-buffer)))) (when (hash-table-p hash) (maphash (lambda (key _value) (when (sequencep key) (if exwm-input--local-simulation-keys (local-unset-key key) (define-key exwm-mode-map key nil)))) hash))) ;; Abandon the old hash table. (setq exwm-input--simulation-keys (make-hash-table :test #'equal))) (dolist (i simulation-keys) (let ((original (vconcat (car i))) (simulated (cdr i))) (setq simulated (if (sequencep simulated) (append simulated nil) (list simulated))) ;; The key stored is a key sequence (vector). ;; The value stored is a list of key events. (puthash original simulated exwm-input--simulation-keys) ;; Also mark the prefix key as used. (puthash (aref original 0) t exwm-input--simulation-keys))) ;; Update keymaps. (maphash (lambda (key _value) (when (sequencep key) (if exwm-input--local-simulation-keys (local-set-key key #'exwm-input-send-simulation-key) (define-key exwm-mode-map key #'exwm-input-send-simulation-key)))) exwm-input--simulation-keys)) (defun exwm-input-set-simulation-keys (simulation-keys) "Please customize or set `exwm-input-simulation-keys' instead." (declare (obsolete nil "26")) (exwm-input--set-simulation-keys simulation-keys)) (defcustom exwm-input-simulation-keys nil "Simulation keys. It is an alist of the form (original-key . simulated-key), where both original-key and simulated-key are key sequences. Original-key is what you type to an X window in line-mode which then gets translated to simulated-key by EXWM and forwarded to the X window. Notes: * Setting the value directly (rather than customizing it) after EXWM finishes initialization has no effect. * Original-keys consist of multiple key events are only supported in Emacs 26.2 and later. * A minority of applications do not accept simulated keys by default. It's required to customize them to accept events sent by SendEvent. * The predefined examples in the Customize interface are not guaranteed to work for all applications. This can be tweaked on a per application basis with `exwm-input-set-local-simulation-keys'." :type '(alist :key-type (key-sequence :tag "Original") :value-type (choice (key-sequence :tag "User-defined") (key-sequence :tag "Move left" [left]) (key-sequence :tag "Move right" [right]) (key-sequence :tag "Move up" [up]) (key-sequence :tag "Move down" [down]) (key-sequence :tag "Move to BOL" [home]) (key-sequence :tag "Move to EOL" [end]) (key-sequence :tag "Page up" [prior]) (key-sequence :tag "Page down" [next]) (key-sequence :tag "Copy" [C-c]) (key-sequence :tag "Paste" [C-v]) (key-sequence :tag "Delete" [delete]) (key-sequence :tag "Delete to EOL" [S-end delete]))) :set (lambda (symbol value) (set symbol value) (exwm-input--set-simulation-keys value))) (defcustom exwm-input-pre-post-command-blacklist '(exit-minibuffer abort-recursive-edit minibuffer-keyboard-quit) "Commands impossible to detect with `post-command-hook'." :type '(repeat function)) (cl-defun exwm-input--read-keys (prompt stop-key) (let ((cursor-in-echo-area t) keys key) (while (not (eq key stop-key)) (setq key (read-key (format "%s (terminate with %s): %s" prompt (key-description (vector stop-key)) (key-description keys))) keys (vconcat keys (vector key)))) (when (> (length keys) 1) (substring keys 0 -1)))) ;;;###autoload (defun exwm-input-set-simulation-key (original-key simulated-key) "Set a simulation key. The simulation key takes effect in real time, but is lost when this session ends unless it's specifically saved in the Customize interface for `exwm-input-simulation-keys'." (interactive (let (original simulated) (setq original (exwm-input--read-keys "Translate from" ?\C-g)) (when original (setq simulated (exwm-input--read-keys (format "Translate from %s to" (key-description original)) ?\C-g))) (list original simulated))) (exwm--log "original: %s, simulated: %s" original-key simulated-key) (when (and original-key simulated-key) (let ((entry `((,original-key . ,simulated-key)))) (setq exwm-input-simulation-keys (append exwm-input-simulation-keys entry)) (exwm-input--set-simulation-keys entry t)))) (defun exwm-input--unset-simulation-keys () "Clear simulation keys and key bindings defined." (exwm--log) (when (hash-table-p exwm-input--simulation-keys) (maphash (lambda (key _value) (when (sequencep key) (define-key exwm-mode-map key nil))) exwm-input--simulation-keys) (clrhash exwm-input--simulation-keys))) (defun exwm-input-set-local-simulation-keys (simulation-keys) "Set buffer-local simulation keys. SIMULATION-KEYS is an alist of the form (original-key . simulated-key), where both ORIGINAL-KEY and SIMULATED-KEY are key sequences." (exwm--log) (make-local-variable 'exwm-input--simulation-keys) (use-local-map (copy-keymap exwm-mode-map)) (let ((exwm-input--local-simulation-keys t)) (exwm-input--set-simulation-keys simulation-keys))) ;;;###autoload (cl-defun exwm-input-send-simulation-key (times) "Fake a key event according to the last input key sequence." (interactive "p") (exwm--log) (unless (derived-mode-p 'exwm-mode) (cl-return-from exwm-input-send-simulation-key)) (let ((keys (gethash (this-single-command-keys) exwm-input--simulation-keys))) (dotimes (_ times) (dolist (key keys) (exwm-input--fake-key key))))) ;;;###autoload (defmacro exwm-input-invoke-factory (keys) "Make a command that invokes KEYS when called. One use is to access the keymap bound to KEYS (as prefix keys) in char-mode." (let* ((keys (kbd keys)) (description (key-description keys))) `(defun ,(intern (concat "exwm-input--invoke--" description)) () ,(format "Invoke `%s'." description) (interactive) (mapc (lambda (key) (exwm-input--cache-event key t) (exwm-input--unread-event key)) ',(listify-key-sequence keys))))) (defun exwm-input--on-pre-command () "Run in `pre-command-hook'." (unless (or (eq this-command #'exwm-input--noop) (memq this-command exwm-input-pre-post-command-blacklist)) (setq exwm-input--during-command t))) (defun exwm-input--on-post-command () "Run in `post-command-hook'." (unless (eq this-command #'exwm-input--noop) (setq exwm-input--during-command nil))) (defun exwm-input--on-minibuffer-setup () "Run in `minibuffer-setup-hook' to grab keyboard if necessary." (exwm--log) (with-current-buffer (window-buffer (frame-selected-window exwm-workspace--current)) (when (and (derived-mode-p 'exwm-mode) (not (exwm-workspace--client-p)) (eq exwm--selected-input-mode 'char-mode)) (exwm-input--grab-keyboard exwm--id)))) (defun exwm-input--on-minibuffer-exit () "Run in `minibuffer-exit-hook' to release keyboard if necessary." (exwm--log) (with-current-buffer (window-buffer (frame-selected-window exwm-workspace--current)) (when (and (derived-mode-p 'exwm-mode) (not (exwm-workspace--client-p)) (eq exwm--selected-input-mode 'char-mode) (eq exwm--input-mode 'line-mode)) (exwm-input--release-keyboard exwm--id)))) (defun exwm-input--on-echo-area-dirty () "Run when new message arrives to grab keyboard if necessary." (exwm--log) (when (and (not (active-minibuffer-window)) (not (exwm-workspace--client-p)) cursor-in-echo-area) (exwm-input--on-minibuffer-setup))) (defun exwm-input--on-echo-area-clear () "Run in `echo-area-clear-hook' to release keyboard if necessary." (exwm--log) (unless (current-message) (exwm-input--on-minibuffer-exit))) (defun exwm-input--init () "Initialize the keyboard module." (exwm--log) ;; Refresh keyboard mapping (xcb:keysyms:init exwm--connection #'exwm-input--on-keysyms-update) ;; Create the X window and intern the atom used to fetch timestamp. (setq exwm-input--timestamp-window (xcb:generate-id exwm--connection)) (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 :wid exwm-input--timestamp-window :parent exwm--root :x -1 :y -1 :width 1 :height 1 :border-width 0 :class xcb:WindowClass:CopyFromParent :visual 0 :value-mask xcb:CW:EventMask :event-mask xcb:EventMask:PropertyChange)) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window exwm-input--timestamp-window :data "EXWM: exwm-input--timestamp-window")) (setq exwm-input--timestamp-atom (exwm--intern-atom "_TIME")) ;; Initialize global keys. (dolist (i exwm-input-global-keys) (exwm-input--set-key (car i) (cdr i))) ;; Initialize simulation keys. (when exwm-input-simulation-keys (exwm-input--set-simulation-keys exwm-input-simulation-keys)) ;; Attach event listeners (xcb:+event exwm--connection 'xcb:PropertyNotify #'exwm-input--on-PropertyNotify) (xcb:+event exwm--connection 'xcb:CreateNotify #'exwm-input--on-CreateNotify) (xcb:+event exwm--connection 'xcb:KeyPress #'exwm-input--on-KeyPress) (xcb:+event exwm--connection 'xcb:ButtonPress #'exwm-input--on-ButtonPress) (xcb:+event exwm--connection 'xcb:ButtonRelease #'exwm-floating--stop-moveresize) (xcb:+event exwm--connection 'xcb:MotionNotify #'exwm-floating--do-moveresize) (when mouse-autoselect-window (xcb:+event exwm--connection 'xcb:EnterNotify #'exwm-input--on-EnterNotify)) ;; Control `exwm-input--during-command' (add-hook 'pre-command-hook #'exwm-input--on-pre-command) (add-hook 'post-command-hook #'exwm-input--on-post-command) ;; Grab/Release keyboard when minibuffer/echo becomes active/inactive. (add-hook 'minibuffer-setup-hook #'exwm-input--on-minibuffer-setup) (add-hook 'minibuffer-exit-hook #'exwm-input--on-minibuffer-exit) (setq exwm-input--echo-area-timer (run-with-idle-timer 0 t #'exwm-input--on-echo-area-dirty)) (add-hook 'echo-area-clear-hook #'exwm-input--on-echo-area-clear) ;; Update focus when buffer list updates (add-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update)) (defun exwm-input--post-init () "The second stage in the initialization of the input module." (exwm--log) (exwm-input--update-global-prefix-keys)) (defun exwm-input--exit () "Exit the input module." (exwm--log) (exwm-input--unset-simulation-keys) (remove-hook 'pre-command-hook #'exwm-input--on-pre-command) (remove-hook 'post-command-hook #'exwm-input--on-post-command) (remove-hook 'minibuffer-setup-hook #'exwm-input--on-minibuffer-setup) (remove-hook 'minibuffer-exit-hook #'exwm-input--on-minibuffer-exit) (when exwm-input--echo-area-timer (cancel-timer exwm-input--echo-area-timer) (setq exwm-input--echo-area-timer nil)) (remove-hook 'echo-area-clear-hook #'exwm-input--on-echo-area-clear) (remove-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update) (when exwm-input--update-focus-defer-timer (cancel-timer exwm-input--update-focus-defer-timer)) (when exwm-input--update-focus-timer (cancel-timer exwm-input--update-focus-timer)) ;; Make input focus working even without a WM. (xcb:+request exwm--connection (make-instance 'xcb:SetInputFocus :revert-to xcb:InputFocus:PointerRoot :focus exwm--root :time xcb:Time:CurrentTime)) (xcb:flush exwm--connection)) (provide 'exwm-input) ;;; exwm-input.el ends here exwm-0.26/exwm-layout.el000066400000000000000000000643101414260560000152400ustar00rootroot00000000000000;;; exwm-layout.el --- Layout Module for EXWM -*- lexical-binding: t -*- ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module is responsible for keeping X client window properly displayed. ;;; Code: (require 'exwm-core) (defgroup exwm-layout nil "Layout." :version "25.3" :group 'exwm) (defcustom exwm-layout-auto-iconify t "Non-nil to automatically iconify unused X windows when possible." :type 'boolean) (defcustom exwm-layout-show-all-buffers nil "Non-nil to allow switching to buffers on other workspaces." :type 'boolean) (defconst exwm-layout--floating-hidden-position -101 "Where to place hidden floating X windows.") (defvar exwm-layout--other-buffer-exclude-buffers nil "List of buffers that should not be selected by `other-buffer'.") (defvar exwm-layout--other-buffer-exclude-exwm-mode-buffers nil "When non-nil, prevent EXWM buffers from being selected by `other-buffer'.") (defvar exwm-layout--timer nil "Timer used to track echo area changes.") (defvar exwm-workspace--current) (defvar exwm-workspace--frame-y-offset) (declare-function exwm-input--release-keyboard "exwm-input.el") (declare-function exwm-input--grab-keyboard "exwm-input.el") (declare-function exwm-input-grab-keyboard "exwm-input.el") (declare-function exwm-workspace--active-p "exwm-workspace.el" (frame)) (declare-function exwm-workspace--client-p "exwm-workspace.el" (&optional frame)) (declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el") (declare-function exwm-workspace--workspace-p "exwm-workspace.el" (workspace)) (declare-function exwm-workspace-move-window "exwm-workspace.el" (frame-or-index &optional id)) (defun exwm-layout--set-state (id state) "Set WM_STATE." (exwm--log "id=#x%x" id) (xcb:+request exwm--connection (make-instance 'xcb:icccm:set-WM_STATE :window id :state state :icon xcb:Window:None)) (with-current-buffer (exwm--id->buffer id) (setq exwm-state state))) (defun exwm-layout--iconic-state-p (&optional id) (= xcb:icccm:WM_STATE:IconicState (if id (buffer-local-value 'exwm-state (exwm--id->buffer id)) exwm-state))) (defun exwm-layout--set-ewmh-state (xwin) "Set _NET_WM_STATE." (with-current-buffer (exwm--id->buffer xwin) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_STATE :window exwm--id :data exwm--ewmh-state)))) (defun exwm-layout--fullscreen-p () (when (derived-mode-p 'exwm-mode) (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state))) (defun exwm-layout--auto-iconify () (when (and exwm-layout-auto-iconify (not exwm-transient-for)) (let ((xwin exwm--id) (state exwm-state)) (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (when (and exwm--floating-frame (eq exwm-transient-for xwin) (not (eq exwm-state state))) (if (eq state xcb:icccm:WM_STATE:NormalState) (exwm-layout--refresh-floating exwm--floating-frame) (exwm-layout--hide exwm--id)))))))) (defun exwm-layout--show (id &optional window) "Show window ID exactly fit in the Emacs window WINDOW." (exwm--log "Show #x%x in %s" id window) (let* ((edges (window-inside-absolute-pixel-edges window)) (x (pop edges)) (y (pop edges)) (width (- (pop edges) x)) (height (- (pop edges) y)) frame-x frame-y frame-width frame-height) (with-current-buffer (exwm--id->buffer id) (when exwm--floating-frame (setq frame-width (frame-pixel-width exwm--floating-frame) frame-height (+ (frame-pixel-height exwm--floating-frame) ;; Use `frame-outer-height' in the future. exwm-workspace--frame-y-offset)) (when exwm--floating-frame-position (setq frame-x (elt exwm--floating-frame-position 0) frame-y (elt exwm--floating-frame-position 1) x (+ x frame-x (- exwm-layout--floating-hidden-position)) y (+ y frame-y (- exwm-layout--floating-hidden-position))) (setq exwm--floating-frame-position nil)) (exwm--set-geometry (frame-parameter exwm--floating-frame 'exwm-container) frame-x frame-y frame-width frame-height)) (when (exwm-layout--fullscreen-p) (with-slots ((x* x) (y* y) (width* width) (height* height)) (exwm-workspace--get-geometry exwm--frame) (setq x x* y y* width width* height height*))) (exwm--set-geometry id x y width height) (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window id)) (exwm-layout--set-state id xcb:icccm:WM_STATE:NormalState) (setq exwm--ewmh-state (delq xcb:Atom:_NET_WM_STATE_HIDDEN exwm--ewmh-state)) (exwm-layout--set-ewmh-state id) (exwm-layout--auto-iconify))) (xcb:flush exwm--connection)) (defun exwm-layout--hide (id) "Hide window ID." (with-current-buffer (exwm--id->buffer id) (unless (or (exwm-layout--iconic-state-p) (and exwm--floating-frame (eq 4294967295. exwm--desktop))) (exwm--log "Hide #x%x" id) (when exwm--floating-frame (let* ((container (frame-parameter exwm--floating-frame 'exwm-container)) (geometry (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable container)))) (setq exwm--floating-frame-position (vector (slot-value geometry 'x) (slot-value geometry 'y))) (exwm--set-geometry container exwm-layout--floating-hidden-position exwm-layout--floating-hidden-position 1 1))) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window id :value-mask xcb:CW:EventMask :event-mask xcb:EventMask:NoEvent)) (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window id)) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window id :value-mask xcb:CW:EventMask :event-mask (exwm--get-client-event-mask))) (exwm-layout--set-state id xcb:icccm:WM_STATE:IconicState) (cl-pushnew xcb:Atom:_NET_WM_STATE_HIDDEN exwm--ewmh-state) (exwm-layout--set-ewmh-state id) (exwm-layout--auto-iconify) (xcb:flush exwm--connection)))) ;;;###autoload (cl-defun exwm-layout-set-fullscreen (&optional id) "Make window ID fullscreen." (interactive) (exwm--log "id=#x%x" (or id 0)) (unless (and (or id (derived-mode-p 'exwm-mode)) (not (exwm-layout--fullscreen-p))) (cl-return-from exwm-layout-set-fullscreen)) (with-current-buffer (if id (exwm--id->buffer id) (window-buffer)) ;; Expand the X window to fill the whole screen. (with-slots (x y width height) (exwm-workspace--get-geometry exwm--frame) (exwm--set-geometry exwm--id x y width height)) ;; Raise the X window. (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window exwm--id :value-mask (logior xcb:ConfigWindow:BorderWidth xcb:ConfigWindow:StackMode) :border-width 0 :stack-mode xcb:StackMode:Above)) (cl-pushnew xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state) (exwm-layout--set-ewmh-state exwm--id) (xcb:flush exwm--connection) (set-window-dedicated-p (get-buffer-window) t) (exwm-input--release-keyboard exwm--id))) ;;;###autoload (cl-defun exwm-layout-unset-fullscreen (&optional id) "Restore window from fullscreen state." (interactive) (exwm--log "id=#x%x" (or id 0)) (unless (and (or id (derived-mode-p 'exwm-mode)) (exwm-layout--fullscreen-p)) (cl-return-from exwm-layout-unset-fullscreen)) (with-current-buffer (if id (exwm--id->buffer id) (window-buffer)) ;; `exwm-layout--show' relies on `exwm--ewmh-state' to decide whether to ;; fullscreen the window. (setq exwm--ewmh-state (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state)) (exwm-layout--set-ewmh-state exwm--id) (if exwm--floating-frame (exwm-layout--show exwm--id (frame-root-window exwm--floating-frame)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window exwm--id :value-mask (logior xcb:ConfigWindow:Sibling xcb:ConfigWindow:StackMode) :sibling exwm--guide-window :stack-mode xcb:StackMode:Above)) (let ((window (get-buffer-window nil t))) (when window (exwm-layout--show exwm--id window)))) (xcb:flush exwm--connection) (set-window-dedicated-p (get-buffer-window) nil) (when (eq 'line-mode exwm--selected-input-mode) (exwm-input--grab-keyboard exwm--id)))) ;;;###autoload (cl-defun exwm-layout-toggle-fullscreen (&optional id) "Toggle fullscreen mode." (interactive (list (exwm--buffer->id (window-buffer)))) (exwm--log "id=#x%x" (or id 0)) (unless (or id (derived-mode-p 'exwm-mode)) (cl-return-from exwm-layout-toggle-fullscreen)) (when id (with-current-buffer (exwm--id->buffer id) (if (exwm-layout--fullscreen-p) (exwm-layout-unset-fullscreen id) (exwm-layout-set-fullscreen id))))) (defun exwm-layout--other-buffer-predicate (buffer) "Return non-nil when the BUFFER may be displayed in selected frame. Prevents EXWM-mode buffers already being displayed on some other window from being selected. Should be set as `buffer-predicate' frame parameter for all frames. Used by `other-buffer'. When variable `exwm-layout--other-buffer-exclude-exwm-mode-buffers' is t EXWM buffers are never selected by `other-buffer'. When variable `exwm-layout--other-buffer-exclude-buffers' is a list of buffers, EXWM buffers belonging to that list are never selected by `other-buffer'." (or (not (with-current-buffer buffer (derived-mode-p 'exwm-mode))) (and (not exwm-layout--other-buffer-exclude-exwm-mode-buffers) (not (memq buffer exwm-layout--other-buffer-exclude-buffers)) ;; Do not select if already shown in some window. (not (get-buffer-window buffer t))))) (defun exwm-layout--set-client-list-stacking () "Set _NET_CLIENT_LIST_STACKING." (exwm--log) (let (id clients-floating clients clients-iconic clients-other) (dolist (pair exwm--id-buffer-alist) (setq id (car pair)) (with-current-buffer (cdr pair) (if (eq exwm--frame exwm-workspace--current) (if exwm--floating-frame ;; A floating X window on the current workspace. (setq clients-floating (cons id clients-floating)) (if (get-buffer-window (cdr pair) exwm-workspace--current) ;; A normal tilling X window on the current workspace. (setq clients (cons id clients)) ;; An iconic tilling X window on the current workspace. (setq clients-iconic (cons id clients-iconic)))) ;; X window on other workspaces. (setq clients-other (cons id clients-other))))) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST_STACKING :window exwm--root :data (vconcat (append clients-other clients-iconic clients clients-floating)))))) (defun exwm-layout--refresh (&optional frame) "Refresh layout." ;; `window-size-change-functions' sets this argument while ;; `window-configuration-change-hook' makes the frame selected. (unless frame (setq frame (selected-frame))) (exwm--log "frame=%s" frame) (if (not (exwm-workspace--workspace-p frame)) (if (frame-parameter frame 'exwm-outer-id) (exwm-layout--refresh-floating frame) (exwm-layout--refresh-other frame)) (exwm-layout--refresh-workspace frame))) (defun exwm-layout--refresh-floating (frame) "Refresh floating frame FRAME." (exwm--log "Refresh floating %s" frame) (let ((window (frame-first-window frame))) (with-current-buffer (window-buffer window) (when (and (derived-mode-p 'exwm-mode) ;; It may be a buffer waiting to be killed. (exwm--id->buffer exwm--id)) (exwm--log "Refresh floating window #x%x" exwm--id) (if (exwm-workspace--active-p exwm--frame) (exwm-layout--show exwm--id window) (exwm-layout--hide exwm--id)))))) (defun exwm-layout--refresh-other (frame) "Refresh client or nox frame FRAME." ;; Other frames (e.g. terminal/graphical frame of emacsclient) ;; We shall bury all `exwm-mode' buffers in this case (exwm--log "Refresh other %s" frame) (let ((windows (window-list frame 'nomini)) ;exclude minibuffer (exwm-layout--other-buffer-exclude-exwm-mode-buffers t)) (dolist (window windows) (with-current-buffer (window-buffer window) (when (derived-mode-p 'exwm-mode) (if (window-prev-buffers window) (switch-to-prev-buffer window) (switch-to-next-buffer window))))))) (defun exwm-layout--refresh-workspace (frame) "Refresh workspace frame FRAME." (exwm--log "Refresh workspace %s" frame) ;; Workspaces other than the active one can also be refreshed (RandR) (let (covered-buffers ;EXWM-buffers covered by a new X window. vacated-windows) ;Windows previously displaying EXWM-buffers. (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (when (and (not exwm--floating-frame) ;exclude floating X windows (or exwm-layout-show-all-buffers ;; Exclude X windows on other workspaces (eq frame exwm--frame))) (let (;; List of windows in current frame displaying the `exwm-mode' ;; buffers. (windows (get-buffer-window-list (current-buffer) 'nomini frame))) (if (not windows) (when (eq frame exwm--frame) ;; Hide it if it was being shown in this workspace. (exwm-layout--hide exwm--id)) (let ((window (car windows))) (if (eq frame exwm--frame) ;; Show it if `frame' is active, hide otherwise. (if (exwm-workspace--active-p frame) (exwm-layout--show exwm--id window) (exwm-layout--hide exwm--id)) ;; It was last shown in other workspace; move it here. (exwm-workspace-move-window frame exwm--id)) ;; Vacate any other windows (in any workspace) showing this ;; `exwm-mode' buffer. (setq vacated-windows (append vacated-windows (remove window (get-buffer-window-list (current-buffer) 'nomini t)))) ;; Note any `exwm-mode' buffer is being covered by another ;; `exwm-mode' buffer. We want to avoid that `exwm-mode' ;; buffer to be reappear in any of the vacated windows. (let ((prev-buffer (car-safe (car-safe (window-prev-buffers window))))) (and prev-buffer (with-current-buffer prev-buffer (derived-mode-p 'exwm-mode)) (push prev-buffer covered-buffers))))))))) ;; Set some sensible buffer to vacated windows. (let ((exwm-layout--other-buffer-exclude-buffers covered-buffers)) (dolist (window vacated-windows) (if (window-prev-buffers window) (switch-to-prev-buffer window) (switch-to-next-buffer window)))) ;; Make sure windows floating / on other workspaces are excluded (let ((exwm-layout--other-buffer-exclude-exwm-mode-buffers t)) (dolist (window (window-list frame 'nomini)) (with-current-buffer (window-buffer window) (when (and (derived-mode-p 'exwm-mode) (or exwm--floating-frame (not (eq frame exwm--frame)))) (if (window-prev-buffers window) (switch-to-prev-buffer window) (switch-to-next-buffer window)))))) (exwm-layout--set-client-list-stacking) (xcb:flush exwm--connection))) (defun exwm-layout--on-minibuffer-setup () "Refresh layout when minibuffer grows." (exwm--log) (unless (exwm-workspace--client-p) (exwm--defer 0 (lambda () (when (< 1 (window-height (minibuffer-window))) (exwm-layout--refresh)))))) (defun exwm-layout--on-echo-area-change (&optional dirty) "Run when message arrives or in `echo-area-clear-hook' to refresh layout." (when (and (current-message) (not (exwm-workspace--client-p)) (or (cl-position ?\n (current-message)) (> (length (current-message)) (frame-width exwm-workspace--current)))) (exwm--log) (if dirty (exwm-layout--refresh) (exwm--defer 0 #'exwm-layout--refresh)))) ;;;###autoload (defun exwm-layout-enlarge-window (delta &optional horizontal) "Make the selected window DELTA pixels taller. If no argument is given, make the selected window one pixel taller. If the optional argument HORIZONTAL is non-nil, make selected window DELTA pixels wider. If DELTA is negative, shrink selected window by -DELTA pixels. Normal hints are checked and regarded if the selected window is displaying an `exwm-mode' buffer. However, this may violate the normal hints set on other X windows." (interactive "p") (exwm--log) (cond ((zerop delta)) ;no operation ((window-minibuffer-p)) ;avoid resize minibuffer-window ((not (and (derived-mode-p 'exwm-mode) exwm--floating-frame)) ;; Resize on tiling layout (unless (= 0 (window-resizable nil delta horizontal nil t)) ;not resizable (let ((window-resize-pixelwise t)) (window-resize nil delta horizontal nil t)))) ;; Resize on floating layout (exwm--fixed-size) ;fixed size (horizontal (let* ((width (frame-pixel-width)) (edges (window-inside-pixel-edges)) (inner-width (- (elt edges 2) (elt edges 0))) (margin (- width inner-width))) (if (> delta 0) (if (not exwm--normal-hints-max-width) (cl-incf width delta) (if (>= inner-width exwm--normal-hints-max-width) (setq width nil) (setq width (min (+ exwm--normal-hints-max-width margin) (+ width delta))))) (if (not exwm--normal-hints-min-width) (cl-incf width delta) (if (<= inner-width exwm--normal-hints-min-width) (setq width nil) (setq width (max (+ exwm--normal-hints-min-width margin) (+ width delta)))))) (when (and width (> width 0)) (setf (slot-value exwm--geometry 'width) width) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm--floating-frame 'exwm-outer-id) :value-mask xcb:ConfigWindow:Width :width width)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm--floating-frame 'exwm-container) :value-mask xcb:ConfigWindow:Width :width width)) (xcb:flush exwm--connection)))) (t (let* ((height (+ (frame-pixel-height) exwm-workspace--frame-y-offset)) (edges (window-inside-pixel-edges)) (inner-height (- (elt edges 3) (elt edges 1))) (margin (- height inner-height))) (if (> delta 0) (if (not exwm--normal-hints-max-height) (cl-incf height delta) (if (>= inner-height exwm--normal-hints-max-height) (setq height nil) (setq height (min (+ exwm--normal-hints-max-height margin) (+ height delta))))) (if (not exwm--normal-hints-min-height) (cl-incf height delta) (if (<= inner-height exwm--normal-hints-min-height) (setq height nil) (setq height (max (+ exwm--normal-hints-min-height margin) (+ height delta)))))) (when (and height (> height 0)) (setf (slot-value exwm--geometry 'height) height) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm--floating-frame 'exwm-outer-id) :value-mask xcb:ConfigWindow:Height :height height)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm--floating-frame 'exwm-container) :value-mask xcb:ConfigWindow:Height :height height)) (xcb:flush exwm--connection)))))) ;;;###autoload (defun exwm-layout-enlarge-window-horizontally (delta) "Make the selected window DELTA pixels wider. See also `exwm-layout-enlarge-window'." (interactive "p") (exwm--log "%s" delta) (exwm-layout-enlarge-window delta t)) ;;;###autoload (defun exwm-layout-shrink-window (delta) "Make the selected window DELTA pixels lower. See also `exwm-layout-enlarge-window'." (interactive "p") (exwm--log "%s" delta) (exwm-layout-enlarge-window (- delta))) ;;;###autoload (defun exwm-layout-shrink-window-horizontally (delta) "Make the selected window DELTA pixels narrower. See also `exwm-layout-enlarge-window'." (interactive "p") (exwm--log "%s" delta) (exwm-layout-enlarge-window (- delta) t)) ;;;###autoload (defun exwm-layout-hide-mode-line () "Hide mode-line." (interactive) (exwm--log) (when (and (derived-mode-p 'exwm-mode) mode-line-format) (let (mode-line-height) (when exwm--floating-frame (setq mode-line-height (window-mode-line-height (frame-root-window exwm--floating-frame)))) (setq exwm--mode-line-format mode-line-format mode-line-format nil) (if (not exwm--floating-frame) (exwm-layout--show exwm--id) (set-frame-height exwm--floating-frame (- (frame-pixel-height exwm--floating-frame) mode-line-height) nil t))))) ;;;###autoload (defun exwm-layout-show-mode-line () "Show mode-line." (interactive) (exwm--log) (when (and (derived-mode-p 'exwm-mode) (not mode-line-format)) (setq mode-line-format exwm--mode-line-format exwm--mode-line-format nil) (if (not exwm--floating-frame) (exwm-layout--show exwm--id) (set-frame-height exwm--floating-frame (+ (frame-pixel-height exwm--floating-frame) (window-mode-line-height (frame-root-window exwm--floating-frame))) nil t) (call-interactively #'exwm-input-grab-keyboard)) (force-mode-line-update))) ;;;###autoload (defun exwm-layout-toggle-mode-line () "Toggle the display of mode-line." (interactive) (exwm--log) (when (derived-mode-p 'exwm-mode) (if mode-line-format (exwm-layout-hide-mode-line) (exwm-layout-show-mode-line)))) (defun exwm-layout--init () "Initialize layout module." ;; Auto refresh layout (exwm--log) (add-hook 'window-configuration-change-hook #'exwm-layout--refresh) ;; The behavior of `window-configuration-change-hook' will be changed. (when (fboundp 'window-pixel-width-before-size-change) (add-hook 'window-size-change-functions #'exwm-layout--refresh)) (unless (exwm-workspace--minibuffer-own-frame-p) ;; Refresh when minibuffer grows (add-hook 'minibuffer-setup-hook #'exwm-layout--on-minibuffer-setup t) (setq exwm-layout--timer (run-with-idle-timer 0 t #'exwm-layout--on-echo-area-change t)) (add-hook 'echo-area-clear-hook #'exwm-layout--on-echo-area-change))) (defun exwm-layout--exit () "Exit the layout module." (exwm--log) (remove-hook 'window-configuration-change-hook #'exwm-layout--refresh) (when (fboundp 'window-pixel-width-before-size-change) (remove-hook 'window-size-change-functions #'exwm-layout--refresh)) (remove-hook 'minibuffer-setup-hook #'exwm-layout--on-minibuffer-setup) (when exwm-layout--timer (cancel-timer exwm-layout--timer) (setq exwm-layout--timer nil)) (remove-hook 'echo-area-clear-hook #'exwm-layout--on-echo-area-change)) (provide 'exwm-layout) ;;; exwm-layout.el ends here exwm-0.26/exwm-manage.el000066400000000000000000001130401414260560000151460ustar00rootroot00000000000000;;; exwm-manage.el --- Window Management Module for -*- lexical-binding: t -*- ;;; EXWM ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; 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 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 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 exwm-0.26/exwm-randr.el000066400000000000000000000401341414260560000150270ustar00rootroot00000000000000;;; exwm-randr.el --- RandR Module for EXWM -*- lexical-binding: t -*- ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module adds RandR support for EXWM. Currently it requires external ;; tools such as xrandr(1) to properly configure RandR first. This ;; dependency may be removed in the future, but more work is needed before ;; that. ;; To use this module, load, enable it and configure ;; `exwm-randr-workspace-monitor-plist' and `exwm-randr-screen-change-hook' ;; as follows: ;; ;; (require 'exwm-randr) ;; (setq exwm-randr-workspace-monitor-plist '(0 "VGA1")) ;; (add-hook 'exwm-randr-screen-change-hook ;; (lambda () ;; (start-process-shell-command ;; "xrandr" nil "xrandr --output VGA1 --left-of LVDS1 --auto"))) ;; (exwm-randr-enable) ;; ;; With above lines, workspace 0 should be assigned to the output named "VGA1", ;; staying at the left of other workspaces on the output "LVDS1". Please refer ;; to xrandr(1) for the configuration of RandR. ;; References: ;; + RandR (http://www.x.org/archive/X11R7.7/doc/randrproto/randrproto.txt) ;;; Code: (require 'xcb-randr) (require 'exwm-core) (require 'exwm-workspace) (defgroup exwm-randr nil "RandR." :version "25.3" :group 'exwm) (defcustom exwm-randr-refresh-hook nil "Normal hook run when the RandR module just refreshed." :type 'hook) (defcustom exwm-randr-screen-change-hook nil "Normal hook run when screen changes." :type 'hook) (defcustom exwm-randr-workspace-monitor-plist nil "Plist mapping workspaces to monitors. In RandR 1.5 a monitor is a rectangle region decoupled from the physical size of screens, and can be identified with `xrandr --listmonitors' (name of the primary monitor is prefixed with an `*'). When no monitor is created it automatically fallback to RandR 1.2 output which represents the physical screen size. RandR 1.5 monitors can be created with `xrandr --setmonitor'. For example, to split an output (`LVDS-1') of size 1280x800 into two side-by-side monitors one could invoke (the digits after `/' are size in mm) xrandr --setmonitor *LVDS-1-L 640/135x800/163+0+0 LVDS-1 xrandr --setmonitor LVDS-1-R 640/135x800/163+640+0 none If a monitor is not active, the workspaces mapped to it are displayed on the primary monitor until it becomes active (if ever). Unspecified workspaces are all mapped to the primary monitor. For example, with the following setting workspace other than 1 and 3 would always be displayed on the primary monitor where workspace 1 and 3 would be displayed on their corresponding monitors whenever the monitors are active. \\='(1 \"HDMI-1\" 3 \"DP-1\")" :type '(plist :key-type integer :value-type string)) (with-no-warnings (define-obsolete-variable-alias 'exwm-randr-workspace-output-plist 'exwm-randr-workspace-monitor-plist "27.1")) (defvar exwm-randr--last-timestamp 0 "Used for debouncing events.") (defvar exwm-randr--prev-screen-change-seqnum nil "The most recent ScreenChangeNotify sequence number.") (defvar exwm-randr--compatibility-mode nil "Non-nil when the server does not support RandR 1.5 protocol.") (defun exwm-randr--get-monitors () "Get RandR 1.5 monitors." (exwm--log) (let (monitor-name geometry monitor-geometry-alist primary-monitor) (with-slots (timestamp monitors) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:randr:GetMonitors :window exwm--root :get-active 1)) (when (> timestamp exwm-randr--last-timestamp) (setq exwm-randr--last-timestamp timestamp)) (dolist (monitor monitors) (with-slots (name primary x y width height) monitor (setq monitor-name (x-get-atom-name name) geometry (make-instance 'xcb:RECTANGLE :x x :y y :width width :height height) monitor-geometry-alist (cons (cons monitor-name geometry) monitor-geometry-alist)) (exwm--log "%s: %sx%s+%s+%s" monitor-name x y width height) ;; Save primary monitor when available (fallback to the first one). (when (or (/= 0 primary) (not primary-monitor)) (setq primary-monitor monitor-name))))) (exwm--log "Primary monitor: %s" primary-monitor) (list primary-monitor monitor-geometry-alist (exwm-randr--get-monitor-alias primary-monitor monitor-geometry-alist)))) (defun exwm-randr--get-outputs () "Get RandR 1.2 outputs. Only used when RandR 1.5 is not supported by the server." (exwm--log) (let (output-name geometry output-geometry-alist primary-output) (with-slots (config-timestamp outputs) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:randr:GetScreenResourcesCurrent :window exwm--root)) (when (> config-timestamp exwm-randr--last-timestamp) (setq exwm-randr--last-timestamp config-timestamp)) (dolist (output outputs) (with-slots (crtc connection name) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:randr:GetOutputInfo :output output :config-timestamp config-timestamp)) (when (and (= connection xcb:randr:Connection:Connected) (/= crtc 0)) (with-slots (x y width height) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:randr:GetCrtcInfo :crtc crtc :config-timestamp config-timestamp)) (setq output-name (decode-coding-string (apply #'unibyte-string name) 'utf-8) geometry (make-instance 'xcb:RECTANGLE :x x :y y :width width :height height) output-geometry-alist (cons (cons output-name geometry) output-geometry-alist)) (exwm--log "%s: %sx%s+%s+%s" output-name x y width height) ;; The primary output is the first one. (unless primary-output (setq primary-output output-name))))))) (exwm--log "Primary output: %s" primary-output) (list primary-output output-geometry-alist (exwm-randr--get-monitor-alias primary-output output-geometry-alist)))) (defun exwm-randr--get-monitor-alias (primary-monitor monitor-geometry-alist) "Generate monitor aliases using PRIMARY-MONITOR MONITOR-GEOMETRY-ALIST. In a mirroring setup some monitors overlap and should be treated as one." (let (monitor-position-alist monitor-alias-alist monitor-name geometry) (setq monitor-position-alist (with-slots (x y) (cdr (assoc primary-monitor monitor-geometry-alist)) (list (cons primary-monitor (vector x y))))) (setq monitor-alias-alist (list (cons primary-monitor primary-monitor))) (dolist (pair monitor-geometry-alist) (setq monitor-name (car pair) geometry (cdr pair)) (unless (assoc monitor-name monitor-alias-alist) (let* ((position (vector (slot-value geometry 'x) (slot-value geometry 'y))) (alias (car (rassoc position monitor-position-alist)))) (if alias (setq monitor-alias-alist (cons (cons monitor-name alias) monitor-alias-alist)) (setq monitor-position-alist (cons (cons monitor-name position) monitor-position-alist) monitor-alias-alist (cons (cons monitor-name monitor-name) monitor-alias-alist)))))) monitor-alias-alist)) ;;;###autoload (defun exwm-randr-refresh () "Refresh workspaces according to the updated RandR info." (interactive) (exwm--log) (let* ((result (if exwm-randr--compatibility-mode (exwm-randr--get-outputs) (exwm-randr--get-monitors))) (primary-monitor (elt result 0)) (monitor-geometry-alist (elt result 1)) (monitor-alias-alist (elt result 2)) container-monitor-alist container-frame-alist) (when (and primary-monitor monitor-geometry-alist) (when exwm-workspace--fullscreen-frame-count ;; Not all workspaces are fullscreen; reset this counter. (setq exwm-workspace--fullscreen-frame-count 0)) (dotimes (i (exwm-workspace--count)) (let* ((monitor (plist-get exwm-randr-workspace-monitor-plist i)) (geometry (cdr (assoc monitor monitor-geometry-alist))) (frame (elt exwm-workspace--list i)) (container (frame-parameter frame 'exwm-container))) (if geometry ;; Unify monitor names in case it's a mirroring setup. (setq monitor (cdr (assoc monitor monitor-alias-alist))) ;; Missing monitors fallback to the primary one. (setq monitor primary-monitor geometry (cdr (assoc primary-monitor monitor-geometry-alist)))) (setq container-monitor-alist (nconc `((,container . ,(intern monitor))) container-monitor-alist) container-frame-alist (nconc `((,container . ,frame)) container-frame-alist)) (set-frame-parameter frame 'exwm-randr-monitor monitor) (set-frame-parameter frame 'exwm-geometry geometry))) ;; Update workareas. (exwm-workspace--update-workareas) ;; Resize workspace. (dolist (f exwm-workspace--list) (exwm-workspace--set-fullscreen f)) (xcb:flush exwm--connection) ;; Raise the minibuffer if it's active. (when (and (active-minibuffer-window) (exwm-workspace--minibuffer-own-frame-p)) (exwm-workspace--show-minibuffer)) ;; Set _NET_DESKTOP_GEOMETRY. (exwm-workspace--set-desktop-geometry) ;; Update active/inactive workspaces. (dolist (w exwm-workspace--list) (exwm-workspace--set-active w nil)) ;; Mark the workspace on the top of each monitor as active. (dolist (xwin (reverse (slot-value (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:QueryTree :window exwm--root)) 'children))) (let ((monitor (cdr (assq xwin container-monitor-alist)))) (when monitor (setq container-monitor-alist (rassq-delete-all monitor container-monitor-alist)) (exwm-workspace--set-active (cdr (assq xwin container-frame-alist)) t)))) (xcb:flush exwm--connection) (run-hooks 'exwm-randr-refresh-hook)))) (define-obsolete-function-alias 'exwm-randr--refresh #'exwm-randr-refresh "27.1") (defun exwm-randr--on-ScreenChangeNotify (data _synthetic) "Handle `ScreenChangeNotify' event. Run `exwm-randr-screen-change-hook' (usually user scripts to configure RandR)." (exwm--log) (let ((evt (make-instance 'xcb:randr:ScreenChangeNotify))) (xcb:unmarshal evt data) (let ((seqnum (slot-value evt '~sequence))) (unless (equal seqnum exwm-randr--prev-screen-change-seqnum) (setq exwm-randr--prev-screen-change-seqnum seqnum) (run-hooks 'exwm-randr-screen-change-hook))))) (defun exwm-randr--on-Notify (data _synthetic) "Handle `CrtcChangeNotify' and `OutputChangeNotify' events. Refresh when any CRTC/output changes." (exwm--log) (let ((evt (make-instance 'xcb:randr:Notify)) notify) (xcb:unmarshal evt data) (with-slots (subCode u) evt (cl-case subCode (xcb:randr:Notify:CrtcChange (setq notify (slot-value u 'cc))) (xcb:randr:Notify:OutputChange (setq notify (slot-value u 'oc)))) (when notify (with-slots (timestamp) notify (when (> timestamp exwm-randr--last-timestamp) (exwm-randr-refresh) (setq exwm-randr--last-timestamp timestamp))))))) (defun exwm-randr--on-ConfigureNotify (data _synthetic) "Handle `ConfigureNotify' event. Refresh when any RandR 1.5 monitor changes." (exwm--log) (let ((evt (make-instance 'xcb:ConfigureNotify))) (xcb:unmarshal evt data) (with-slots (window) evt (when (eq window exwm--root) (exwm-randr-refresh))))) (defun exwm-randr--init () "Initialize RandR extension and EXWM RandR module." (exwm--log) (when (= 0 (slot-value (xcb:get-extension-data exwm--connection 'xcb:randr) 'present)) (error "[EXWM] RandR extension is not supported by the server")) (with-slots (major-version minor-version) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:randr:QueryVersion :major-version 1 :minor-version 5)) (cond ((and (= major-version 1) (= minor-version 5)) (setq exwm-randr--compatibility-mode nil)) ((and (= major-version 1) (>= minor-version 2)) (setq exwm-randr--compatibility-mode t)) (t (error "[EXWM] The server only support RandR version up to %d.%d" major-version minor-version))) ;; External monitor(s) may already be connected. (run-hooks 'exwm-randr-screen-change-hook) (exwm-randr-refresh) ;; Listen for `ScreenChangeNotify' to notify external tools to ;; configure RandR and `CrtcChangeNotify/OutputChangeNotify' to ;; refresh the workspace layout. (xcb:+event exwm--connection 'xcb:randr:ScreenChangeNotify #'exwm-randr--on-ScreenChangeNotify) (xcb:+event exwm--connection 'xcb:randr:Notify #'exwm-randr--on-Notify) (xcb:+event exwm--connection 'xcb:ConfigureNotify #'exwm-randr--on-ConfigureNotify) (xcb:+request exwm--connection (make-instance 'xcb:randr:SelectInput :window exwm--root :enable (logior xcb:randr:NotifyMask:ScreenChange xcb:randr:NotifyMask:CrtcChange xcb:randr:NotifyMask:OutputChange))) (xcb:flush exwm--connection) (add-hook 'exwm-workspace-list-change-hook #'exwm-randr-refresh)) ;; Prevent frame parameters introduced by this module from being ;; saved/restored. (dolist (i '(exwm-randr-monitor)) (unless (assq i frameset-filter-alist) (push (cons i :never) frameset-filter-alist)))) (defun exwm-randr--exit () "Exit the RandR module." (exwm--log) (remove-hook 'exwm-workspace-list-change-hook #'exwm-randr-refresh)) (defun exwm-randr-enable () "Enable RandR support for EXWM." (exwm--log) (add-hook 'exwm-init-hook #'exwm-randr--init) (add-hook 'exwm-exit-hook #'exwm-randr--exit)) (provide 'exwm-randr) ;;; exwm-randr.el ends here exwm-0.26/exwm-systemtray.el000066400000000000000000000623441414260560000161540ustar00rootroot00000000000000;;; exwm-systemtray.el --- System Tray Module for -*- lexical-binding: t -*- ;;; EXWM ;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module adds system tray support for EXWM. ;; To use this module, load and enable it as follows: ;; (require 'exwm-systemtray) ;; (exwm-systemtray-enable) ;;; Code: (require 'xcb-icccm) (require 'xcb-xembed) (require 'xcb-systemtray) (require 'exwm-core) (require 'exwm-workspace) (defclass exwm-systemtray--icon () ((width :initarg :width) (height :initarg :height) (visible :initarg :visible)) :documentation "Attributes of a system tray icon.") (defclass xcb:systemtray:-ClientMessage (xcb:icccm:--ClientMessage xcb:ClientMessage) ((format :initform 32) (type :initform xcb:Atom:MANAGER) (time :initarg :time :type xcb:TIMESTAMP) ;new slot (selection :initarg :selection :type xcb:ATOM) ;new slot (owner :initarg :owner :type xcb:WINDOW)) ;new slot :documentation "A systemtray client message.") (defgroup exwm-systemtray nil "System tray." :version "25.3" :group 'exwm) (defcustom exwm-systemtray-height nil "System tray height. You shall use the default value if using auto-hide minibuffer." :type 'integer) (defcustom exwm-systemtray-icon-gap 2 "Gap between icons." :type 'integer) (defvar exwm-systemtray--embedder-window nil "The embedder window.") (defcustom exwm-systemtray-background-color nil "Background color of systemtray. This should be a color, or nil for transparent background." :type '(choice (const :tag "Transparent" nil) (color)) :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) ;; Change the background color for embedder. (when (and exwm--connection exwm-systemtray--embedder-window) (let ((background-pixel (exwm--color->pixel value))) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window exwm-systemtray--embedder-window :value-mask (logior xcb:CW:BackPixmap (if background-pixel xcb:CW:BackPixel 0)) :background-pixmap xcb:BackPixmap:ParentRelative :background-pixel background-pixel)) ;; Unmap & map to take effect immediately. (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window exwm-systemtray--embedder-window)) (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window exwm-systemtray--embedder-window)) (xcb:flush exwm--connection))))) ;; GTK icons require at least 16 pixels to show normally. (defconst exwm-systemtray--icon-min-size 16 "Minimum icon size.") (defvar exwm-systemtray--connection nil "The X connection.") (defvar exwm-systemtray--list nil "The icon list.") (defvar exwm-systemtray--selection-owner-window nil "The selection owner window.") (defvar xcb:Atom:_NET_SYSTEM_TRAY_S0) (defun exwm-systemtray--embed (icon) "Embed an icon." (exwm--log "Try to embed #x%x" icon) (let ((info (xcb:+request-unchecked+reply exwm-systemtray--connection (make-instance 'xcb:xembed:get-_XEMBED_INFO :window icon))) width* height* visible) (when info (exwm--log "Embed #x%x" icon) (with-slots (width height) (xcb:+request-unchecked+reply exwm-systemtray--connection (make-instance 'xcb:GetGeometry :drawable icon)) (setq height* exwm-systemtray-height width* (round (* width (/ (float height*) height)))) (when (< width* exwm-systemtray--icon-min-size) (setq width* exwm-systemtray--icon-min-size height* (round (* height (/ (float width*) width))))) (exwm--log "Resize from %dx%d to %dx%d" width height width* height*)) ;; Add this icon to save-set. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ChangeSaveSet :mode xcb:SetMode:Insert :window icon)) ;; Reparent to the embedder. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ReparentWindow :window icon :parent exwm-systemtray--embedder-window :x 0 ;; Vertically centered. :y (/ (- exwm-systemtray-height height*) 2))) ;; Resize the icon. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ConfigureWindow :window icon :value-mask (logior xcb:ConfigWindow:Width xcb:ConfigWindow:Height xcb:ConfigWindow:BorderWidth) :width width* :height height* :border-width 0)) ;; Set event mask. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ChangeWindowAttributes :window icon :value-mask xcb:CW:EventMask :event-mask (logior xcb:EventMask:ResizeRedirect xcb:EventMask:KeyPress xcb:EventMask:PropertyChange))) ;; Grab all keys and forward them to Emacs frame. (unless (exwm-workspace--minibuffer-own-frame-p) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:GrabKey :owner-events 0 :grab-window icon :modifiers xcb:ModMask:Any :key xcb:Grab:Any :pointer-mode xcb:GrabMode:Async :keyboard-mode xcb:GrabMode:Async))) (setq visible (slot-value info 'flags)) (if visible (setq visible (/= 0 (logand (slot-value info 'flags) xcb:xembed:MAPPED))) ;; Default to visible. (setq visible t)) (when visible (exwm--log "Map the window") (xcb:+request exwm-systemtray--connection (make-instance 'xcb:MapWindow :window icon))) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:xembed:SendEvent :destination icon :event (xcb:marshal (make-instance 'xcb:xembed:EMBEDDED-NOTIFY :window icon :time xcb:Time:CurrentTime :embedder exwm-systemtray--embedder-window :version 0) exwm-systemtray--connection))) (push `(,icon . ,(make-instance 'exwm-systemtray--icon :width width* :height height* :visible visible)) exwm-systemtray--list) (exwm-systemtray--refresh)))) (defun exwm-systemtray--unembed (icon) "Unembed an icon." (exwm--log "Unembed #x%x" icon) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:UnmapWindow :window icon)) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ReparentWindow :window icon :parent exwm--root :x 0 :y 0)) (setq exwm-systemtray--list (assq-delete-all icon exwm-systemtray--list)) (exwm-systemtray--refresh)) (defun exwm-systemtray--refresh () "Refresh the system tray." (exwm--log) ;; Make sure to redraw the embedder. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:UnmapWindow :window exwm-systemtray--embedder-window)) (let ((x exwm-systemtray-icon-gap) map) (dolist (pair exwm-systemtray--list) (when (slot-value (cdr pair) 'visible) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ConfigureWindow :window (car pair) :value-mask xcb:ConfigWindow:X :x x)) (setq x (+ x (slot-value (cdr pair) 'width) exwm-systemtray-icon-gap)) (setq map t))) (let ((workarea (elt exwm-workspace--workareas exwm-workspace-current-index))) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ConfigureWindow :window exwm-systemtray--embedder-window :value-mask (logior xcb:ConfigWindow:X xcb:ConfigWindow:Width) :x (- (aref workarea 2) x) :width x))) (when map (xcb:+request exwm-systemtray--connection (make-instance 'xcb:MapWindow :window exwm-systemtray--embedder-window)))) (xcb:flush exwm-systemtray--connection)) (defun exwm-systemtray--on-DestroyNotify (data _synthetic) "Unembed icons on DestroyNotify." (exwm--log) (let ((obj (make-instance 'xcb:DestroyNotify))) (xcb:unmarshal obj data) (with-slots (window) obj (when (assoc window exwm-systemtray--list) (exwm-systemtray--unembed window))))) (defun exwm-systemtray--on-ReparentNotify (data _synthetic) "Unembed icons on ReparentNotify." (exwm--log) (let ((obj (make-instance 'xcb:ReparentNotify))) (xcb:unmarshal obj data) (with-slots (window parent) obj (when (and (/= parent exwm-systemtray--embedder-window) (assoc window exwm-systemtray--list)) (exwm-systemtray--unembed window))))) (defun exwm-systemtray--on-ResizeRequest (data _synthetic) "Resize the tray icon on ResizeRequest." (exwm--log) (let ((obj (make-instance 'xcb:ResizeRequest)) attr) (xcb:unmarshal obj data) (with-slots (window width height) obj (when (setq attr (cdr (assoc window exwm-systemtray--list))) (with-slots ((width* width) (height* height)) attr (setq height* exwm-systemtray-height width* (round (* width (/ (float height*) height)))) (when (< width* exwm-systemtray--icon-min-size) (setq width* exwm-systemtray--icon-min-size height* (round (* height (/ (float width*) width))))) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ConfigureWindow :window window :value-mask (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Width xcb:ConfigWindow:Height) ;; Vertically centered. :y (/ (- exwm-systemtray-height height*) 2) :width width* :height height*))) (exwm-systemtray--refresh))))) (defun exwm-systemtray--on-PropertyNotify (data _synthetic) "Map/Unmap the tray icon on PropertyNotify." (exwm--log) (let ((obj (make-instance 'xcb:PropertyNotify)) attr info visible) (xcb:unmarshal obj data) (with-slots (window atom state) obj (when (and (eq state xcb:Property:NewValue) (eq atom xcb:Atom:_XEMBED_INFO) (setq attr (cdr (assoc window exwm-systemtray--list)))) (setq info (xcb:+request-unchecked+reply exwm-systemtray--connection (make-instance 'xcb:xembed:get-_XEMBED_INFO :window window))) (when info (setq visible (/= 0 (logand (slot-value info 'flags) xcb:xembed:MAPPED))) (exwm--log "#x%x visible? %s" window visible) (if visible (xcb:+request exwm-systemtray--connection (make-instance 'xcb:MapWindow :window window)) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:UnmapWindow :window window))) (setf (slot-value attr 'visible) visible) (exwm-systemtray--refresh)))))) (defun exwm-systemtray--on-ClientMessage (data _synthetic) "Handle client messages." (let ((obj (make-instance 'xcb:ClientMessage)) opcode data32) (xcb:unmarshal obj data) (with-slots (window type data) obj (when (eq type xcb:Atom:_NET_SYSTEM_TRAY_OPCODE) (setq data32 (slot-value data 'data32) opcode (elt data32 1)) (exwm--log "opcode: %s" opcode) (cond ((= opcode xcb:systemtray:opcode:REQUEST-DOCK) (unless (assoc (elt data32 2) exwm-systemtray--list) (exwm-systemtray--embed (elt data32 2)))) ;; Not implemented (rarely used nowadays). ((or (= opcode xcb:systemtray:opcode:BEGIN-MESSAGE) (= opcode xcb:systemtray:opcode:CANCEL-MESSAGE))) (t (exwm--log "Unknown opcode message: %s" obj))))))) (defun exwm-systemtray--on-KeyPress (data _synthetic) "Forward all KeyPress events to Emacs frame." (exwm--log) ;; This function is only executed when there's no autohide minibuffer, ;; a workspace frame has the input focus and the pointer is over a ;; tray icon. (let ((dest (frame-parameter (selected-frame) 'exwm-outer-id)) (obj (make-instance 'xcb:KeyPress))) (xcb:unmarshal obj data) (setf (slot-value obj 'event) dest) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:SendEvent :propagate 0 :destination dest :event-mask xcb:EventMask:NoEvent :event (xcb:marshal obj exwm-systemtray--connection)))) (xcb:flush exwm-systemtray--connection)) (defun exwm-systemtray--on-workspace-switch () "Reparent/Refresh the system tray in `exwm-workspace-switch-hook'." (exwm--log) (unless (exwm-workspace--minibuffer-own-frame-p) (exwm-workspace--update-offsets) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ReparentWindow :window exwm-systemtray--embedder-window :parent (string-to-number (frame-parameter exwm-workspace--current 'window-id)) :x 0 :y (- (elt (elt exwm-workspace--workareas exwm-workspace-current-index) 3) exwm-workspace--frame-y-offset exwm-systemtray-height)))) (exwm-systemtray--refresh)) (defun exwm-systemtray--refresh-all () "Reposition/Refresh the system tray." (exwm--log) (unless (exwm-workspace--minibuffer-own-frame-p) (exwm-workspace--update-offsets) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ConfigureWindow :window exwm-systemtray--embedder-window :value-mask xcb:ConfigWindow:Y :y (- (elt (elt exwm-workspace--workareas exwm-workspace-current-index) 3) exwm-workspace--frame-y-offset exwm-systemtray-height)))) (exwm-systemtray--refresh)) (cl-defun exwm-systemtray--init () "Initialize system tray module." (exwm--log) (cl-assert (not exwm-systemtray--connection)) (cl-assert (not exwm-systemtray--list)) (cl-assert (not exwm-systemtray--selection-owner-window)) (cl-assert (not exwm-systemtray--embedder-window)) (unless exwm-systemtray-height (setq exwm-systemtray-height (max exwm-systemtray--icon-min-size (line-pixel-height)))) ;; Create a new connection. (setq exwm-systemtray--connection (xcb:connect)) (set-process-query-on-exit-flag (slot-value exwm-systemtray--connection 'process) nil) ;; Initialize XELB modules. (xcb:xembed:init exwm-systemtray--connection t) (xcb:systemtray:init exwm-systemtray--connection t) ;; Acquire the manager selection _NET_SYSTEM_TRAY_S0. (with-slots (owner) (xcb:+request-unchecked+reply exwm-systemtray--connection (make-instance 'xcb:GetSelectionOwner :selection xcb:Atom:_NET_SYSTEM_TRAY_S0)) (when (/= owner xcb:Window:None) (xcb:disconnect exwm-systemtray--connection) (setq exwm-systemtray--connection nil) (warn "[EXWM] Other system tray detected") (cl-return-from exwm-systemtray--init))) (let ((id (xcb:generate-id exwm-systemtray--connection))) (setq exwm-systemtray--selection-owner-window id) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:CreateWindow :depth 0 :wid id :parent exwm--root :x 0 :y 0 :width 1 :height 1 :border-width 0 :class xcb:WindowClass:InputOnly :visual 0 :value-mask xcb:CW:OverrideRedirect :override-redirect 1)) ;; Get the selection ownership. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:SetSelectionOwner :owner id :selection xcb:Atom:_NET_SYSTEM_TRAY_S0 :time xcb:Time:CurrentTime)) ;; Send a client message to announce the selection. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:SendEvent :propagate 0 :destination exwm--root :event-mask xcb:EventMask:StructureNotify :event (xcb:marshal (make-instance 'xcb:systemtray:-ClientMessage :window exwm--root :time xcb:Time:CurrentTime :selection xcb:Atom:_NET_SYSTEM_TRAY_S0 :owner id) exwm-systemtray--connection))) ;; Set _NET_WM_NAME. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window id :data "EXWM: exwm-systemtray--selection-owner-window")) ;; Set the _NET_SYSTEM_TRAY_ORIENTATION property. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:xembed:set-_NET_SYSTEM_TRAY_ORIENTATION :window id :data xcb:systemtray:ORIENTATION:HORZ))) ;; Create the embedder. (let ((id (xcb:generate-id exwm-systemtray--connection)) (background-pixel (exwm--color->pixel exwm-systemtray-background-color)) frame parent depth y) (setq exwm-systemtray--embedder-window id) (if (exwm-workspace--minibuffer-own-frame-p) (setq frame exwm-workspace--minibuffer y (if (>= (line-pixel-height) exwm-systemtray-height) ;; Bottom aligned. (- (line-pixel-height) exwm-systemtray-height) ;; Vertically centered. (/ (- (line-pixel-height) exwm-systemtray-height) 2))) (exwm-workspace--update-offsets) (setq frame exwm-workspace--current ;; Bottom aligned. y (- (elt (elt exwm-workspace--workareas exwm-workspace-current-index) 3) exwm-workspace--frame-y-offset exwm-systemtray-height))) (setq parent (string-to-number (frame-parameter frame 'window-id)) depth (slot-value (xcb:+request-unchecked+reply exwm-systemtray--connection (make-instance 'xcb:GetGeometry :drawable parent)) 'depth)) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:CreateWindow :depth depth :wid id :parent parent :x 0 :y y :width 1 :height exwm-systemtray-height :border-width 0 :class xcb:WindowClass:InputOutput :visual 0 :value-mask (logior xcb:CW:BackPixmap (if background-pixel xcb:CW:BackPixel 0) xcb:CW:EventMask) :background-pixmap xcb:BackPixmap:ParentRelative :background-pixel background-pixel :event-mask xcb:EventMask:SubstructureNotify)) ;; Set _NET_WM_NAME. (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window id :data "EXWM: exwm-systemtray--embedder-window"))) (xcb:flush exwm-systemtray--connection) ;; Attach event listeners. (xcb:+event exwm-systemtray--connection 'xcb:DestroyNotify #'exwm-systemtray--on-DestroyNotify) (xcb:+event exwm-systemtray--connection 'xcb:ReparentNotify #'exwm-systemtray--on-ReparentNotify) (xcb:+event exwm-systemtray--connection 'xcb:ResizeRequest #'exwm-systemtray--on-ResizeRequest) (xcb:+event exwm-systemtray--connection 'xcb:PropertyNotify #'exwm-systemtray--on-PropertyNotify) (xcb:+event exwm-systemtray--connection 'xcb:ClientMessage #'exwm-systemtray--on-ClientMessage) (unless (exwm-workspace--minibuffer-own-frame-p) (xcb:+event exwm-systemtray--connection 'xcb:KeyPress #'exwm-systemtray--on-KeyPress)) ;; Add hook to move/reparent the embedder. (add-hook 'exwm-workspace-switch-hook #'exwm-systemtray--on-workspace-switch) (add-hook 'exwm-workspace--update-workareas-hook #'exwm-systemtray--refresh-all) (add-hook 'menu-bar-mode-hook #'exwm-systemtray--refresh-all) (add-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all) (when (boundp 'exwm-randr-refresh-hook) (add-hook 'exwm-randr-refresh-hook #'exwm-systemtray--refresh-all)) ;; The struts can be updated already. (when exwm-workspace--workareas (exwm-systemtray--refresh-all))) (defun exwm-systemtray--exit () "Exit the systemtray module." (exwm--log) (when exwm-systemtray--connection ;; Hide & reparent out the embedder before disconnection to prevent ;; embedded icons from being reparented to an Emacs frame (which is the ;; parent of the embedder). (xcb:+request exwm-systemtray--connection (make-instance 'xcb:UnmapWindow :window exwm-systemtray--embedder-window)) (xcb:+request exwm-systemtray--connection (make-instance 'xcb:ReparentWindow :window exwm-systemtray--embedder-window :parent exwm--root :x 0 :y 0)) (xcb:disconnect exwm-systemtray--connection) (setq exwm-systemtray--connection nil exwm-systemtray--list nil exwm-systemtray--selection-owner-window nil exwm-systemtray--embedder-window nil) (remove-hook 'exwm-workspace-switch-hook #'exwm-systemtray--on-workspace-switch) (remove-hook 'exwm-workspace--update-workareas-hook #'exwm-systemtray--refresh-all) (remove-hook 'menu-bar-mode-hook #'exwm-systemtray--refresh-all) (remove-hook 'tool-bar-mode-hook #'exwm-systemtray--refresh-all) (when (boundp 'exwm-randr-refresh-hook) (remove-hook 'exwm-randr-refresh-hook #'exwm-systemtray--refresh-all)))) (defun exwm-systemtray-enable () "Enable system tray support for EXWM." (exwm--log) (add-hook 'exwm-init-hook #'exwm-systemtray--init) (add-hook 'exwm-exit-hook #'exwm-systemtray--exit)) (provide 'exwm-systemtray) ;;; exwm-systemtray.el ends here exwm-0.26/exwm-workspace.el000066400000000000000000002313661414260560000157300ustar00rootroot00000000000000;;; exwm-workspace.el --- Workspace Module for EXWM -*- lexical-binding: t -*- ;; Copyright (C) 1015-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module adds workspace support for EXWM. ;;; Code: (require 'server) (require 'exwm-core) (defgroup exwm-workspace nil "Workspace." :version "25.3" :group 'exwm) (defcustom exwm-workspace-switch-hook nil "Normal hook run after switching workspace." :type 'hook) (defcustom exwm-workspace-list-change-hook nil "Normal hook run when the workspace list is changed (workspace added, deleted, moved, etc)." :type 'hook) (defcustom exwm-workspace-show-all-buffers nil "Non-nil to show buffers on other workspaces." :type 'boolean) (defcustom exwm-workspace-warp-cursor nil "Non-nil to warp cursor automatically after workspace switch." :type 'boolean) (defcustom exwm-workspace-number 1 "Initial number of workspaces." :type 'integer) (defcustom exwm-workspace-index-map #'number-to-string "Function for mapping a workspace index to a string for display. By default `number-to-string' is applied which yields 0 1 2 ... ." :type 'function) (defcustom exwm-workspace-minibuffer-position nil "Position of the minibuffer frame. A restart is required for this change to take effect." :type '(choice (const :tag "Bottom (fixed)" nil) (const :tag "Bottom (auto-hide)" bottom) (const :tag "Top (auto-hide)" top))) (defcustom exwm-workspace-display-echo-area-timeout 1 "Timeout for displaying echo area." :type 'integer) (defcustom exwm-workspace-switch-create-limit 10 "Number of workspaces `exwm-workspace-switch-create' allowed to create each time." :type 'integer) (defvar exwm-workspace-current-index 0 "Index of current active workspace.") (defvar exwm-workspace--attached-minibuffer-height 0 "Height (in pixel) of the attached minibuffer. If the minibuffer is detached, this value is 0.") (defvar exwm-workspace--client nil "The 'client' frame parameter of emacsclient frames.") (defvar exwm-workspace--create-silently nil "When non-nil workspaces are created in the background (not switched to). Please manually run the hook `exwm-workspace-list-change-hook' afterwards.") (defvar exwm-workspace--current nil "Current active workspace.") (defvar exwm-workspace--display-echo-area-timer nil "Timer for auto-hiding echo area.") (defvar exwm-workspace--id-struts-alist nil "Alist of X window and struts.") (defvar exwm-workspace--fullscreen-frame-count 0 "Count the fullscreen workspace frames.") (defvar exwm-workspace--list nil "List of all workspaces (Emacs frames).") (defvar exwm-workspace--minibuffer nil "The minibuffer frame shared among all frames.") (defvar exwm-workspace--original-handle-focus-in (symbol-function #'handle-focus-in)) (defvar exwm-workspace--original-handle-focus-out (symbol-function #'handle-focus-out)) (defvar exwm-workspace--prompt-add-allowed nil "Non-nil to allow adding workspace from the prompt.") (defvar exwm-workspace--prompt-delete-allowed nil "Non-nil to allow deleting workspace from the prompt.") (defvar exwm-workspace--struts nil "Areas occupied by struts.") (defvar exwm-workspace--switch-history nil "History for `read-from-minibuffer' to interactively switch workspace.") (defvar exwm-workspace--switch-history-outdated nil "Non-nil to indicate `exwm-workspace--switch-history' is outdated.") (defvar exwm-workspace--timer nil "Timer used to track echo area changes.") (defvar exwm-workspace--update-workareas-hook nil "Normal hook run when workareas get updated.") (defvar exwm-workspace--workareas nil "Workareas (struts excluded).") (defvar exwm-workspace--frame-y-offset 0 "Offset between Emacs inner & outer frame in Y.") (defvar exwm-workspace--window-y-offset 0 "Offset between Emacs first window & outer frame in Y.") (defvar exwm-input--during-command) (defvar exwm-input--event-hook) (defvar exwm-layout-show-all-buffers) (defvar exwm-manage--desktop) (declare-function exwm-input--on-buffer-list-update "exwm-input.el" ()) (declare-function exwm-layout--fullscreen-p "exwm-layout.el" ()) (declare-function exwm-layout--hide "exwm-layout.el" (id)) (declare-function exwm-layout--other-buffer-predicate "exwm-layout.el" (buffer)) (declare-function exwm-layout--refresh "exwm-layout.el") (declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) (defsubst exwm-workspace--position (frame) "Retrieve index of given FRAME in workspace list. NIL if FRAME is not a workspace" (cl-position frame exwm-workspace--list)) (defsubst exwm-workspace--count () "Retrieve total number of workspaces." (length exwm-workspace--list)) (defsubst exwm-workspace--workspace-p (frame) "Return t if FRAME is a workspace." (memq frame exwm-workspace--list)) (defvar exwm-workspace--client-p-hash-table (make-hash-table :test 'eq :weakness 'key) "Used to cache the results of calling ‘exwm-workspace--client-p’.") (defsubst exwm-workspace--client-p (&optional frame) "Return non-nil if FRAME is an emacsclient frame." (let* ((frame (or frame (selected-frame))) (cached-value (gethash frame exwm-workspace--client-p-hash-table 'absent))) (if (eq cached-value 'absent) (puthash frame (or (frame-parameter frame 'client) (not (display-graphic-p frame))) exwm-workspace--client-p-hash-table) cached-value))) (defvar exwm-workspace--switch-map nil "Keymap used for interactively selecting workspace.") (defun exwm-workspace--init-switch-map () (let ((map (make-sparse-keymap))) (define-key map [t] (lambda () (interactive))) (define-key map "+" #'exwm-workspace--prompt-add) (define-key map "-" #'exwm-workspace--prompt-delete) (dotimes (i 10) (define-key map (int-to-string i) #'exwm-workspace--switch-map-nth-prefix)) (unless (eq exwm-workspace-index-map #'number-to-string) ;; Add extra (and possibly override) keys for selecting workspace. (dotimes (i 10) (let ((key (funcall exwm-workspace-index-map i))) (when (and (stringp key) (= (length key) 1) (<= 0 (elt key 0) 127)) (define-key map key (lambda () (interactive) (exwm-workspace--switch-map-select-nth i))))))) (define-key map "\C-a" (lambda () (interactive) (goto-history-element 1))) (define-key map "\C-e" (lambda () (interactive) (goto-history-element (exwm-workspace--count)))) (define-key map "\C-g" #'abort-recursive-edit) (define-key map "\C-]" #'abort-recursive-edit) (define-key map "\C-j" #'exit-minibuffer) ;; (define-key map "\C-m" #'exit-minibuffer) ;not working (define-key map [return] #'exit-minibuffer) (define-key map " " #'exit-minibuffer) (define-key map "\C-f" #'previous-history-element) (define-key map "\C-b" #'next-history-element) ;; Alternative keys (define-key map [right] #'previous-history-element) (define-key map [left] #'next-history-element) (setq exwm-workspace--switch-map map))) (defun exwm-workspace--workspace-from-frame-or-index (frame-or-index) "Retrieve the workspace frame from FRAME-OR-INDEX." (cond ((framep frame-or-index) (unless (exwm-workspace--position frame-or-index) (user-error "[EXWM] Frame is not a workspace %S" frame-or-index)) frame-or-index) ((integerp frame-or-index) (unless (and (<= 0 frame-or-index) (< frame-or-index (exwm-workspace--count))) (user-error "[EXWM] Workspace index out of range: %d" frame-or-index)) (elt exwm-workspace--list frame-or-index)) (t (user-error "[EXWM] Invalid workspace: %s" frame-or-index)))) (defun exwm-workspace--prompt-for-workspace (&optional prompt) "Prompt for a workspace, returning the workspace frame." (exwm-workspace--update-switch-history) (let* ((current-idx (exwm-workspace--position exwm-workspace--current)) (history-add-new-input nil) ;prevent modifying history (history-idx (read-from-minibuffer (or prompt "Workspace: ") (elt exwm-workspace--switch-history current-idx) exwm-workspace--switch-map nil `(exwm-workspace--switch-history . ,(1+ current-idx)))) (workspace-idx (cl-position history-idx exwm-workspace--switch-history :test #'equal))) (elt exwm-workspace--list workspace-idx))) (defun exwm-workspace--prompt-add () "Add workspace from the prompt." (interactive) (when exwm-workspace--prompt-add-allowed (let ((exwm-workspace--create-silently t)) (make-frame) (run-hooks 'exwm-workspace-list-change-hook)) (exwm-workspace--update-switch-history) (goto-history-element minibuffer-history-position))) (defun exwm-workspace--prompt-delete () "Delete workspace from the prompt." (interactive) (when (and exwm-workspace--prompt-delete-allowed (< 1 (exwm-workspace--count))) (let ((frame (elt exwm-workspace--list (1- minibuffer-history-position)))) (exwm-workspace--get-remove-frame-next-workspace frame) (if (eq frame exwm-workspace--current) ;; Abort the recursive minibuffer if deleting the current workspace. (progn (exwm--defer 0 #'delete-frame frame) (abort-recursive-edit)) (delete-frame frame) (exwm-workspace--update-switch-history) (goto-history-element (min minibuffer-history-position (exwm-workspace--count))))))) (defun exwm-workspace--update-switch-history () "Update the history for switching workspace to reflect the latest status." (when exwm-workspace--switch-history-outdated (setq exwm-workspace--switch-history-outdated nil) (let* ((num (exwm-workspace--count)) (sequence (number-sequence 0 (1- num))) (not-empty (make-vector num nil))) (dolist (i exwm--id-buffer-alist) (with-current-buffer (cdr i) (when exwm--frame (setf (aref not-empty (exwm-workspace--position exwm--frame)) t)))) (setq exwm-workspace--switch-history (mapcar (lambda (i) (mapconcat (lambda (j) (format (if (= i j) "[%s]" " %s ") (propertize (apply exwm-workspace-index-map (list j)) 'face (cond ((frame-parameter (elt exwm-workspace--list j) 'exwm-urgency) '(:foreground "orange")) ((aref not-empty j) '(:foreground "green")) (t nil))))) sequence "")) sequence))))) ;;;###autoload (defun exwm-workspace--get-geometry (frame) "Return the geometry of frame FRAME." (or (frame-parameter frame 'exwm-geometry) (make-instance 'xcb:RECTANGLE :x 0 :y 0 :width (x-display-pixel-width) :height (x-display-pixel-height)))) ;;;###autoload (defun exwm-workspace--current-height () "Return the height of current workspace." (let ((geometry (frame-parameter exwm-workspace--current 'exwm-geometry))) (if geometry (slot-value geometry 'height) (x-display-pixel-height)))) ;;;###autoload (defun exwm-workspace--minibuffer-own-frame-p () "Reports whether the minibuffer is displayed in its own frame." (memq exwm-workspace-minibuffer-position '(top bottom))) (defun exwm-workspace--update-struts () "Update `exwm-workspace--struts'." (setq exwm-workspace--struts nil) (let (struts struts*) (dolist (pair exwm-workspace--id-struts-alist) (setq struts (cdr pair)) (when struts (dotimes (i 4) (when (/= 0 (aref struts i)) (setq struts* (vector (aref [left right top bottom] i) (aref struts i) (when (= 12 (length struts)) (substring struts (+ 4 (* i 2)) (+ 6 (* i 2)))))) (if (= 0 (mod i 2)) ;; Make left/top processed first. (push struts* exwm-workspace--struts) (setq exwm-workspace--struts (append exwm-workspace--struts (list struts*)))))))) (exwm--log "%s" exwm-workspace--struts))) (defun exwm-workspace--update-workareas () "Update `exwm-workspace--workareas'." (let ((root-width (x-display-pixel-width)) (root-height (x-display-pixel-height)) workareas edge width position delta) ;; Calculate workareas with no struts. (if (frame-parameter (car exwm-workspace--list) 'exwm-geometry) ;; Use the 'exwm-geometry' frame parameter if possible. (dolist (f exwm-workspace--list) (with-slots (x y width height) (frame-parameter f 'exwm-geometry) (setq workareas (append workareas (list (vector x y width height)))))) ;; Fall back to use the screen size. (let ((workarea (vector 0 0 root-width root-height))) (setq workareas (make-list (exwm-workspace--count) workarea)))) ;; Exclude areas occupied by struts. (dolist (struts exwm-workspace--struts) (setq edge (aref struts 0) width (aref struts 1) position (aref struts 2)) (dolist (w workareas) (pcase edge ;; Left and top are always processed first. (`left (setq delta (- (aref w 0) width)) (when (and (< delta 0) (or (not position) (< (max (aref position 0) (aref w 1)) (min (aref position 1) (+ (aref w 1) (aref w 3)))))) (cl-incf (aref w 2) delta) (setf (aref w 0) width))) (`right (setq delta (- root-width (aref w 0) (aref w 2) width)) (when (and (< delta 0) (or (not position) (< (max (aref position 0) (aref w 1)) (min (aref position 1) (+ (aref w 1) (aref w 3)))))) (cl-incf (aref w 2) delta))) (`top (setq delta (- (aref w 1) width)) (when (and (< delta 0) (or (not position) (< (max (aref position 0) (aref w 0)) (min (aref position 1) (+ (aref w 0) (aref w 2)))))) (cl-incf (aref w 3) delta) (setf (aref w 1) width))) (`bottom (setq delta (- root-height (aref w 1) (aref w 3) width)) (when (and (< delta 0) (or (not position) (< (max (aref position 0) (aref w 0)) (min (aref position 1) (+ (aref w 0) (aref w 2)))))) (cl-incf (aref w 3) delta)))))) ;; Save the result. (setq exwm-workspace--workareas workareas) (xcb:flush exwm--connection)) (exwm--log "%s" exwm-workspace--workareas) (run-hooks 'exwm-workspace--update-workareas-hook)) (defun exwm-workspace--update-offsets () "Update `exwm-workspace--frame-y-offset'/`exwm-workspace--window-y-offset'." (exwm--log) (if (not (and exwm-workspace--list (or menu-bar-mode tool-bar-mode))) (setq exwm-workspace--frame-y-offset 0 exwm-workspace--window-y-offset 0) (redisplay t) (let* ((frame (elt exwm-workspace--list 0)) (edges (window-inside-absolute-pixel-edges (frame-first-window frame)))) (with-slots (y) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable (frame-parameter frame 'exwm-container))) (with-slots ((y* y)) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable (frame-parameter frame 'exwm-outer-id))) (with-slots ((y** y)) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable (frame-parameter frame 'exwm-id))) (setq exwm-workspace--frame-y-offset (- y** y*) exwm-workspace--window-y-offset (- (elt edges 1) y)))))))) (defun exwm-workspace--set-active (frame active) "Make frame FRAME active on its monitor." (exwm--log "active=%s; frame=%s" frame active) (set-frame-parameter frame 'exwm-active active) (if active (exwm-workspace--set-fullscreen frame) (exwm--set-geometry (frame-parameter frame 'exwm-container) nil nil 1 1)) (exwm-layout--refresh frame) (xcb:flush exwm--connection)) (defun exwm-workspace--active-p (frame) "Return non-nil if FRAME is active" (frame-parameter frame 'exwm-active)) (defun exwm-workspace--set-fullscreen (frame) "Make frame FRAME fullscreen according to `exwm-workspace--workareas'." (exwm--log "frame=%s" frame) (let ((workarea (elt exwm-workspace--workareas (exwm-workspace--position frame))) (id (frame-parameter frame 'exwm-outer-id)) (container (frame-parameter frame 'exwm-container)) x y width height) (setq x (aref workarea 0) y (aref workarea 1) width (aref workarea 2) height (aref workarea 3)) (exwm--log "x=%s; y=%s; w=%s; h=%s" x y width height) (when (and (eq frame exwm-workspace--current) (exwm-workspace--minibuffer-own-frame-p)) (exwm-workspace--resize-minibuffer-frame)) (if (exwm-workspace--active-p frame) (exwm--set-geometry container x y width height) (exwm--set-geometry container x y 1 1)) (exwm--set-geometry id nil nil width height) (xcb:flush exwm--connection)) ;; This is only used for workspace initialization. (when exwm-workspace--fullscreen-frame-count (cl-incf exwm-workspace--fullscreen-frame-count))) (defun exwm-workspace--resize-minibuffer-frame () "Resize minibuffer (and its container) to fit the size of workspace." (cl-assert (exwm-workspace--minibuffer-own-frame-p)) (let ((workarea (elt exwm-workspace--workareas exwm-workspace-current-index)) (container (frame-parameter exwm-workspace--minibuffer 'exwm-container)) y width) (setq y (if (eq exwm-workspace-minibuffer-position 'top) (- (aref workarea 1) exwm-workspace--attached-minibuffer-height) ;; Reset the frame size. (set-frame-height exwm-workspace--minibuffer 1) (redisplay) ;FIXME. (+ (aref workarea 1) (aref workarea 3) (- (frame-pixel-height exwm-workspace--minibuffer)) exwm-workspace--attached-minibuffer-height)) width (aref workarea 2)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window container :value-mask (logior xcb:ConfigWindow:X xcb:ConfigWindow:Y xcb:ConfigWindow:Width (if exwm-manage--desktop xcb:ConfigWindow:Sibling 0) xcb:ConfigWindow:StackMode) :x (aref workarea 0) :y y :width width :sibling exwm-manage--desktop :stack-mode (if exwm-manage--desktop xcb:StackMode:Above xcb:StackMode:Below))) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id) :value-mask xcb:ConfigWindow:Width :width width)) (exwm--log "y: %s, width: %s" y width))) (defun exwm-workspace--switch-map-nth-prefix (&optional prefix-digits) "Allow selecting a workspace by number. PREFIX-DIGITS is a list of the digits introduced so far." (interactive) (let* ((k (aref (substring (this-command-keys-vector) -1) 0)) (d (- k ?0)) ;; Convert prefix-digits to number. For example, '(2 1) to 120. (o 1) (pn (apply #'+ (mapcar (lambda (x) (setq o (* 10 o)) (* o x)) prefix-digits))) (n (+ pn d)) prefix-length index-max index-length) (if (or (= n 0) (> n (setq index-max (1- (exwm-workspace--count)))) (>= (setq prefix-length (length prefix-digits)) (setq index-length (floor (log index-max 10)))) ;; Check if it's still possible to do a match. (> (* n (expt 10 (- index-length prefix-length))) index-max)) (exwm-workspace--switch-map-select-nth n) ;; Go ahead if there are enough digits to select any workspace. (set-transient-map (let ((map (make-sparse-keymap)) (cmd (let ((digits (cons d prefix-digits))) (lambda () (interactive) (exwm-workspace--switch-map-nth-prefix digits))))) (dotimes (i 10) (define-key map (int-to-string i) cmd)) ;; Accept (define-key map [return] (lambda () (interactive) (exwm-workspace--switch-map-select-nth n))) map))))) (defun exwm-workspace--switch-map-select-nth (n) "Select Nth workspace." (interactive) (goto-history-element (1+ n)) (exit-minibuffer)) ;;;###autoload (defun exwm-workspace-switch (frame-or-index &optional force) "Switch to workspace INDEX (0-based). Query for the index if not specified when called interactively. Passing a workspace frame as the first option or making use of the rest options are for internal use only." (interactive (list (cond ((null current-prefix-arg) (unless (and (derived-mode-p 'exwm-mode) ;; The prompt is invisible in fullscreen mode. (exwm-layout--fullscreen-p)) (let ((exwm-workspace--prompt-add-allowed t) (exwm-workspace--prompt-delete-allowed t)) (exwm-workspace--prompt-for-workspace "Switch to [+/-]: ")))) ((and (integerp current-prefix-arg) (<= 0 current-prefix-arg (exwm-workspace--count))) current-prefix-arg) (t 0)))) (exwm--log) (let* ((frame (exwm-workspace--workspace-from-frame-or-index frame-or-index)) (old-frame exwm-workspace--current) (index (exwm-workspace--position frame)) (window (frame-parameter frame 'exwm-selected-window))) (when (or force (not (eq frame exwm-workspace--current))) (unless (window-live-p window) (setq window (frame-selected-window frame))) (when (and (not (eq frame old-frame)) (frame-live-p old-frame)) (with-selected-frame old-frame (funcall exwm-workspace--original-handle-focus-out (list 'focus-out frame)))) ;; Raise this frame. (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter frame 'exwm-container) :value-mask (logior xcb:ConfigWindow:Sibling xcb:ConfigWindow:StackMode) :sibling exwm--guide-window :stack-mode xcb:StackMode:Below)) (setq exwm-workspace--current frame exwm-workspace-current-index index) (unless (exwm-workspace--workspace-p (selected-frame)) ;; Save the floating frame window selected on the previous workspace. (set-frame-parameter (buffer-local-value 'exwm--frame (window-buffer)) 'exwm-selected-window (selected-window))) ;; Show/Hide X windows. (let ((monitor-old (frame-parameter old-frame 'exwm-randr-monitor)) (monitor-new (frame-parameter frame 'exwm-randr-monitor)) (active-old (exwm-workspace--active-p old-frame)) (active-new (exwm-workspace--active-p frame)) workspaces-to-hide) (cond ((not active-old) (exwm-workspace--set-active frame t)) ((equal monitor-old monitor-new) (exwm-workspace--set-active frame t) (unless (eq frame old-frame) (exwm-workspace--set-active old-frame nil) (setq workspaces-to-hide (list old-frame)))) (active-new) (t (dolist (w exwm-workspace--list) (when (and (exwm-workspace--active-p w) (equal monitor-new (frame-parameter w 'exwm-randr-monitor))) (exwm-workspace--set-active w nil) (setq workspaces-to-hide (append workspaces-to-hide (list w))))) (exwm-workspace--set-active frame t))) (dolist (i exwm--id-buffer-alist) (with-current-buffer (cdr i) (if (memq exwm--frame workspaces-to-hide) (exwm-layout--hide exwm--id) (when (eq frame exwm--frame) (let ((window (get-buffer-window nil t))) (when window (exwm-layout--show exwm--id window)))))))) (select-window window) (x-focus-frame (window-frame window)) ;The real input focus. (set-frame-parameter frame 'exwm-selected-window nil) (if (exwm-workspace--minibuffer-own-frame-p) ;; Resize the minibuffer frame. (exwm-workspace--resize-minibuffer-frame) ;; Set a default minibuffer frame. (setq default-minibuffer-frame frame)) ;; Hide windows in other workspaces by preprending a space (unless exwm-workspace-show-all-buffers (dolist (i exwm--id-buffer-alist) (with-current-buffer (cdr i) (let ((name (replace-regexp-in-string "^\\s-*" "" (buffer-name)))) (exwm-workspace-rename-buffer (if (eq frame exwm--frame) name (concat " " name))))))) ;; Update demands attention flag (set-frame-parameter frame 'exwm-urgency nil) ;; Update switch workspace history (setq exwm-workspace--switch-history-outdated t) ;; Set _NET_CURRENT_DESKTOP (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_CURRENT_DESKTOP :window exwm--root :data index)) (xcb:flush exwm--connection)) (when exwm-workspace-warp-cursor (with-slots (win-x win-y) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:QueryPointer :window (frame-parameter frame 'exwm-outer-id))) (when (or (< win-x 0) (< win-y 0) (> win-x (frame-pixel-width frame)) (> win-y (frame-pixel-height frame))) (xcb:+request exwm--connection (make-instance 'xcb:WarpPointer :src-window xcb:Window:None :dst-window (frame-parameter frame 'exwm-outer-id) :src-x 0 :src-y 0 :src-width 0 :src-height 0 :dst-x (/ (frame-pixel-width frame) 2) :dst-y (/ (frame-pixel-height frame) 2))) (xcb:flush exwm--connection)))) (funcall exwm-workspace--original-handle-focus-in (list 'focus-in frame)) (run-hooks 'exwm-workspace-switch-hook))) ;;;###autoload (defun exwm-workspace-switch-create (frame-or-index) "Switch to workspace INDEX or creating it first if it does not exist yet. Passing a workspace frame as the first option is for internal use only." (interactive (list (cond ((integerp current-prefix-arg) current-prefix-arg) (t 0)))) (unless frame-or-index (setq frame-or-index 0)) (exwm--log "%s" frame-or-index) (if (or (framep frame-or-index) (< frame-or-index (exwm-workspace--count))) (exwm-workspace-switch frame-or-index) (let ((exwm-workspace--create-silently t)) (dotimes (_ (min exwm-workspace-switch-create-limit (1+ (- frame-or-index (exwm-workspace--count))))) (make-frame)) (run-hooks 'exwm-workspace-list-change-hook)) (exwm-workspace-switch frame-or-index))) ;;;###autoload (defun exwm-workspace-swap (workspace1 workspace2) "Interchange position of WORKSPACE1 with that of WORKSPACE2." (interactive (unless (and (derived-mode-p 'exwm-mode) ;; The prompt is invisible in fullscreen mode. (exwm-layout--fullscreen-p)) (let (w1 w2) (let ((exwm-workspace--prompt-add-allowed t) (exwm-workspace--prompt-delete-allowed t)) (setq w1 (exwm-workspace--prompt-for-workspace "Pick a workspace [+/-]: "))) (setq w2 (exwm-workspace--prompt-for-workspace (format "Swap workspace %d with: " (exwm-workspace--position w1)))) (list w1 w2)))) (exwm--log) (let ((pos1 (exwm-workspace--position workspace1)) (pos2 (exwm-workspace--position workspace2))) (if (or (not pos1) (not pos2) (= pos1 pos2)) (user-error "[EXWM] Cannot swap %s and %s" workspace1 workspace2) (setf (elt exwm-workspace--list pos1) workspace2) (setf (elt exwm-workspace--list pos2) workspace1) ;; Update the _NET_WM_DESKTOP property of each X window affected. (dolist (pair exwm--id-buffer-alist) (when (memq (buffer-local-value 'exwm--frame (cdr pair)) (list workspace1 workspace2)) (exwm-workspace--set-desktop (car pair)))) (xcb:flush exwm--connection) (when (memq exwm-workspace--current (list workspace1 workspace2)) ;; With the current workspace involved, lots of stuffs need refresh. (set-frame-parameter exwm-workspace--current 'exwm-selected-window (selected-window)) (exwm-workspace-switch exwm-workspace--current t)) (run-hooks 'exwm-workspace-list-change-hook)))) ;;;###autoload (defun exwm-workspace-move (workspace nth) "Move WORKSPACE to the NTH position. When called interactively, prompt for a workspace and move current one just before it." (interactive (cond ((null current-prefix-arg) (unless (and (derived-mode-p 'exwm-mode) ;; The prompt is invisible in fullscreen mode. (exwm-layout--fullscreen-p)) (list exwm-workspace--current (exwm-workspace--position (exwm-workspace--prompt-for-workspace "Move workspace to: "))))) ((and (integerp current-prefix-arg) (<= 0 current-prefix-arg (exwm-workspace--count))) (list exwm-workspace--current current-prefix-arg)) (t (list exwm-workspace--current 0)))) (exwm--log) (let ((pos (exwm-workspace--position workspace)) flag start end index) (if (= nth pos) (user-error "[EXWM] Cannot move to same position") ;; Set if the current workspace is involved. (setq flag (or (eq workspace exwm-workspace--current) (eq (elt exwm-workspace--list nth) exwm-workspace--current))) ;; Do the move. (with-no-warnings ;For Emacs 24. (pop (nthcdr pos exwm-workspace--list))) (push workspace (nthcdr nth exwm-workspace--list)) ;; Update the _NET_WM_DESKTOP property of each X window affected. (setq start (min pos nth) end (max pos nth)) (dolist (pair exwm--id-buffer-alist) (setq index (exwm-workspace--position (buffer-local-value 'exwm--frame (cdr pair)))) (unless (or (< index start) (> index end)) (exwm-workspace--set-desktop (car pair)))) (when flag ;; With the current workspace involved, lots of stuffs need refresh. (set-frame-parameter exwm-workspace--current 'exwm-selected-window (selected-window)) (exwm-workspace-switch exwm-workspace--current t)) (run-hooks 'exwm-workspace-list-change-hook)))) ;;;###autoload (defun exwm-workspace-add (&optional index) "Add a workspace as the INDEX-th workspace, or the last one if INDEX is nil. INDEX must not exceed the current number of workspaces." (interactive) (exwm--log "%s" index) (if (and index ;; No need to move if it's the last one. (< index (exwm-workspace--count))) (exwm-workspace-move (make-frame) index) (make-frame))) ;;;###autoload (defun exwm-workspace-delete (&optional frame-or-index) "Delete the workspace FRAME-OR-INDEX." (interactive) (exwm--log "%s" frame-or-index) (when (< 1 (exwm-workspace--count)) (let ((frame (if frame-or-index (exwm-workspace--workspace-from-frame-or-index frame-or-index) exwm-workspace--current))) (exwm-workspace--get-remove-frame-next-workspace frame) (delete-frame frame)))) (defun exwm-workspace--set-desktop (id) "Set _NET_WM_DESKTOP for X window ID." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (let ((desktop (exwm-workspace--position exwm--frame))) (setq exwm--desktop desktop) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_DESKTOP :window id :data desktop))))) ;;;###autoload (cl-defun exwm-workspace-move-window (frame-or-index &optional id) "Move window ID to workspace FRAME-OR-INDEX." (interactive (list (cond ((null current-prefix-arg) (let ((exwm-workspace--prompt-add-allowed t) (exwm-workspace--prompt-delete-allowed t)) (exwm-workspace--prompt-for-workspace "Move to [+/-]: "))) ((and (integerp current-prefix-arg) (<= 0 current-prefix-arg (exwm-workspace--count))) current-prefix-arg) (t 0)))) (let ((frame (exwm-workspace--workspace-from-frame-or-index frame-or-index)) old-frame container) (unless id (setq id (exwm--buffer->id (window-buffer)))) (unless id (cl-return-from exwm-workspace-move-window)) (exwm--log "Moving #x%x to %s" id frame-or-index) (with-current-buffer (exwm--id->buffer id) (unless (eq exwm--frame frame) (unless exwm-workspace-show-all-buffers (let ((name (replace-regexp-in-string "^\\s-*" "" (buffer-name)))) (exwm-workspace-rename-buffer (if (eq frame exwm-workspace--current) name (concat " " name))))) (setq old-frame exwm--frame exwm--frame frame) (if (not exwm--floating-frame) ;; Tiling. (if (get-buffer-window nil frame) (when (eq frame exwm-workspace--current) (exwm-layout--refresh frame)) (set-window-buffer (get-buffer-window nil t) (other-buffer nil t)) (unless (eq frame exwm-workspace--current) ;; Clear the 'exwm-selected-window' frame parameter. (set-frame-parameter frame 'exwm-selected-window nil)) (set-window-buffer (frame-selected-window frame) (exwm--id->buffer id)) (if (eq frame exwm-workspace--current) (select-window (frame-selected-window frame)) (unless (exwm-workspace--active-p frame) (exwm-layout--hide id)))) ;; Floating. (setq container (frame-parameter exwm--floating-frame 'exwm-container)) (unless (equal (frame-parameter old-frame 'exwm-randr-monitor) (frame-parameter frame 'exwm-randr-monitor)) (with-slots (x y) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable container)) (with-slots ((x1 x) (y1 y)) (exwm-workspace--get-geometry old-frame) (with-slots ((x2 x) (y2 y)) (exwm-workspace--get-geometry frame) (setq x (+ x (- x2 x1)) y (+ y (- y2 y1))))) (exwm--set-geometry id x y nil nil) (exwm--set-geometry container x y nil nil))) (if (exwm-workspace--minibuffer-own-frame-p) (if (eq frame exwm-workspace--current) (select-window (frame-root-window exwm--floating-frame)) (select-window (frame-selected-window exwm-workspace--current)) (unless (exwm-workspace--active-p frame) (exwm-layout--hide id))) ;; The frame needs to be recreated since it won't use the ;; minibuffer on the new workspace. ;; The code is mostly copied from `exwm-floating--set-floating'. (let* ((old-frame exwm--floating-frame) (new-frame (with-current-buffer (or (get-buffer "*scratch*") (progn (set-buffer-major-mode (get-buffer-create "*scratch*")) (get-buffer "*scratch*"))) (make-frame `((minibuffer . ,(minibuffer-window frame)) (left . ,(* window-min-width -100)) (top . ,(* window-min-height -100)) (width . ,window-min-width) (height . ,window-min-height) (unsplittable . t))))) (outer-id (string-to-number (frame-parameter new-frame 'outer-window-id))) (window-id (string-to-number (frame-parameter new-frame 'window-id))) (window (frame-root-window new-frame))) (set-frame-parameter new-frame 'exwm-outer-id outer-id) (set-frame-parameter new-frame 'exwm-id window-id) (set-frame-parameter new-frame 'exwm-container container) (make-frame-invisible new-frame) (set-frame-size new-frame (frame-pixel-width old-frame) (frame-pixel-height old-frame) t) (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window outer-id :parent container :x 0 :y 0)) (xcb:flush exwm--connection) (with-current-buffer (exwm--id->buffer id) (setq window-size-fixed nil exwm--floating-frame new-frame) (set-window-dedicated-p (frame-root-window old-frame) nil) (remove-hook 'window-configuration-change-hook #'exwm-layout--refresh) (set-window-buffer window (current-buffer)) (add-hook 'window-configuration-change-hook #'exwm-layout--refresh) (set-window-dedicated-p window t)) ;; Select a tiling window and delete the old frame. (select-window (frame-selected-window exwm-workspace--current)) (delete-frame old-frame) ;; The rest is the same. (make-frame-visible new-frame) (exwm--set-geometry outer-id 0 0 nil nil) (xcb:flush exwm--connection) (redisplay) (if (eq frame exwm-workspace--current) (with-current-buffer (exwm--id->buffer id) (select-window (frame-root-window exwm--floating-frame))) (unless (exwm-workspace--active-p frame) (exwm-layout--hide id))))) ;; Update the 'exwm-selected-window' frame parameter. (when (not (eq frame exwm-workspace--current)) (with-current-buffer (exwm--id->buffer id) (set-frame-parameter frame 'exwm-selected-window (frame-root-window exwm--floating-frame))))) ;; Set _NET_WM_DESKTOP. (exwm-workspace--set-desktop id) (xcb:flush exwm--connection))) (setq exwm-workspace--switch-history-outdated t))) ;;;###autoload (defun exwm-workspace-switch-to-buffer (buffer-or-name) "Make the current Emacs window display another buffer." (interactive (let ((inhibit-quit t)) ;; Show all buffers (unless exwm-workspace-show-all-buffers (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (when (= ?\s (aref (buffer-name) 0)) (let ((buffer-list-update-hook (remq #'exwm-input--on-buffer-list-update buffer-list-update-hook))) (rename-buffer (substring (buffer-name) 1))))))) (prog1 (with-local-quit (list (get-buffer (read-buffer-to-switch "Switch to buffer: ")))) ;; Hide buffers on other workspaces (unless exwm-workspace-show-all-buffers (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (unless (or (eq exwm--frame exwm-workspace--current) (= ?\s (aref (buffer-name) 0))) (let ((buffer-list-update-hook (remq #'exwm-input--on-buffer-list-update buffer-list-update-hook))) (rename-buffer (concat " " (buffer-name))))))))))) (exwm--log) (when buffer-or-name (with-current-buffer buffer-or-name (if (derived-mode-p 'exwm-mode) ;; EXWM buffer. (if (eq exwm--frame exwm-workspace--current) ;; On the current workspace. (if (not exwm--floating-frame) (switch-to-buffer buffer-or-name) ;; Select the floating frame. (select-frame-set-input-focus exwm--floating-frame) (select-window (frame-root-window exwm--floating-frame))) ;; On another workspace. (if exwm-layout-show-all-buffers (exwm-workspace-move-window exwm-workspace--current exwm--id) (let ((window (get-buffer-window buffer-or-name exwm--frame))) (if window (set-frame-parameter exwm--frame 'exwm-selected-window window) (set-window-buffer (frame-selected-window exwm--frame) buffer-or-name))) (exwm-workspace-switch exwm--frame))) ;; Ordinary buffer. (switch-to-buffer buffer-or-name))))) (defun exwm-workspace-rename-buffer (newname) "Rename a buffer." (let ((hidden (= ?\s (aref newname 0))) (basename (replace-regexp-in-string "<[0-9]+>$" "" newname)) (counter 1) tmp) (when hidden (setq basename (substring basename 1))) (setq newname basename) (while (and (setq tmp (or (get-buffer newname) (get-buffer (concat " " newname)))) (not (eq tmp (current-buffer)))) (setq newname (format "%s<%d>" basename (cl-incf counter)))) (let ((buffer-list-update-hook (remq #'exwm-input--on-buffer-list-update buffer-list-update-hook))) (rename-buffer (concat (and hidden " ") newname))))) (defun exwm-workspace--x-create-frame (orig-fun params) "Set override-redirect on the frame created by `x-create-frame'." (exwm--log) (let ((frame (funcall orig-fun params))) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window (string-to-number (frame-parameter frame 'outer-window-id)) :value-mask xcb:CW:OverrideRedirect :override-redirect 1)) (xcb:flush exwm--connection) frame)) (defsubst exwm-workspace--minibuffer-attached-p () "Return non-nil if the minibuffer is attached. Please check `exwm-workspace--minibuffer-own-frame-p' first." (assq (frame-parameter exwm-workspace--minibuffer 'exwm-container) exwm-workspace--id-struts-alist)) ;;;###autoload (defun exwm-workspace-attach-minibuffer () "Attach the minibuffer so that it always shows." (interactive) (exwm--log) (when (and (exwm-workspace--minibuffer-own-frame-p) (not (exwm-workspace--minibuffer-attached-p))) ;; Reset the frame size. (set-frame-height exwm-workspace--minibuffer 1) (redisplay) ;FIXME. (setq exwm-workspace--attached-minibuffer-height (frame-pixel-height exwm-workspace--minibuffer)) (exwm-workspace--show-minibuffer) (let ((container (frame-parameter exwm-workspace--minibuffer 'exwm-container))) (push (cons container (if (eq exwm-workspace-minibuffer-position 'top) (vector 0 0 exwm-workspace--attached-minibuffer-height 0) (vector 0 0 0 exwm-workspace--attached-minibuffer-height))) exwm-workspace--id-struts-alist) (exwm-workspace--update-struts) (exwm-workspace--update-workareas) (dolist (f exwm-workspace--list) (exwm-workspace--set-fullscreen f))))) ;;;###autoload (defun exwm-workspace-detach-minibuffer () "Detach the minibuffer so that it automatically hides." (interactive) (exwm--log) (when (and (exwm-workspace--minibuffer-own-frame-p) (exwm-workspace--minibuffer-attached-p)) (setq exwm-workspace--attached-minibuffer-height 0) (let ((container (frame-parameter exwm-workspace--minibuffer 'exwm-container))) (setq exwm-workspace--id-struts-alist (assq-delete-all container exwm-workspace--id-struts-alist)) (exwm-workspace--update-struts) (exwm-workspace--update-workareas) (dolist (f exwm-workspace--list) (exwm-workspace--set-fullscreen f)) (exwm-workspace--hide-minibuffer)))) ;;;###autoload (defun exwm-workspace-toggle-minibuffer () "Attach the minibuffer if it's detached, or detach it if it's attached." (interactive) (exwm--log) (when (exwm-workspace--minibuffer-own-frame-p) (if (exwm-workspace--minibuffer-attached-p) (exwm-workspace-detach-minibuffer) (exwm-workspace-attach-minibuffer)))) (defun exwm-workspace--update-minibuffer-height (&optional echo-area) "Update the minibuffer frame height." (unless (exwm-workspace--client-p) (let ((height (with-current-buffer (window-buffer (minibuffer-window exwm-workspace--minibuffer)) (max 1 (if echo-area (let ((width (frame-width exwm-workspace--minibuffer)) (result 0)) (mapc (lambda (i) (setq result (+ result (ceiling (1+ (length i)) width)))) (split-string (or (current-message) "") "\n")) result) (count-screen-lines)))))) (when (and (integerp max-mini-window-height) (> height max-mini-window-height)) (setq height max-mini-window-height)) (exwm--log "%s" height) (set-frame-height exwm-workspace--minibuffer height)))) (defun exwm-workspace--on-ConfigureNotify (data _synthetic) "Adjust the container to fit the minibuffer frame." (let ((obj (make-instance 'xcb:ConfigureNotify)) workarea y) (xcb:unmarshal obj data) (with-slots (window height) obj (when (eq (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id) window) (exwm--log) (when (and (floatp max-mini-window-height) (> height (* max-mini-window-height (exwm-workspace--current-height)))) (setq height (floor (* max-mini-window-height (exwm-workspace--current-height)))) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window window :value-mask xcb:ConfigWindow:Height :height height))) (when (/= (exwm-workspace--count) (length exwm-workspace--workareas)) ;; There is a chance the workareas are not updated timely. (exwm-workspace--update-workareas)) (setq workarea (elt exwm-workspace--workareas exwm-workspace-current-index) y (if (eq exwm-workspace-minibuffer-position 'top) (- (aref workarea 1) exwm-workspace--attached-minibuffer-height) (+ (aref workarea 1) (aref workarea 3) (- height) exwm-workspace--attached-minibuffer-height))) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm-workspace--minibuffer 'exwm-container) :value-mask (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height) :y y :height height)) (xcb:flush exwm--connection))))) (defun exwm-workspace--display-buffer (buffer alist) "Display BUFFER as if the current workspace is selected." ;; Only when the floating minibuffer frame is selected. ;; This also protect this functions from being recursively called. (when (eq (selected-frame) exwm-workspace--minibuffer) (with-selected-frame exwm-workspace--current (display-buffer buffer alist)))) (defun exwm-workspace--show-minibuffer () "Show the minibuffer frame." (exwm--log) ;; Cancel pending timer. (when exwm-workspace--display-echo-area-timer (cancel-timer exwm-workspace--display-echo-area-timer) (setq exwm-workspace--display-echo-area-timer nil)) ;; Show the minibuffer frame. (unless (exwm-workspace--minibuffer-attached-p) (exwm--set-geometry (frame-parameter exwm-workspace--minibuffer 'exwm-container) nil nil (frame-pixel-width exwm-workspace--minibuffer) (frame-pixel-height exwm-workspace--minibuffer))) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm-workspace--minibuffer 'exwm-container) :value-mask xcb:ConfigWindow:StackMode :stack-mode xcb:StackMode:Above)) (xcb:flush exwm--connection)) (defun exwm-workspace--hide-minibuffer () "Hide the minibuffer frame." (exwm--log) ;; Hide the minibuffer frame. (if (exwm-workspace--minibuffer-attached-p) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window (frame-parameter exwm-workspace--minibuffer 'exwm-container) :value-mask (logior (if exwm-manage--desktop xcb:ConfigWindow:Sibling 0) xcb:ConfigWindow:StackMode) :sibling exwm-manage--desktop :stack-mode (if exwm-manage--desktop xcb:StackMode:Above xcb:StackMode:Below))) (exwm--set-geometry (frame-parameter exwm-workspace--minibuffer 'exwm-container) nil nil 1 1)) (xcb:flush exwm--connection)) (defun exwm-workspace--on-minibuffer-setup () "Run in minibuffer-setup-hook to show the minibuffer and its container." (exwm--log) (when (and (= 1 (minibuffer-depth)) (not (exwm-workspace--client-p))) (add-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height) (exwm-workspace--show-minibuffer)) ;; FIXME: This is a temporary fix for the *Completions* buffer not ;; being correctly fitted by its displaying window. As with ;; `exwm-workspace--display-buffer', the problem is caused by ;; the fact that the minibuffer (rather than the workspace) ;; frame is the 'selected frame'. `get-buffer-window' will ;; fail to retrieve the correct window. It's likely there are ;; other related issues. ;; This is not required by Emacs 24. (when (fboundp 'window-preserve-size) (let ((window (get-buffer-window "*Completions*" exwm-workspace--current))) (when window (fit-window-to-buffer window) (window-preserve-size window))))) (defun exwm-workspace--on-minibuffer-exit () "Run in minibuffer-exit-hook to hide the minibuffer container." (exwm--log) (when (and (= 1 (minibuffer-depth)) (not (exwm-workspace--client-p))) (remove-hook 'post-command-hook #'exwm-workspace--update-minibuffer-height) (exwm-workspace--hide-minibuffer))) (defun exwm-workspace--on-echo-area-dirty () "Run when new message arrives to show the echo area and its container." (when (and (not (active-minibuffer-window)) (not (exwm-workspace--client-p)) (or (current-message) cursor-in-echo-area)) (exwm-workspace--update-minibuffer-height t) (exwm-workspace--show-minibuffer) (unless (or (not exwm-workspace-display-echo-area-timeout) exwm-input--during-command ;e.g. read-event input-method-use-echo-area) (setq exwm-workspace--display-echo-area-timer (run-with-timer exwm-workspace-display-echo-area-timeout nil #'exwm-workspace--echo-area-maybe-clear))))) (defun exwm-workspace--echo-area-maybe-clear () "Eventually clear the echo area container." (exwm--log) (if (not (current-message)) (exwm-workspace--on-echo-area-clear) ;; Reschedule. (cancel-timer exwm-workspace--display-echo-area-timer) (setq exwm-workspace--display-echo-area-timer (run-with-timer exwm-workspace-display-echo-area-timeout nil #'exwm-workspace--echo-area-maybe-clear)))) (defun exwm-workspace--on-echo-area-clear () "Run in echo-area-clear-hook to hide echo area container." (unless (exwm-workspace--client-p) (unless (active-minibuffer-window) (exwm-workspace--hide-minibuffer)) (when exwm-workspace--display-echo-area-timer (cancel-timer exwm-workspace--display-echo-area-timer) (setq exwm-workspace--display-echo-area-timer nil)))) (defun exwm-workspace--set-desktop-geometry () "Set _NET_DESKTOP_GEOMETRY." (exwm--log) ;; We don't support large desktop so it's the same with screen size. (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_DESKTOP_GEOMETRY :window exwm--root :width (x-display-pixel-width) :height (x-display-pixel-height)))) (defun exwm-workspace--add-frame-as-workspace (frame) "Configure frame FRAME to be treated as a workspace." (exwm--log "%s" frame) (setq exwm-workspace--list (nconc exwm-workspace--list (list frame))) (let ((outer-id (string-to-number (frame-parameter frame 'outer-window-id))) (window-id (string-to-number (frame-parameter frame 'window-id))) (container (xcb:generate-id exwm--connection))) ;; Save window IDs (set-frame-parameter frame 'exwm-outer-id outer-id) (set-frame-parameter frame 'exwm-id window-id) (set-frame-parameter frame 'exwm-container container) ;; In case it's created by emacsclient. (set-frame-parameter frame 'client nil) ;; Copy RandR frame parameters from the first workspace to ;; prevent potential problems. The values do not matter here as ;; they'll be updated by the RandR module later. (let ((w (car exwm-workspace--list))) (dolist (param '(exwm-randr-monitor exwm-geometry)) (set-frame-parameter frame param (frame-parameter w param)))) (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 :wid container :parent exwm--root :x -1 :y -1 :width 1 :height 1 :border-width 0 :class xcb:WindowClass:InputOutput :visual 0 :value-mask (logior xcb:CW:BackPixmap xcb:CW:OverrideRedirect) :background-pixmap xcb:BackPixmap:ParentRelative :override-redirect 1)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window container :value-mask xcb:ConfigWindow:StackMode :stack-mode xcb:StackMode:Below)) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window container :data (format "EXWM workspace %d frame container" (exwm-workspace--position frame)))) (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window outer-id :parent container :x 0 :y 0)) (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window container))) (xcb:flush exwm--connection) ;; Delay making the workspace fullscreen until Emacs becomes idle (exwm--defer 0 #'set-frame-parameter frame 'fullscreen 'fullboth) ;; Update EWMH properties. (exwm-workspace--update-ewmh-props) (if exwm-workspace--create-silently (setq exwm-workspace--switch-history-outdated t) (let ((original-index exwm-workspace-current-index)) (exwm-workspace-switch frame t) (message "Created %s as workspace %d; switched from %d" frame exwm-workspace-current-index original-index)) (run-hooks 'exwm-workspace-list-change-hook))) (defun exwm-workspace--get-remove-frame-next-workspace (frame) "Return the next workspace if workspace FRAME is removed. All X windows currently on workspace FRAME will be automatically moved to the next workspace." (let* ((index (exwm-workspace--position frame)) (lastp (= index (1- (exwm-workspace--count)))) (nextw (elt exwm-workspace--list (+ index (if lastp -1 +1))))) ;; Clients need to be moved to some other workspace before this being ;; removed. (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (when (eq exwm--frame frame) (exwm-workspace-move-window nextw exwm--id)))) nextw)) (defun exwm-workspace--remove-frame-as-workspace (frame) "Stop treating frame FRAME as a workspace." ;; TODO: restore all frame parameters (e.g. exwm-workspace, buffer-predicate, ;; etc) (exwm--log "Removing frame `%s' as workspace" frame) (let* ((index (exwm-workspace--position frame)) (nextw (exwm-workspace--get-remove-frame-next-workspace frame))) ;; Need to remove the workspace from the list in order for ;; the correct calculation of indexes. (setq exwm-workspace--list (delete frame exwm-workspace--list)) ;; Update the _NET_WM_DESKTOP property of each X window affected. (dolist (pair exwm--id-buffer-alist) (when (<= (1- index) (exwm-workspace--position (buffer-local-value 'exwm--frame (cdr pair)))) (exwm-workspace--set-desktop (car pair)))) ;; If the current workspace is deleted, switch to next one. (when (eq frame exwm-workspace--current) (exwm-workspace-switch nextw))) ;; Reparent out the frame. (let ((outer-id (frame-parameter frame 'exwm-outer-id))) (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window outer-id)) (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window outer-id :parent exwm--root :x 0 :y 0)) ;; Reset the override-redirect. (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window outer-id :value-mask xcb:CW:OverrideRedirect :override-redirect 0)) ;; Remove fullscreen state. (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_STATE :window outer-id :data nil)) (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window outer-id))) ;; Destroy the container. (xcb:+request exwm--connection (make-instance 'xcb:DestroyWindow :window (frame-parameter frame 'exwm-container))) (xcb:flush exwm--connection) ;; Update EWMH properties. (exwm-workspace--update-ewmh-props) ;; Update switch history. (setq exwm-workspace--switch-history-outdated t) (run-hooks 'exwm-workspace-list-change-hook)) (defun exwm-workspace--on-delete-frame (frame) "Hook run upon `delete-frame' that tears down FRAME's configuration as a workspace." (cond ((not (exwm-workspace--workspace-p frame)) (exwm--log "Frame `%s' is not a workspace" frame)) (t (when (= 1 (exwm-workspace--count)) ;; The user managed to delete the last workspace, so create a new one. (exwm--log "Last workspace deleted; create a new one") ;; TODO: this makes sense in the hook. But we need a function that takes ;; care of converting a workspace into a regular unmanaged frame. (let ((exwm-workspace--create-silently t)) (make-frame))) (exwm-workspace--remove-frame-as-workspace frame) (remhash frame exwm-workspace--client-p-hash-table)))) (defun exwm-workspace--on-after-make-frame (frame) "Hook run upon `make-frame' that configures FRAME as a workspace." (cond ((exwm-workspace--workspace-p frame) (exwm--log "Frame `%s' is already a workspace" frame)) ((not (display-graphic-p frame)) (exwm--log "Frame `%s' is not graphical" frame)) ((not (string-equal (replace-regexp-in-string "\\.0$" "" (slot-value exwm--connection 'display)) (replace-regexp-in-string "\\.0$" "" (frame-parameter frame 'display)))) (exwm--log "Frame `%s' is on a different DISPLAY (%S instead of %S)" frame (frame-parameter frame 'display) (slot-value exwm--connection 'display))) ((frame-parameter frame 'unsplittable) ;; We create floating frames with the "unsplittable" parameter set. ;; Though it may not be a floating frame, we won't treat an ;; unsplittable frame as a workspace anyway. (exwm--log "Frame `%s' is floating" frame)) (t (exwm--log "Adding frame `%s' as workspace" frame) (exwm-workspace--add-frame-as-workspace frame)))) (defun exwm-workspace--update-ewmh-props () "Update EWMH properties to match the workspace list." (exwm--log) (let ((num-workspaces (exwm-workspace--count))) ;; Avoid setting 0 desktops. (when (= 0 num-workspaces) (setq num-workspaces 1)) ;; Set _NET_NUMBER_OF_DESKTOPS. (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_NUMBER_OF_DESKTOPS :window exwm--root :data num-workspaces)) ;; Set _NET_DESKTOP_GEOMETRY. (exwm-workspace--set-desktop-geometry) ;; Update workareas. (exwm-workspace--update-workareas)) (xcb:flush exwm--connection)) (defun exwm-workspace--modify-all-x-frames-parameters (new-x-parameters) "Modifies `window-system-default-frame-alist' for the X Window System. NEW-X-PARAMETERS is an alist of frame parameters, merged into current `window-system-default-frame-alist' for the X Window System. The parameters are applied to all subsequently created X frames." (exwm--log) ;; The parameters are modified in place; take current ;; ones or insert a new X-specific list. (let ((x-parameters (or (assq 'x window-system-default-frame-alist) (let ((new-x-parameters '(x))) (push new-x-parameters window-system-default-frame-alist) new-x-parameters)))) (setf (cdr x-parameters) (append new-x-parameters (cdr x-parameters))))) (defun exwm-workspace--handle-focus-in (_orig-func _event) "Replacement for `handle-focus-in'." (interactive "e")) (defun exwm-workspace--handle-focus-out (_orig-func _event) "Replacement for `handle-focus-out'." (interactive "e")) (defun exwm-workspace--init-minibuffer-frame () (exwm--log) ;; Initialize workspaces without minibuffers. (setq exwm-workspace--minibuffer (make-frame '((window-system . x) (minibuffer . only) (left . 10000) (right . 10000) (width . 1) (height . 1) (client . nil)))) ;; This is the only usable minibuffer frame. (setq default-minibuffer-frame exwm-workspace--minibuffer) (exwm-workspace--modify-all-x-frames-parameters '((minibuffer . nil))) (let ((outer-id (string-to-number (frame-parameter exwm-workspace--minibuffer 'outer-window-id))) (window-id (string-to-number (frame-parameter exwm-workspace--minibuffer 'window-id))) (container (xcb:generate-id exwm--connection))) (set-frame-parameter exwm-workspace--minibuffer 'exwm-outer-id outer-id) (set-frame-parameter exwm-workspace--minibuffer 'exwm-id window-id) (set-frame-parameter exwm-workspace--minibuffer 'exwm-container container) (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 :wid container :parent exwm--root :x 0 :y 0 :width 1 :height 1 :border-width 0 :class xcb:WindowClass:InputOutput :visual 0 :value-mask (logior xcb:CW:BackPixmap xcb:CW:OverrideRedirect) :background-pixmap xcb:BackPixmap:ParentRelative :override-redirect 1)) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window container :data "EXWM minibuffer container")) ;; Reparent the minibuffer frame to the container. (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window outer-id :parent container :x 0 :y 0)) ;; Map the container. (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window container)) ;; Attach event listener for monitoring the frame (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window outer-id :value-mask xcb:CW:EventMask :event-mask xcb:EventMask:StructureNotify)) (xcb:+event exwm--connection 'xcb:ConfigureNotify #'exwm-workspace--on-ConfigureNotify)) ;; Show/hide minibuffer / echo area when they're active/inactive. (add-hook 'minibuffer-setup-hook #'exwm-workspace--on-minibuffer-setup) (add-hook 'minibuffer-exit-hook #'exwm-workspace--on-minibuffer-exit) (setq exwm-workspace--timer (run-with-idle-timer 0 t #'exwm-workspace--on-echo-area-dirty)) (add-hook 'echo-area-clear-hook #'exwm-workspace--on-echo-area-clear) ;; The default behavior of `display-buffer' (indirectly called by ;; `minibuffer-completion-help') is not correct here. (cl-pushnew '(exwm-workspace--display-buffer) display-buffer-alist :test #'equal)) (defun exwm-workspace--exit-minibuffer-frame () (exwm--log) ;; Only on minibuffer-frame. (remove-hook 'minibuffer-setup-hook #'exwm-workspace--on-minibuffer-setup) (remove-hook 'minibuffer-exit-hook #'exwm-workspace--on-minibuffer-exit) (remove-hook 'echo-area-clear-hook #'exwm-workspace--on-echo-area-clear) (when exwm-workspace--timer (cancel-timer exwm-workspace--timer) (setq exwm-workspace--timer nil)) (setq display-buffer-alist (cl-delete '(exwm-workspace--display-buffer) display-buffer-alist :test #'equal)) (setq default-minibuffer-frame nil) (let ((id (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id))) (when (and exwm-workspace--minibuffer id) (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window id :parent exwm--root :x 0 :y 0))) (setq exwm-workspace--minibuffer nil))) (defun exwm-workspace--init () "Initialize workspace module." (exwm--log) (exwm-workspace--init-switch-map) ;; Prevent unexpected exit (setq exwm-workspace--fullscreen-frame-count 0) (exwm-workspace--modify-all-x-frames-parameters '((internal-border-width . 0))) (let ((initial-workspaces (frame-list))) (if (not (exwm-workspace--minibuffer-own-frame-p)) ;; Initialize workspaces with minibuffers. (when (< 1 (length initial-workspaces)) ;; Exclude the initial frame. (dolist (i initial-workspaces) (unless (frame-parameter i 'window-id) (setq initial-workspaces (delq i initial-workspaces)))) (setq exwm-workspace--client (frame-parameter (car initial-workspaces) 'client)) (let ((f (car initial-workspaces))) ;; Remove the possible internal border. (set-frame-parameter f 'internal-border-width 0) ;; Prevent user from deleting the first frame by accident. (set-frame-parameter f 'client nil))) (exwm-workspace--init-minibuffer-frame) ;; Remove/hide existing frames. (dolist (f initial-workspaces) (if (frame-parameter f 'client) (progn (unless exwm-workspace--client (setq exwm-workspace--client (frame-parameter f 'client))) (make-frame-invisible f)) (when (eq 'x (framep f)) ;do not delete the initial frame. (delete-frame f)))) ;; Recreate one frame with the external minibuffer set. (setq initial-workspaces (list (make-frame '((window-system . x) (client . nil)))))) ;; Prevent `other-buffer' from selecting already displayed EXWM buffers. (modify-all-frames-parameters '((buffer-predicate . exwm-layout--other-buffer-predicate))) ;; Create remaining workspaces. (dotimes (_ (- exwm-workspace-number (length initial-workspaces))) (nconc initial-workspaces (list (make-frame '((window-system . x) (client . nil)))))) ;; Configure workspaces (let ((exwm-workspace--create-silently t)) (dolist (i initial-workspaces) (exwm-workspace--add-frame-as-workspace i)))) (xcb:flush exwm--connection) ;; We have to advice `x-create-frame' or every call to it would hang EXWM (advice-add 'x-create-frame :around #'exwm-workspace--x-create-frame) ;; We have to manually handle focus-in and focus-out events for Emacs ;; frames. (advice-add 'handle-focus-in :around #'exwm-workspace--handle-focus-in) (advice-add 'handle-focus-out :around #'exwm-workspace--handle-focus-out) ;; Make new frames create new workspaces. (add-hook 'after-make-frame-functions #'exwm-workspace--on-after-make-frame) (add-hook 'delete-frame-functions #'exwm-workspace--on-delete-frame) (when (exwm-workspace--minibuffer-own-frame-p) (add-hook 'exwm-input--event-hook #'exwm-workspace--on-echo-area-clear)) ;; Switch to the first workspace (exwm-workspace-switch 0 t) ;; Prevent frame parameters introduced by this module from being ;; saved/restored. (dolist (i '(exwm-active exwm-outer-id exwm-id exwm-container exwm-geometry exwm-selected-window exwm-urgency fullscreen)) (unless (assq i frameset-filter-alist) (push (cons i :never) frameset-filter-alist)))) (defun exwm-workspace--exit () "Exit the workspace module." (exwm--log) (when (exwm-workspace--minibuffer-own-frame-p) (exwm-workspace--exit-minibuffer-frame)) (advice-remove 'x-create-frame #'exwm-workspace--x-create-frame) (advice-remove 'handle-focus-in #'exwm-workspace--handle-focus-in) (advice-remove 'handle-focus-out #'exwm-workspace--handle-focus-out) (remove-hook 'after-make-frame-functions #'exwm-workspace--on-after-make-frame) (remove-hook 'delete-frame-functions #'exwm-workspace--on-delete-frame) (when (exwm-workspace--minibuffer-own-frame-p) (remove-hook 'exwm-input--event-hook #'exwm-workspace--on-echo-area-clear)) ;; Hide & reparent out all frames (save-set can't be used here since ;; X windows will be re-mapped). (setq exwm-workspace--current nil) (dolist (i exwm-workspace--list) (exwm-workspace--remove-frame-as-workspace i) (modify-frame-parameters i '((exwm-selected-window . nil) (exwm-urgency . nil) (exwm-outer-id . nil) (exwm-id . nil) (exwm-container . nil) ;; (internal-border-width . nil) ; integerp ;; (client . nil) (fullscreen . nil) (buffer-predicate . nil)))) ;; Restore the 'client' frame parameter (before `exwm-exit'). (when exwm-workspace--client (dolist (f exwm-workspace--list) (set-frame-parameter f 'client exwm-workspace--client)) (when (exwm-workspace--minibuffer-own-frame-p) (set-frame-parameter exwm-workspace--minibuffer 'client exwm-workspace--client)) (setq exwm-workspace--client nil))) (defun exwm-workspace--post-init () "The second stage in the initialization of the workspace module." (exwm--log) (when exwm-workspace--client ;; Reset the 'fullscreen' frame parameter to make emacsclinet frames ;; fullscreen (even without the RandR module enabled). (dolist (i exwm-workspace--list) (set-frame-parameter i 'fullscreen nil) (set-frame-parameter i 'fullscreen 'fullboth))) ;; Wait until all workspace frames are resized. (with-timeout (1) (while (< exwm-workspace--fullscreen-frame-count (exwm-workspace--count)) (accept-process-output nil 0.1))) (setq exwm-workspace--fullscreen-frame-count nil)) (provide 'exwm-workspace) ;;; exwm-workspace.el ends here exwm-0.26/exwm-xim.el000066400000000000000000001063111414260560000145160ustar00rootroot00000000000000;;; exwm-xim.el --- XIM Module for EXWM -*- lexical-binding: t -*- ;; Copyright (C) 2019-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; 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 . ;;; Commentary: ;; This module adds XIM support for EXWM and allows sending characters ;; generated by any Emacs's builtin input method (info node `Input Methods') ;; to X windows. ;; This module is essentially an X input method server utilizing Emacs as ;; its backend. It talks with X windows through the XIM protocol. The XIM ;; protocol is quite flexible by itself, stating that an implementation can ;; create network connections of various types as well as make use of an ;; existing X connection for communication, and that an IM server may ;; support multiple transport versions, various input styles and several ;; event flow modals, etc. Here we only make choices that are most popular ;; among other IM servers and more importantly, practical for Emacs to act ;; as an IM server: ;; ;; + Packets are transported on top of an X connection like most IMEs. ;; + Only transport version 0.0 (i.e. only-CM & Property-with-CM) is ;; supported (same as "IM Server Developers Kit", adopted by most IMEs). ;; + Only support static event flow, on-demand-synchronous method. ;; + Only "root-window" input style is supported. ;; To use this module, first load and enable it as follows: ;; ;; (require 'exwm-xim) ;; (exwm-xim-enable) ;; ;; A keybinding for `toggle-input-method' is probably required to turn on & ;; off an input method (default to `default-input-method'). It's bound to ;; 'C-\' by default and can be made reachable when working with X windows: ;; ;; (push ?\C-\\ exwm-input-prefix-keys) ;; ;; It's also required (and error-prone) to setup environment variables to ;; make applications actually use this input method. Typically the ;; following lines should be inserted into '~/.xinitrc'. ;; ;; export XMODIFIERS=@im=exwm-xim ;; export GTK_IM_MODULE=xim ;; export QT_IM_MODULE=xim ;; export CLUTTER_IM_MODULE=xim ;; References: ;; + XIM (http://www.x.org/releases/X11R7.6/doc/libX11/specs/XIM/xim.html) ;; + IMdkit (http://xorg.freedesktop.org/archive/unsupported/lib/IMdkit/) ;; + UIM (https://github.com/uim/uim) ;;; Code: (eval-when-compile (require 'cl-lib)) (require 'xcb-keysyms) (require 'xcb-xim) (require 'exwm-core) (require 'exwm-input) (defconst exwm-xim--locales "@locale=\ aa,af,ak,am,an,anp,ar,as,ast,ayc,az,be,bem,ber,bg,bhb,bho,bn,bo,br,brx,bs,byn,\ ca,ce,cmn,crh,cs,csb,cv,cy,da,de,doi,dv,dz,el,en,es,et,eu,fa,ff,fi,fil,fo,fr,\ fur,fy,ga,gd,gez,gl,gu,gv,ha,hak,he,hi,hne,hr,hsb,ht,hu,hy,ia,id,ig,ik,is,it,\ iu,iw,ja,ka,kk,kl,km,kn,ko,kok,ks,ku,kw,ky,lb,lg,li,li,lij,lo,lt,lv,lzh,mag,\ mai,mg,mhr,mi,mk,ml,mn,mni,mr,ms,mt,my,nan,nb,nds,ne,nhn,niu,nl,nn,nr,nso,oc,\ om,or,os,pa,pa,pap,pl,ps,pt,quz,raj,ro,ru,rw,sa,sat,sc,sd,se,shs,si,sid,sk,sl,\ so,sq,sr,ss,st,sv,sw,szl,ta,tcy,te,tg,th,the,ti,tig,tk,tl,tn,tr,ts,tt,ug,uk,\ unm,ur,uz,ve,vi,wa,wae,wal,wo,xh,yi,yo,yue,zh,zu,\ C,no" "All supported locales (stolen from glibc).") (defconst exwm-xim--default-error (make-instance 'xim:error :im-id 0 :ic-id 0 :flag xim:error-flag:invalid-both :error-code xim:error-code:bad-something :length 0 :type 0 :detail nil) "Default error returned to clients.") (defconst exwm-xim--default-im-attrs (list (make-instance 'xim:XIMATTR :id 0 :type xim:ATTRIBUTE-VALUE-TYPE:xim-styles :length (length xlib:XNQueryInputStyle) :attribute xlib:XNQueryInputStyle)) "Default IM attrs returned to clients.") (defconst exwm-xim--default-ic-attrs (list (make-instance 'xim:XICATTR :id 0 :type xim:ATTRIBUTE-VALUE-TYPE:long-data :length (length xlib:XNInputStyle) :attribute xlib:XNInputStyle) (make-instance 'xim:XICATTR :id 1 :type xim:ATTRIBUTE-VALUE-TYPE:window :length (length xlib:XNClientWindow) :attribute xlib:XNClientWindow) ;; Required by e.g. xterm. (make-instance 'xim:XICATTR :id 2 :type xim:ATTRIBUTE-VALUE-TYPE:window :length (length xlib:XNFocusWindow) :attribute xlib:XNFocusWindow)) "Default IC attrs returned to clients.") (defconst exwm-xim--default-styles (make-instance 'xim:XIMStyles :number nil :styles (list (logior xlib:XIMPreeditNothing xlib:XIMStatusNothing))) "Default styles: root-window, i.e. no preediting or status display support.") (defconst exwm-xim--default-attributes (list (make-instance 'xim:XIMATTRIBUTE :id 0 :length nil :value exwm-xim--default-styles)) "Default IM/IC attributes returned to clients.") (defvar exwm-xim--conn nil "The X connection for initiating other XIM connections.") (defvar exwm-xim--event-xwin nil "X window for initiating new XIM connections.") (defvar exwm-xim--server-client-plist '(nil nil) "Plist mapping server window to [X connection, client window, byte-order].") (defvar exwm-xim--client-server-plist '(nil nil) "Plist mapping client window to server window.") (defvar exwm-xim--property-index 0 "For generating a unique property name.") (defvar exwm-xim--im-id 0 "Last IM ID.") (defvar exwm-xim--ic-id 0 "Last IC ID.") ;; X11 atoms. (defvar exwm-xim--@server nil) (defvar exwm-xim--LOCALES nil) (defvar exwm-xim--TRANSPORT nil) (defvar exwm-xim--XIM_SERVERS nil) (defvar exwm-xim--_XIM_PROTOCOL nil) (defvar exwm-xim--_XIM_XCONNECT nil) (defvar exwm-xim-buffer-p nil "Whether current buffer is used by exwm-xim.") (make-variable-buffer-local 'exwm-xim-buffer-p) (defun exwm-xim--on-SelectionRequest (data _synthetic) "Handle SelectionRequest events on IMS window. Such events would be received when clients query for LOCALES or TRANSPORT." (exwm--log) (let ((evt (make-instance 'xcb:SelectionRequest)) value fake-event) (xcb:unmarshal evt data) (with-slots (time requestor selection target property) evt (setq value (cond ((= target exwm-xim--LOCALES) ;; Return supported locales. exwm-xim--locales) ((= target exwm-xim--TRANSPORT) ;; Use XIM over an X connection. "@transport=X/"))) (when value ;; Change the property. (xcb:+request exwm-xim--conn (make-instance 'xcb:ChangeProperty :mode xcb:PropMode:Replace :window requestor :property property :type target :format 8 :data-len (length value) :data value)) ;; Send a SelectionNotify event. (setq fake-event (make-instance 'xcb:SelectionNotify :time time :requestor requestor :selection selection :target target :property property)) (xcb:+request exwm-xim--conn (make-instance 'xcb:SendEvent :propagate 0 :destination requestor :event-mask xcb:EventMask:NoEvent :event (xcb:marshal fake-event exwm-xim--conn))) (xcb:flush exwm-xim--conn))))) (cl-defun exwm-xim--on-ClientMessage-0 (data _synthetic) "Handle ClientMessage event on IMS window (new connection). Such events would be received when clients request for _XIM_XCONNECT. A new X connection and server window would be created to communicate with this client." (exwm--log) (let ((evt (make-instance 'xcb:ClientMessage)) conn client-xwin server-xwin) (xcb:unmarshal evt data) (with-slots (window type data) evt (unless (= type exwm-xim--_XIM_XCONNECT) ;; Only handle _XIM_XCONNECT. (exwm--log "Ignore ClientMessage %s" type) (cl-return-from exwm-xim--on-ClientMessage-0)) (setq client-xwin (elt (slot-value data 'data32) 0) ;; Create a new X connection and a new server window. conn (xcb:connect) server-xwin (xcb:generate-id conn)) (set-process-query-on-exit-flag (slot-value conn 'process) nil) ;; Store this client. (plist-put exwm-xim--server-client-plist server-xwin `[,conn ,client-xwin nil]) (plist-put exwm-xim--client-server-plist client-xwin server-xwin) ;; Select DestroyNotify events on this client window. (xcb:+request exwm-xim--conn (make-instance 'xcb:ChangeWindowAttributes :window client-xwin :value-mask xcb:CW:EventMask :event-mask xcb:EventMask:StructureNotify)) (xcb:flush exwm-xim--conn) ;; Handle ClientMessage events from this new connection. (xcb:+event conn 'xcb:ClientMessage #'exwm-xim--on-ClientMessage) ;; Create a communication window. (xcb:+request conn (make-instance 'xcb:CreateWindow :depth 0 :wid server-xwin :parent exwm--root :x 0 :y 0 :width 1 :height 1 :border-width 0 :class xcb:WindowClass:InputOutput :visual 0 :value-mask xcb:CW:OverrideRedirect :override-redirect 1)) (xcb:flush conn) ;; Send connection establishment ClientMessage. (setf window client-xwin (slot-value data 'data32) `(,server-xwin 0 0 0 0)) (slot-makeunbound data 'data8) (slot-makeunbound data 'data16) (xcb:+request exwm-xim--conn (make-instance 'xcb:SendEvent :propagate 0 :destination client-xwin :event-mask xcb:EventMask:NoEvent :event (xcb:marshal evt exwm-xim--conn))) (xcb:flush exwm-xim--conn)))) (cl-defun exwm-xim--on-ClientMessage (data _synthetic) "Handle ClientMessage event on IMS communication window (request). Such events would be received when clients request for _XIM_PROTOCOL. The actual XIM request is in client message data or a property." (exwm--log) (let ((evt (make-instance 'xcb:ClientMessage)) conn client-xwin server-xwin) (xcb:unmarshal evt data) (with-slots (format window type data) evt (unless (= type exwm-xim--_XIM_PROTOCOL) (exwm--log "Ignore ClientMessage %s" type) (cl-return-from exwm-xim--on-ClientMessage)) (setq server-xwin window conn (plist-get exwm-xim--server-client-plist server-xwin) client-xwin (elt conn 1) conn (elt conn 0)) (cond ((= format 8) ;; Data. (exwm-xim--on-request (vconcat (slot-value data 'data8)) conn client-xwin server-xwin)) ((= format 32) ;; Atom. (with-slots (data32) data (with-slots (value) (xcb:+request-unchecked+reply conn (make-instance 'xcb:GetProperty :delete 1 :window server-xwin :property (elt data32 1) :type xcb:GetPropertyType:Any :long-offset 0 :long-length (elt data32 0))) (when (> (length value) 0) (exwm-xim--on-request value conn client-xwin server-xwin))))))))) (defun exwm-xim--on-request (data conn client-xwin server-xwin) "Handle an XIM reuqest." (exwm--log) (let ((opcode (elt data 0)) ;; Let-bind `xim:lsb' to make pack/unpack functions work correctly. (xim:lsb (elt (plist-get exwm-xim--server-client-plist server-xwin) 2)) req replies) (cond ((= opcode xim:opcode:error) (exwm--log "ERROR: %s" data)) ((= opcode xim:opcode:connect) (exwm--log "CONNECT") (setq xim:lsb (= (elt data 4) xim:connect-byte-order:lsb-first)) ;; Store byte-order. (setf (elt (plist-get exwm-xim--server-client-plist server-xwin) 2) xim:lsb) (setq req (make-instance 'xim:connect)) (xcb:unmarshal req data) (if (and (= (slot-value req 'major-version) 1) (= (slot-value req 'minor-version) 0) ;; Do not support authentication. (= (slot-value req 'number) 0)) ;; Accept the connection. (push (make-instance 'xim:connect-reply) replies) ;; Deny it. (push exwm-xim--default-error replies))) ((memq opcode (list xim:opcode:auth-required xim:opcode:auth-reply xim:opcode:auth-next xim:opcode:auth-ng)) (exwm--log "AUTH: %d" opcode) ;; Deny any attempt to make authentication. (push exwm-xim--default-error replies)) ((= opcode xim:opcode:disconnect) (exwm--log "DISCONNECT") ;; Gracefully disconnect from the client. (exwm-xim--make-request (make-instance 'xim:disconnect-reply) conn client-xwin) ;; Destroy the communication window & connection. (xcb:+request conn (make-instance 'xcb:DestroyWindow :window server-xwin)) (xcb:disconnect conn) ;; Clean up cache. (cl-remf exwm-xim--server-client-plist server-xwin) (cl-remf exwm-xim--client-server-plist client-xwin)) ((= opcode xim:opcode:open) (exwm--log "OPEN") ;; Note: We make no check here. (setq exwm-xim--im-id (if (< exwm-xim--im-id #xffff) (1+ exwm-xim--im-id) 1)) (setq replies (list (make-instance 'xim:open-reply :im-id exwm-xim--im-id :im-attrs-length nil :im-attrs exwm-xim--default-im-attrs :ic-attrs-length nil :ic-attrs exwm-xim--default-ic-attrs) (make-instance 'xim:set-event-mask :im-id exwm-xim--im-id :ic-id 0 ;; Static event flow. :forward-event-mask xcb:EventMask:KeyPress ;; on-demand-synchronous method. :synchronous-event-mask xcb:EventMask:NoEvent)))) ((= opcode xim:opcode:close) (exwm--log "CLOSE") (setq req (make-instance 'xim:close)) (xcb:unmarshal req data) (push (make-instance 'xim:close-reply :im-id (slot-value req 'im-id)) replies)) ((= opcode xim:opcode:trigger-notify) (exwm--log "TRIGGER-NOTIFY") ;; Only static event flow modal is supported. (push exwm-xim--default-error replies)) ((= opcode xim:opcode:encoding-negotiation) (exwm--log "ENCODING-NEGOTIATION") (setq req (make-instance 'xim:encoding-negotiation)) (xcb:unmarshal req data) (let ((index (cl-position "COMPOUND_TEXT" (mapcar (lambda (i) (slot-value i 'name)) (slot-value req 'names)) :test #'equal))) (unless index ;; Fallback to portable character encoding (a subset of ASCII). (setq index -1)) (push (make-instance 'xim:encoding-negotiation-reply :im-id (slot-value req 'im-id) :category xim:encoding-negotiation-reply-category:name :index index) replies))) ((= opcode xim:opcode:query-extension) (exwm--log "QUERY-EXTENSION") (setq req (make-instance 'xim:query-extension)) (xcb:unmarshal req data) (push (make-instance 'xim:query-extension-reply :im-id (slot-value req 'im-id) ;; No extension support. :length 0 :extensions nil) replies)) ((= opcode xim:opcode:set-im-values) (exwm--log "SET-IM-VALUES") ;; There's only one possible input method attribute. (setq req (make-instance 'xim:set-im-values)) (xcb:unmarshal req data) (push (make-instance 'xim:set-im-values-reply :im-id (slot-value req 'im-id)) replies)) ((= opcode xim:opcode:get-im-values) (exwm--log "GET-IM-VALUES") (setq req (make-instance 'xim:get-im-values)) (let (im-attributes-id) (xcb:unmarshal req data) (setq im-attributes-id (slot-value req 'im-attributes-id)) (if (cl-notevery (lambda (i) (= i 0)) im-attributes-id) ;; Only support one IM attributes. (push (make-instance 'xim:error :im-id (slot-value req 'im-id) :ic-id 0 :flag xim:error-flag:invalid-ic-id :error-code xim:error-code:bad-something :length 0 :type 0 :detail nil) replies) (push (make-instance 'xim:get-im-values-reply :im-id (slot-value req 'im-id) :length nil :im-attributes exwm-xim--default-attributes) replies)))) ((= opcode xim:opcode:create-ic) (exwm--log "CREATE-IC") (setq req (make-instance 'xim:create-ic)) (xcb:unmarshal req data) ;; Note: The ic-attributes slot is ignored. (setq exwm-xim--ic-id (if (< exwm-xim--ic-id #xffff) (1+ exwm-xim--ic-id) 1)) (push (make-instance 'xim:create-ic-reply :im-id (slot-value req 'im-id) :ic-id exwm-xim--ic-id) replies)) ((= opcode xim:opcode:destroy-ic) (exwm--log "DESTROY-IC") (setq req (make-instance 'xim:destroy-ic)) (xcb:unmarshal req data) (push (make-instance 'xim:destroy-ic-reply :im-id (slot-value req 'im-id) :ic-id (slot-value req 'ic-id)) replies)) ((= opcode xim:opcode:set-ic-values) (exwm--log "SET-IC-VALUES") (setq req (make-instance 'xim:set-ic-values)) (xcb:unmarshal req data) ;; We don't distinguish between input contexts. (push (make-instance 'xim:set-ic-values-reply :im-id (slot-value req 'im-id) :ic-id (slot-value req 'ic-id)) replies)) ((= opcode xim:opcode:get-ic-values) (exwm--log "GET-IC-VALUES") (setq req (make-instance 'xim:get-ic-values)) (xcb:unmarshal req data) (push (make-instance 'xim:get-ic-values-reply :im-id (slot-value req 'im-id) :ic-id (slot-value req 'ic-id) :length nil :ic-attributes exwm-xim--default-attributes) replies)) ((= opcode xim:opcode:set-ic-focus) (exwm--log "SET-IC-FOCUS") ;; All input contexts are the same. ) ((= opcode xim:opcode:unset-ic-focus) (exwm--log "UNSET-IC-FOCUS") ;; All input contexts are the same. ) ((= opcode xim:opcode:forward-event) (exwm--log "FORWARD-EVENT") (setq req (make-instance 'xim:forward-event)) (xcb:unmarshal req data) (exwm-xim--handle-forward-event-request req xim:lsb conn client-xwin)) ((= opcode xim:opcode:sync) (exwm--log "SYNC") (setq req (make-instance 'xim:sync)) (xcb:unmarshal req data) (push (make-instance 'xim:sync-reply :im-id (slot-value req 'im-id) :ic-id (slot-value req 'ic-id)) replies)) ((= opcode xim:opcode:sync-reply) (exwm--log "SYNC-REPLY")) ((= opcode xim:opcode:reset-ic) (exwm--log "RESET-IC") ;; No context-specific data saved. (setq req (make-instance 'xim:reset-ic)) (xcb:unmarshal req data) (push (make-instance 'xim:reset-ic-reply :im-id (slot-value req 'im-id) :ic-id (slot-value req 'ic-id) :length 0 :string "") replies)) ((memq opcode (list xim:opcode:str-conversion-reply xim:opcode:preedit-start-reply xim:opcode:preedit-caret-reply)) (exwm--log "PREEDIT: %d" opcode) ;; No preedit support. (push exwm-xim--default-error replies)) (t (exwm--log "Bad protocol") (push exwm-xim--default-error replies))) ;; Actually send the replies. (when replies (mapc (lambda (reply) (exwm-xim--make-request reply conn client-xwin)) replies) (xcb:flush conn)))) (defun exwm-xim--handle-forward-event-request (req lsb conn client-xwin) (let ((im-func (with-current-buffer (window-buffer) input-method-function)) key-event keysym keysyms event result) ;; Note: The flag slot is ignored. ;; Do conversion in client's byte-order. (let ((xcb:lsb lsb)) (setq key-event (make-instance 'xcb:KeyPress)) (xcb:unmarshal key-event (slot-value req 'event))) (with-slots (detail state) key-event (setq keysym (xcb:keysyms:keycode->keysym exwm-xim--conn detail state)) (when (/= (car keysym) 0) (setq event (xcb:keysyms:keysym->event exwm-xim--conn (car keysym) (logand state (lognot (cdr keysym))))))) (while (or (slot-value req 'event) unread-command-events) (unless (slot-value req 'event) (setq event (pop unread-command-events)) ;; Handle events in (t . EVENT) format. (when (and (consp event) (eq (car event) t)) (setq event (cdr event)))) (if (or (not im-func) ;; `list' is the default method. (eq im-func #'list) (not event) ;; Select only printable keys. (not (integerp event)) (> #x20 event) (< #x7e event)) ;; Either there is no active input method, or invalid key ;; is detected. (with-slots ((raw-event event) im-id ic-id serial-number) req (if raw-event (setq event raw-event) (setq keysyms (xcb:keysyms:event->keysyms exwm-xim--conn event)) (with-slots (detail state) key-event (setf detail (xcb:keysyms:keysym->keycode exwm-xim--conn (caar keysyms)) state (cdar keysyms))) (setq event (let ((xcb:lsb lsb)) (xcb:marshal key-event conn)))) (when event (exwm-xim--make-request (make-instance 'xim:forward-event :im-id im-id :ic-id ic-id :flag xim:commit-flag:synchronous :serial-number serial-number :event event) conn client-xwin))) (when (eq exwm--selected-input-mode 'char-mode) ;; Grab keyboard temporarily for char-mode. (exwm-input--grab-keyboard)) (unwind-protect (with-temp-buffer ;; This variable is used to test whether exwm-xim is enabled. ;; Used by e.g. pyim-probe. (setq-local exwm-xim-buffer-p t) ;; Always show key strokes. (let ((input-method-use-echo-area t) (exwm-input-line-mode-passthrough t)) (setq result (funcall im-func event)) ;; Clear echo area for the input method. (message nil) ;; This also works for portable character encoding. (setq result (encode-coding-string (concat result) 'compound-text-with-extensions)) (exwm-xim--make-request (make-instance 'xim:commit-x-lookup-chars :im-id (slot-value req 'im-id) :ic-id (slot-value req 'ic-id) :flag (logior xim:commit-flag:synchronous xim:commit-flag:x-lookup-chars) :length (length result) :string result) conn client-xwin))) (when (eq exwm--selected-input-mode 'char-mode) (exwm-input--release-keyboard)))) (xcb:flush conn) (setf event nil (slot-value req 'event) nil)))) (defun exwm-xim--make-request (req conn client-xwin) "Make an XIM request REQ via connection CONN. CLIENT-XWIN would receive a ClientMessage event either telling the client the request data or where to fetch the data." (exwm--log) (let ((data (xcb:marshal req)) property format client-message-data client-message) (if (<= (length data) 20) ;; Send short requests directly with client messages. (setq format 8 ;; Pad to 20 bytes. data (append data (make-list (- 20 (length data)) 0)) client-message-data (make-instance 'xcb:ClientMessageData :data8 data)) ;; Send long requests with properties. (setq property (exwm--intern-atom (format "_EXWM_XIM_%x" exwm-xim--property-index))) (cl-incf exwm-xim--property-index) (xcb:+request conn (make-instance 'xcb:ChangeProperty :mode xcb:PropMode:Append :window client-xwin :property property :type xcb:Atom:STRING :format 8 :data-len (length data) :data data)) ;; Also send a client message to notify the client about this property. (setq format 32 client-message-data (make-instance 'xcb:ClientMessageData :data32 `(,(length data) ,property ;; Pad to 20 bytes. 0 0 0)))) ;; Send the client message. (setq client-message (make-instance 'xcb:ClientMessage :format format :window client-xwin :type exwm-xim--_XIM_PROTOCOL :data client-message-data)) (xcb:+request conn (make-instance 'xcb:SendEvent :propagate 0 :destination client-xwin :event-mask xcb:EventMask:NoEvent :event (xcb:marshal client-message conn))))) (defun exwm-xim--on-DestroyNotify (data synthetic) "Do cleanups on receiving DestroyNotify event. Such event would be received when the client window is destroyed." (exwm--log) (unless synthetic (let ((evt (make-instance 'xcb:DestroyNotify)) conn client-xwin server-xwin) (xcb:unmarshal evt data) (setq client-xwin (slot-value evt 'window) server-xwin (plist-get exwm-xim--client-server-plist client-xwin)) (when server-xwin (setq conn (aref (plist-get exwm-xim--server-client-plist server-xwin) 0)) (cl-remf exwm-xim--server-client-plist server-xwin) (cl-remf exwm-xim--client-server-plist client-xwin) ;; Destroy the communication window & connection. (xcb:+request conn (make-instance 'xcb:DestroyWindow :window server-xwin)) (xcb:disconnect conn))))) (cl-defun exwm-xim--init () "Initialize the XIM module." (exwm--log) (when exwm-xim--conn (cl-return-from exwm-xim--init)) ;; Initialize atoms. (setq exwm-xim--@server (exwm--intern-atom "@server=exwm-xim") exwm-xim--LOCALES (exwm--intern-atom "LOCALES") exwm-xim--TRANSPORT (exwm--intern-atom "TRANSPORT") exwm-xim--XIM_SERVERS (exwm--intern-atom "XIM_SERVERS") exwm-xim--_XIM_PROTOCOL (exwm--intern-atom "_XIM_PROTOCOL") exwm-xim--_XIM_XCONNECT (exwm--intern-atom "_XIM_XCONNECT")) ;; Create a new connection and event window. (setq exwm-xim--conn (xcb:connect) exwm-xim--event-xwin (xcb:generate-id exwm-xim--conn)) (set-process-query-on-exit-flag (slot-value exwm-xim--conn 'process) nil) ;; Initialize xcb:keysyms module. (xcb:keysyms:init exwm-xim--conn) ;; Listen to SelectionRequest event for connection establishment. (xcb:+event exwm-xim--conn 'xcb:SelectionRequest #'exwm-xim--on-SelectionRequest) ;; Listen to ClientMessage event on IMS window for new XIM connection. (xcb:+event exwm-xim--conn 'xcb:ClientMessage #'exwm-xim--on-ClientMessage-0) ;; Listen to DestroyNotify event to do cleanups. (xcb:+event exwm-xim--conn 'xcb:DestroyNotify #'exwm-xim--on-DestroyNotify) ;; Create the event window. (xcb:+request exwm-xim--conn (make-instance 'xcb:CreateWindow :depth 0 :wid exwm-xim--event-xwin :parent exwm--root :x 0 :y 0 :width 1 :height 1 :border-width 0 :class xcb:WindowClass:InputOutput :visual 0 :value-mask xcb:CW:OverrideRedirect :override-redirect 1)) ;; Set the selection owner. (xcb:+request exwm-xim--conn (make-instance 'xcb:SetSelectionOwner :owner exwm-xim--event-xwin :selection exwm-xim--@server :time xcb:Time:CurrentTime)) ;; Set XIM_SERVERS property on the root window. (xcb:+request exwm-xim--conn (make-instance 'xcb:ChangeProperty :mode xcb:PropMode:Prepend :window exwm--root :property exwm-xim--XIM_SERVERS :type xcb:Atom:ATOM :format 32 :data-len 1 :data (funcall (if xcb:lsb #'xcb:-pack-u4-lsb #'xcb:-pack-u4) exwm-xim--@server))) (xcb:flush exwm-xim--conn)) (cl-defun exwm-xim--exit () "Exit the XIM module." (exwm--log) ;; Close IMS communication connections. (mapc (lambda (i) (when (vectorp i) (xcb:disconnect (elt i 0)))) exwm-xim--server-client-plist) ;; Close the IMS connection. (unless exwm-xim--conn (cl-return-from exwm-xim--exit)) ;; Remove exwm-xim from XIM_SERVERS. (let ((reply (xcb:+request-unchecked+reply exwm-xim--conn (make-instance 'xcb:GetProperty :delete 1 :window exwm--root :property exwm-xim--XIM_SERVERS :type xcb:Atom:ATOM :long-offset 0 :long-length 1000))) unpacked-reply pack unpack) (unless reply (cl-return-from exwm-xim--exit)) (setq reply (slot-value reply 'value)) (unless (> (length reply) 4) (cl-return-from exwm-xim--exit)) (setq reply (vconcat reply) pack (if xcb:lsb #'xcb:-pack-u4-lsb #'xcb:-pack-u4) unpack (if xcb:lsb #'xcb:-unpack-u4-lsb #'xcb:-unpack-u4)) (dotimes (i (/ (length reply) 4)) (push (funcall unpack reply (* i 4)) unpacked-reply)) (setq unpacked-reply (delq exwm-xim--@server unpacked-reply) reply (mapcar pack unpacked-reply)) (xcb:+request exwm-xim--conn (make-instance 'xcb:ChangeProperty :mode xcb:PropMode:Replace :window exwm--root :property exwm-xim--XIM_SERVERS :type xcb:Atom:ATOM :format 32 :data-len (length reply) :data reply)) (xcb:flush exwm-xim--conn)) (xcb:disconnect exwm-xim--conn) (setq exwm-xim--conn nil)) (defun exwm-xim-enable () "Enable XIM support for EXWM." (exwm--log) (add-hook 'exwm-init-hook #'exwm-xim--init) (add-hook 'exwm-exit-hook #'exwm-xim--exit)) (provide 'exwm-xim) ;;; exwm-xim.el ends here exwm-0.26/exwm.el000066400000000000000000001266731414260560000137400ustar00rootroot00000000000000;;; exwm.el --- Emacs X Window Manager -*- lexical-binding: t -*- ;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Chris Feng ;; Maintainer: Adrián Medraño Calvo ;; Version: 0.26 ;; Package-Requires: ((xelb "0.18")) ;; Keywords: unix ;; URL: https://github.com/ch11ng/exwm ;; 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 . ;;; Commentary: ;; Overview ;; -------- ;; EXWM (Emacs X Window Manager) is a full-featured tiling X window manager ;; for Emacs built on top of [XELB](https://github.com/ch11ng/xelb). ;; It features: ;; + Fully keyboard-driven operations ;; + Hybrid layout modes (tiling & stacking) ;; + Dynamic workspace support ;; + ICCCM/EWMH compliance ;; + (Optional) RandR (multi-monitor) support ;; + (Optional) Built-in system tray ;; Installation & configuration ;; ---------------------------- ;; Here are the minimal steps to get EXWM working: ;; 1. Install XELB and EXWM, and make sure they are in `load-path'. ;; 2. In '~/.emacs', add following lines (please modify accordingly): ;; ;; (require 'exwm) ;; (require 'exwm-config) ;; (exwm-config-example) ;; ;; 3. Link or copy the file 'xinitrc' to '~/.xinitrc'. ;; 4. Launch EXWM in a console (e.g. tty1) with ;; ;; xinit -- vt01 ;; ;; You should additionally hide the menu-bar, tool-bar, etc to increase the ;; usable space. Please check the wiki (https://github.com/ch11ng/exwm/wiki) ;; for more detailed instructions on installation, configuration, usage, etc. ;; References: ;; + dwm (http://dwm.suckless.org/) ;; + i3 wm (https://i3wm.org/) ;; + Also see references within each required library. ;;; Code: (require 'server) (require 'exwm-core) (require 'exwm-workspace) (require 'exwm-layout) (require 'exwm-floating) (require 'exwm-manage) (require 'exwm-input) (defgroup exwm nil "Emacs X Window Manager." :tag "EXWM" :version "25.3" :group 'applications :prefix "exwm-") (defcustom exwm-init-hook nil "Normal hook run when EXWM has just finished initialization." :type 'hook) (defcustom exwm-exit-hook nil "Normal hook run just before EXWM exits." :type 'hook) (defcustom exwm-update-class-hook nil "Normal hook run when window class is updated." :type 'hook) (defcustom exwm-update-title-hook nil "Normal hook run when window title is updated." :type 'hook) (defcustom exwm-blocking-subrs '(x-file-dialog x-popup-dialog x-select-font) "Subrs (primitives) that would normally block EXWM." :type '(repeat function)) (defcustom exwm-replace 'ask "Whether to replace existing window manager." :type '(radio (const :tag "Ask" ask) (const :tag "Replace by default" t) (const :tag "Do not replace" nil))) (defconst exwm--server-name "server-exwm" "Name of the subordinate Emacs server.") (defvar exwm--server-process nil "Process of the subordinate Emacs server.") (defun exwm-reset () "Reset the state of the selected window (non-fullscreen, line-mode, etc)." (interactive) (exwm--log) (with-current-buffer (window-buffer) (when (derived-mode-p 'exwm-mode) (when (exwm-layout--fullscreen-p) (exwm-layout-unset-fullscreen)) ;; Force refresh (exwm-layout--refresh) (call-interactively #'exwm-input-grab-keyboard)))) ;;;###autoload (defun exwm-restart () "Restart EXWM." (interactive) (exwm--log) (when (exwm--confirm-kill-emacs "[EXWM] Restart? " 'no-check) (let* ((attr (process-attributes (emacs-pid))) (args (cdr (assq 'args attr))) (ppid (cdr (assq 'ppid attr))) (pargs (cdr (assq 'args (process-attributes ppid))))) (cond ((= ppid 1) ;; The parent is the init process. This probably means this ;; instance is an emacsclient. Anyway, start a control instance ;; to manage the subsequent ones. (call-process (car command-line-args)) (kill-emacs)) ((string= args pargs) ;; This is a subordinate instance. Return a magic number to ;; inform the parent (control instance) to start another one. (kill-emacs ?R)) (t ;; This is the control instance. Keep starting subordinate ;; instances until told to exit. ;; Run `server-force-stop' if it exists. (run-hooks 'kill-emacs-hook) (with-temp-buffer (while (= ?R (shell-command-on-region (point) (point) args)))) (kill-emacs)))))) (defun exwm--update-desktop (xwin) "Update _NET_WM_DESKTOP." (exwm--log "#x%x" xwin) (with-current-buffer (exwm--id->buffer xwin) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:ewmh:get-_NET_WM_DESKTOP :window xwin))) desktop) (when reply (setq desktop (slot-value reply 'value)) (cond ((eq desktop 4294967295.) (unless (or (not exwm--floating-frame) (eq exwm--frame exwm-workspace--current) (and exwm--desktop (= desktop exwm--desktop))) (exwm-layout--show xwin (frame-root-window exwm--floating-frame))) (setq exwm--desktop desktop)) ((and desktop (< desktop (exwm-workspace--count)) (if exwm--desktop (/= desktop exwm--desktop) (/= desktop (exwm-workspace--position exwm--frame)))) (exwm-workspace-move-window desktop xwin)) (t (exwm-workspace--set-desktop xwin))))))) (defun exwm--update-window-type (id &optional force) "Update _NET_WM_WINDOW_TYPE." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and exwm-window-type (not force)) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:ewmh:get-_NET_WM_WINDOW_TYPE :window id)))) (when reply ;nil when destroyed (setq exwm-window-type (append (slot-value reply 'value) nil))))))) (defun exwm--update-class (id &optional force) "Update WM_CLASS." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and exwm-instance-name exwm-class-name (not force)) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:icccm:get-WM_CLASS :window id)))) (when reply ;nil when destroyed (setq exwm-instance-name (slot-value reply 'instance-name) exwm-class-name (slot-value reply 'class-name)) (when (and exwm-instance-name exwm-class-name) (run-hooks 'exwm-update-class-hook))))))) (defun exwm--update-utf8-title (id &optional force) "Update _NET_WM_NAME." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (when (or force (not exwm-title)) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:ewmh:get-_NET_WM_NAME :window id)))) (when reply ;nil when destroyed (setq exwm-title (slot-value reply 'value)) (when exwm-title (setq exwm--title-is-utf8 t) (run-hooks 'exwm-update-title-hook))))))) (defun exwm--update-ctext-title (id &optional force) "Update WM_NAME." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (or exwm--title-is-utf8 (and exwm-title (not force))) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:icccm:get-WM_NAME :window id)))) (when reply ;nil when destroyed (setq exwm-title (slot-value reply 'value)) (when exwm-title (run-hooks 'exwm-update-title-hook))))))) (defun exwm--update-title (id) "Update _NET_WM_NAME or WM_NAME." (exwm--log "#x%x" id) (exwm--update-utf8-title id) (exwm--update-ctext-title id)) (defun exwm--update-transient-for (id &optional force) "Update WM_TRANSIENT_FOR." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and exwm-transient-for (not force)) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:icccm:get-WM_TRANSIENT_FOR :window id)))) (when reply ;nil when destroyed (setq exwm-transient-for (slot-value reply 'value))))))) (defun exwm--update-normal-hints (id &optional force) "Update WM_NORMAL_HINTS." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and (not force) (or exwm--normal-hints-x exwm--normal-hints-y exwm--normal-hints-width exwm--normal-hints-height exwm--normal-hints-min-width exwm--normal-hints-min-height exwm--normal-hints-max-width exwm--normal-hints-max-height ;; FIXME: other fields )) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:icccm:get-WM_NORMAL_HINTS :window id)))) (when (and reply (slot-value reply 'flags)) ;nil when destroyed (with-slots (flags x y width height min-width min-height max-width max-height base-width base-height ;; win-gravity ) reply (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:USPosition)) (setq exwm--normal-hints-x x exwm--normal-hints-y y)) (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:USSize)) (setq exwm--normal-hints-width width exwm--normal-hints-height height)) (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PMinSize)) (setq exwm--normal-hints-min-width min-width exwm--normal-hints-min-height min-height)) (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PMaxSize)) (setq exwm--normal-hints-max-width max-width exwm--normal-hints-max-height max-height)) (unless (or exwm--normal-hints-min-width (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PBaseSize))) (setq exwm--normal-hints-min-width base-width exwm--normal-hints-min-height base-height)) ;; (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PWinGravity)) ;; (setq exwm--normal-hints-win-gravity win-gravity)) (setq exwm--fixed-size (and exwm--normal-hints-min-width exwm--normal-hints-min-height exwm--normal-hints-max-width exwm--normal-hints-max-height (/= 0 exwm--normal-hints-min-width) (/= 0 exwm--normal-hints-min-height) (= exwm--normal-hints-min-width exwm--normal-hints-max-width) (= exwm--normal-hints-min-height exwm--normal-hints-max-height))))))))) (defun exwm--update-hints (id &optional force) "Update WM_HINTS." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and (not force) exwm--hints-input exwm--hints-urgency) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:icccm:get-WM_HINTS :window id)))) (when (and reply (slot-value reply 'flags)) ;nil when destroyed (with-slots (flags input initial-state) reply (when flags (unless (= 0 (logand flags xcb:icccm:WM_HINTS:InputHint)) (setq exwm--hints-input (when input (= 1 input)))) (unless (= 0 (logand flags xcb:icccm:WM_HINTS:StateHint)) (setq exwm-state initial-state)) (unless (= 0 (logand flags xcb:icccm:WM_HINTS:UrgencyHint)) (setq exwm--hints-urgency t)))) (when (and exwm--hints-urgency (not (eq exwm--frame exwm-workspace--current))) (unless (frame-parameter exwm--frame 'exwm-urgency) (set-frame-parameter exwm--frame 'exwm-urgency t) (setq exwm-workspace--switch-history-outdated t)))))))) (defun exwm--update-protocols (id &optional force) "Update WM_PROTOCOLS." (exwm--log "#x%x" id) (with-current-buffer (exwm--id->buffer id) (unless (and exwm--protocols (not force)) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:icccm:get-WM_PROTOCOLS :window id)))) (when reply ;nil when destroyed (setq exwm--protocols (append (slot-value reply 'value) nil))))))) (defun exwm--update-struts-legacy (id) "Update _NET_WM_STRUT." (exwm--log "#x%x" id) (let ((pair (assq id exwm-workspace--id-struts-alist)) reply struts) (unless (and pair (< 4 (length (cdr pair)))) (setq reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:ewmh:get-_NET_WM_STRUT :window id))) (when reply (setq struts (slot-value reply 'value)) (if pair (setcdr pair struts) (push (cons id struts) exwm-workspace--id-struts-alist)) (exwm-workspace--update-struts)) ;; Update workareas. (exwm-workspace--update-workareas) ;; Update workspaces. (dolist (f exwm-workspace--list) (exwm-workspace--set-fullscreen f))))) (defun exwm--update-struts-partial (id) "Update _NET_WM_STRUT_PARTIAL." (exwm--log "#x%x" id) (let ((reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:ewmh:get-_NET_WM_STRUT_PARTIAL :window id))) struts pair) (when reply (setq struts (slot-value reply 'value) pair (assq id exwm-workspace--id-struts-alist)) (if pair (setcdr pair struts) (push (cons id struts) exwm-workspace--id-struts-alist)) (exwm-workspace--update-struts)) ;; Update workareas. (exwm-workspace--update-workareas) ;; Update workspaces. (dolist (f exwm-workspace--list) (exwm-workspace--set-fullscreen f)))) (defun exwm--update-struts (id) "Update _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT." (exwm--log "#x%x" id) (exwm--update-struts-partial id) (exwm--update-struts-legacy id)) (defun exwm--on-PropertyNotify (data _synthetic) "Handle PropertyNotify event." (let ((obj (make-instance 'xcb:PropertyNotify)) atom id buffer) (xcb:unmarshal obj data) (setq id (slot-value obj 'window) atom (slot-value obj 'atom)) (exwm--log "atom=%s(%s)" (x-get-atom-name atom exwm-workspace--current) atom) (setq buffer (exwm--id->buffer id)) (if (not (buffer-live-p buffer)) ;; Properties of unmanaged X windows. (cond ((= atom xcb:Atom:_NET_WM_STRUT) (exwm--update-struts-legacy id)) ((= atom xcb:Atom:_NET_WM_STRUT_PARTIAL) (exwm--update-struts-partial id))) (with-current-buffer buffer (cond ((= atom xcb:Atom:_NET_WM_WINDOW_TYPE) (exwm--update-window-type id t)) ((= atom xcb:Atom:WM_CLASS) (exwm--update-class id t)) ((= atom xcb:Atom:_NET_WM_NAME) (exwm--update-utf8-title id t)) ((= atom xcb:Atom:WM_NAME) (exwm--update-ctext-title id t)) ((= atom xcb:Atom:WM_TRANSIENT_FOR) (exwm--update-transient-for id t)) ((= atom xcb:Atom:WM_NORMAL_HINTS) (exwm--update-normal-hints id t)) ((= atom xcb:Atom:WM_HINTS) (exwm--update-hints id t)) ((= atom xcb:Atom:WM_PROTOCOLS) (exwm--update-protocols id t)) ((= atom xcb:Atom:_NET_WM_USER_TIME)) ;ignored (t (exwm--log "Unhandled: %s(%d)" (x-get-atom-name atom exwm-workspace--current) atom))))))) (defun exwm--on-ClientMessage (raw-data _synthetic) "Handle ClientMessage event." (let ((obj (make-instance 'xcb:ClientMessage)) type id data) (xcb:unmarshal obj raw-data) (setq type (slot-value obj 'type) id (slot-value obj 'window) data (slot-value (slot-value obj 'data) 'data32)) (exwm--log "atom=%s(%s)" (x-get-atom-name type exwm-workspace--current) type) (cond ;; _NET_NUMBER_OF_DESKTOPS. ((= type xcb:Atom:_NET_NUMBER_OF_DESKTOPS) (let ((current (exwm-workspace--count)) (requested (elt data 0))) ;; Only allow increasing/decreasing the workspace number by 1. (cond ((< current requested) (make-frame)) ((and (> current requested) (> current 1)) (let ((frame (car (last exwm-workspace--list)))) (exwm-workspace--get-remove-frame-next-workspace frame) (delete-frame frame)))))) ;; _NET_CURRENT_DESKTOP. ((= type xcb:Atom:_NET_CURRENT_DESKTOP) (exwm-workspace-switch (elt data 0))) ;; _NET_ACTIVE_WINDOW. ((= type xcb:Atom:_NET_ACTIVE_WINDOW) (let ((buffer (exwm--id->buffer id)) iconic window) (when (buffer-live-p buffer) (with-current-buffer buffer (when (eq exwm--frame exwm-workspace--current) (if exwm--floating-frame (select-frame exwm--floating-frame) (setq iconic (exwm-layout--iconic-state-p)) (when iconic ;; State change: iconic => normal. (set-window-buffer (frame-selected-window exwm--frame) (current-buffer))) ;; Focus transfer. (setq window (get-buffer-window nil t)) (when (or iconic (not (eq window (selected-window)))) (select-window window)))))))) ;; _NET_CLOSE_WINDOW. ((= type xcb:Atom:_NET_CLOSE_WINDOW) (let ((buffer (exwm--id->buffer id))) (when (buffer-live-p buffer) (exwm--defer 0 #'kill-buffer buffer)))) ;; _NET_WM_MOVERESIZE ((= type xcb:Atom:_NET_WM_MOVERESIZE) (let ((direction (elt data 2)) (buffer (exwm--id->buffer id))) (unless (and buffer (not (buffer-local-value 'exwm--floating-frame buffer))) (cond ((= direction xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_KEYBOARD) ;; FIXME ) ((= direction xcb:ewmh:_NET_WM_MOVERESIZE_MOVE_KEYBOARD) ;; FIXME ) ((= direction xcb:ewmh:_NET_WM_MOVERESIZE_CANCEL) (exwm-floating--stop-moveresize)) ;; In case it's a workspace frame. ((and (not buffer) (catch 'break (dolist (f exwm-workspace--list) (when (or (eq id (frame-parameter f 'exwm-outer-id)) (eq id (frame-parameter f 'exwm-id))) (throw 'break t))) nil))) (t ;; In case it's a floating frame, ;; move the corresponding X window instead. (unless buffer (catch 'break (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (when (and exwm--floating-frame (or (eq id (frame-parameter exwm--floating-frame 'exwm-outer-id)) (eq id (frame-parameter exwm--floating-frame 'exwm-id)))) (setq id exwm--id) (throw 'break nil)))))) ;; Start to move it. (exwm-floating--start-moveresize id direction)))))) ;; _NET_REQUEST_FRAME_EXTENTS ((= type xcb:Atom:_NET_REQUEST_FRAME_EXTENTS) (let ((buffer (exwm--id->buffer id)) top btm) (if (or (not buffer) (not (buffer-local-value 'exwm--floating-frame buffer))) (setq top 0 btm 0) (setq top (window-header-line-height) btm (window-mode-line-height))) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_FRAME_EXTENTS :window id :left 0 :right 0 :top top :bottom btm))) (xcb:flush exwm--connection)) ;; _NET_WM_DESKTOP. ((= type xcb:Atom:_NET_WM_DESKTOP) (let ((buffer (exwm--id->buffer id))) (when (buffer-live-p buffer) (exwm-workspace-move-window (elt data 0) id)))) ;; _NET_WM_STATE ((= type xcb:Atom:_NET_WM_STATE) (let ((action (elt data 0)) (props (list (elt data 1) (elt data 2))) (buffer (exwm--id->buffer id)) props-new) ;; only support _NET_WM_STATE_FULLSCREEN / _NET_WM_STATE_ADD for frames (when (and (not buffer) (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN props) (= action xcb:ewmh:_NET_WM_STATE_ADD)) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_STATE :window id :data (vector xcb:Atom:_NET_WM_STATE_FULLSCREEN))) (xcb:flush exwm--connection)) (when buffer ;ensure it's managed (with-current-buffer buffer ;; _NET_WM_STATE_FULLSCREEN (when (or (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN props) (memq xcb:Atom:_NET_WM_STATE_ABOVE props)) (cond ((= action xcb:ewmh:_NET_WM_STATE_ADD) (unless (exwm-layout--fullscreen-p) (exwm-layout-set-fullscreen id)) (push xcb:Atom:_NET_WM_STATE_FULLSCREEN props-new)) ((= action xcb:ewmh:_NET_WM_STATE_REMOVE) (when (exwm-layout--fullscreen-p) (exwm-layout-unset-fullscreen id))) ((= action xcb:ewmh:_NET_WM_STATE_TOGGLE) (if (exwm-layout--fullscreen-p) (exwm-layout-unset-fullscreen id) (exwm-layout-set-fullscreen id) (push xcb:Atom:_NET_WM_STATE_FULLSCREEN props-new))))) ;; _NET_WM_STATE_DEMANDS_ATTENTION ;; FIXME: check (may require other properties set) (when (memq xcb:Atom:_NET_WM_STATE_DEMANDS_ATTENTION props) (when (= action xcb:ewmh:_NET_WM_STATE_ADD) (unless (eq exwm--frame exwm-workspace--current) (set-frame-parameter exwm--frame 'exwm-urgency t) (setq exwm-workspace--switch-history-outdated t))) ;; xcb:ewmh:_NET_WM_STATE_REMOVE? ;; xcb:ewmh:_NET_WM_STATE_TOGGLE? ) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_STATE :window id :data (vconcat props-new))) (xcb:flush exwm--connection))))) ((= type xcb:Atom:WM_PROTOCOLS) (let ((type (elt data 0))) (cond ((= type xcb:Atom:_NET_WM_PING) (setq exwm-manage--ping-lock nil)) (t (exwm--log "Unhandled WM_PROTOCOLS of type: %d" type))))) ((= type xcb:Atom:WM_CHANGE_STATE) (let ((buffer (exwm--id->buffer id))) (when (and (buffer-live-p buffer) (= (elt data 0) xcb:icccm:WM_STATE:IconicState)) (with-current-buffer buffer (if exwm--floating-frame (call-interactively #'exwm-floating-hide) (bury-buffer)))))) (t (exwm--log "Unhandled: %s(%d)" (x-get-atom-name type exwm-workspace--current) type))))) (defun exwm--on-SelectionClear (data _synthetic) "Handle SelectionClear events." (exwm--log) (let ((obj (make-instance 'xcb:SelectionClear)) owner selection) (xcb:unmarshal obj data) (setq owner (slot-value obj 'owner) selection (slot-value obj 'selection)) (when (and (eq owner exwm--wmsn-window) (eq selection xcb:Atom:WM_S0)) (exwm-exit)))) (defun exwm--init-icccm-ewmh () "Initialize ICCCM/EWMH support." (exwm--log) ;; Handle PropertyNotify event (xcb:+event exwm--connection 'xcb:PropertyNotify #'exwm--on-PropertyNotify) ;; Handle relevant client messages (xcb:+event exwm--connection 'xcb:ClientMessage #'exwm--on-ClientMessage) ;; Handle SelectionClear (xcb:+event exwm--connection 'xcb:SelectionClear #'exwm--on-SelectionClear) ;; Set _NET_SUPPORTED (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_SUPPORTED :window exwm--root :data (vector ;; Root windows properties. xcb:Atom:_NET_SUPPORTED xcb:Atom:_NET_CLIENT_LIST xcb:Atom:_NET_CLIENT_LIST_STACKING xcb:Atom:_NET_NUMBER_OF_DESKTOPS xcb:Atom:_NET_DESKTOP_GEOMETRY xcb:Atom:_NET_DESKTOP_VIEWPORT xcb:Atom:_NET_CURRENT_DESKTOP ;; xcb:Atom:_NET_DESKTOP_NAMES xcb:Atom:_NET_ACTIVE_WINDOW ;; xcb:Atom:_NET_WORKAREA xcb:Atom:_NET_SUPPORTING_WM_CHECK ;; xcb:Atom:_NET_VIRTUAL_ROOTS ;; xcb:Atom:_NET_DESKTOP_LAYOUT ;; xcb:Atom:_NET_SHOWING_DESKTOP ;; Other root window messages. xcb:Atom:_NET_CLOSE_WINDOW ;; xcb:Atom:_NET_MOVERESIZE_WINDOW xcb:Atom:_NET_WM_MOVERESIZE ;; xcb:Atom:_NET_RESTACK_WINDOW xcb:Atom:_NET_REQUEST_FRAME_EXTENTS ;; Application window properties. xcb:Atom:_NET_WM_NAME ;; xcb:Atom:_NET_WM_VISIBLE_NAME ;; xcb:Atom:_NET_WM_ICON_NAME ;; xcb:Atom:_NET_WM_VISIBLE_ICON_NAME xcb:Atom:_NET_WM_DESKTOP ;; xcb:Atom:_NET_WM_WINDOW_TYPE ;; xcb:Atom:_NET_WM_WINDOW_TYPE_DESKTOP xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLBAR xcb:Atom:_NET_WM_WINDOW_TYPE_MENU xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG xcb:Atom:_NET_WM_WINDOW_TYPE_DROPDOWN_MENU xcb:Atom:_NET_WM_WINDOW_TYPE_POPUP_MENU xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLTIP xcb:Atom:_NET_WM_WINDOW_TYPE_NOTIFICATION xcb:Atom:_NET_WM_WINDOW_TYPE_COMBO xcb:Atom:_NET_WM_WINDOW_TYPE_DND xcb:Atom:_NET_WM_WINDOW_TYPE_NORMAL ;; xcb:Atom:_NET_WM_STATE ;; xcb:Atom:_NET_WM_STATE_MODAL ;; xcb:Atom:_NET_WM_STATE_STICKY ;; xcb:Atom:_NET_WM_STATE_MAXIMIZED_VERT ;; xcb:Atom:_NET_WM_STATE_MAXIMIZED_HORZ ;; xcb:Atom:_NET_WM_STATE_SHADED ;; xcb:Atom:_NET_WM_STATE_SKIP_TASKBAR ;; xcb:Atom:_NET_WM_STATE_SKIP_PAGER xcb:Atom:_NET_WM_STATE_HIDDEN xcb:Atom:_NET_WM_STATE_FULLSCREEN ;; xcb:Atom:_NET_WM_STATE_ABOVE ;; xcb:Atom:_NET_WM_STATE_BELOW xcb:Atom:_NET_WM_STATE_DEMANDS_ATTENTION ;; xcb:Atom:_NET_WM_STATE_FOCUSED ;; xcb:Atom:_NET_WM_ALLOWED_ACTIONS xcb:Atom:_NET_WM_ACTION_MOVE xcb:Atom:_NET_WM_ACTION_RESIZE xcb:Atom:_NET_WM_ACTION_MINIMIZE ;; xcb:Atom:_NET_WM_ACTION_SHADE ;; xcb:Atom:_NET_WM_ACTION_STICK ;; xcb:Atom:_NET_WM_ACTION_MAXIMIZE_HORZ ;; xcb:Atom:_NET_WM_ACTION_MAXIMIZE_VERT xcb:Atom:_NET_WM_ACTION_FULLSCREEN xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP xcb:Atom:_NET_WM_ACTION_CLOSE ;; xcb:Atom:_NET_WM_ACTION_ABOVE ;; xcb:Atom:_NET_WM_ACTION_BELOW ;; xcb:Atom:_NET_WM_STRUT xcb:Atom:_NET_WM_STRUT_PARTIAL ;; xcb:Atom:_NET_WM_ICON_GEOMETRY ;; xcb:Atom:_NET_WM_ICON xcb:Atom:_NET_WM_PID ;; xcb:Atom:_NET_WM_HANDLED_ICONS ;; xcb:Atom:_NET_WM_USER_TIME ;; xcb:Atom:_NET_WM_USER_TIME_WINDOW xcb:Atom:_NET_FRAME_EXTENTS ;; xcb:Atom:_NET_WM_OPAQUE_REGION ;; xcb:Atom:_NET_WM_BYPASS_COMPOSITOR ;; Window manager protocols. xcb:Atom:_NET_WM_PING ;; xcb:Atom:_NET_WM_SYNC_REQUEST ;; xcb:Atom:_NET_WM_FULLSCREEN_MONITORS ;; Other properties. xcb:Atom:_NET_WM_FULL_PLACEMENT))) ;; Create a child window for setting _NET_SUPPORTING_WM_CHECK (let ((new-id (xcb:generate-id exwm--connection))) (setq exwm--guide-window new-id) (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 :wid new-id :parent exwm--root :x -1 :y -1 :width 1 :height 1 :border-width 0 :class xcb:WindowClass:InputOnly :visual 0 :value-mask xcb:CW:OverrideRedirect :override-redirect 1)) ;; Set _NET_WM_NAME. Must be set to the name of the window manager, as ;; required by wm-spec. (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window new-id :data "EXWM")) (dolist (i (list exwm--root new-id)) ;; Set _NET_SUPPORTING_WM_CHECK (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_SUPPORTING_WM_CHECK :window i :data new-id)))) ;; Set _NET_DESKTOP_VIEWPORT (we don't support large desktop). (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT :window exwm--root :data [0 0])) (xcb:flush exwm--connection)) (defun exwm--wmsn-acquire (replace) "Acquire the WM_Sn selection. REPLACE specifies what to do in case there already is a window manager. If t, replace it, if nil, abort and ask the user if `ask'." (exwm--log "%s" replace) (with-slots (owner) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetSelectionOwner :selection xcb:Atom:WM_S0)) (when (/= owner xcb:Window:None) (when (eq replace 'ask) (setq replace (yes-or-no-p "Replace existing window manager? "))) (when (not replace) (user-error "Other window manager detected"))) (let ((new-owner (xcb:generate-id exwm--connection))) (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 :wid new-owner :parent exwm--root :x -1 :y -1 :width 1 :height 1 :border-width 0 :class xcb:WindowClass:CopyFromParent :visual 0 :value-mask 0 :override-redirect 0)) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window new-owner :data "EXWM: exwm--wmsn-window")) (xcb:+request-checked+request-check exwm--connection (make-instance 'xcb:SetSelectionOwner :selection xcb:Atom:WM_S0 :owner new-owner :time xcb:Time:CurrentTime)) (with-slots (owner) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetSelectionOwner :selection xcb:Atom:WM_S0)) (unless (eq owner new-owner) (error "Could not acquire ownership of WM selection"))) ;; Wait for the other window manager to terminate. (when (/= owner xcb:Window:None) (let (reply) (cl-dotimes (i exwm--wmsn-acquire-timeout) (setq reply (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable owner))) (when (not reply) (cl-return)) (message "Waiting for other window manager to quit... %ds" i) (sleep-for 1)) (when reply (error "Other window manager did not release selection in time")))) ;; announce (let* ((cmd (make-instance 'xcb:ClientMessageData :data32 (vector xcb:Time:CurrentTime xcb:Atom:WM_S0 new-owner 0 0))) (cm (make-instance 'xcb:ClientMessage :window exwm--root :format 32 :type xcb:Atom:MANAGER :data cmd)) (se (make-instance 'xcb:SendEvent :propagate 0 :destination exwm--root :event-mask xcb:EventMask:NoEvent :event (xcb:marshal cm exwm--connection)))) (xcb:+request exwm--connection se)) (setq exwm--wmsn-window new-owner)))) ;;;###autoload (cl-defun exwm-init (&optional frame) "Initialize EXWM." (interactive) (exwm--log "%s" frame) (if frame ;; The frame might not be selected if it's created by emacslicnet. (select-frame-set-input-focus frame) (setq frame (selected-frame))) (when (not (eq 'x (framep frame))) (message "[EXWM] Not running under X environment") (cl-return-from exwm-init)) (when exwm--connection (exwm--log "EXWM already running") (cl-return-from exwm-init)) (condition-case err (progn (exwm-enable 'undo) ;never initialize again (setq exwm--connection (xcb:connect)) (set-process-query-on-exit-flag (slot-value exwm--connection 'process) nil) ;prevent query message on exit (setq exwm--root (slot-value (car (slot-value (xcb:get-setup exwm--connection) 'roots)) 'root)) ;; Initialize ICCCM/EWMH support (xcb:icccm:init exwm--connection t) (xcb:ewmh:init exwm--connection t) ;; Try to register window manager selection. (exwm--wmsn-acquire exwm-replace) (when (xcb:+request-checked+request-check exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window exwm--root :value-mask xcb:CW:EventMask :event-mask xcb:EventMask:SubstructureRedirect)) (error "Other window manager is running")) ;; Disable some features not working well with EXWM (setq use-dialog-box nil confirm-kill-emacs #'exwm--confirm-kill-emacs) (exwm--lock) (exwm--init-icccm-ewmh) (exwm-layout--init) (exwm-floating--init) (exwm-manage--init) (exwm-workspace--init) (exwm-input--init) (exwm--unlock) (exwm-workspace--post-init) (exwm-input--post-init) (run-hooks 'exwm-init-hook) ;; Manage existing windows (exwm-manage--scan)) (user-error) ((quit error) (exwm-exit) ;; Rethrow error (warn "[EXWM] EXWM fails to start (%s: %s)" (car err) (cdr err))))) ;;;###autoload (defun exwm-exit () "Exit EXWM." (interactive) (exwm--log) (run-hooks 'exwm-exit-hook) (setq confirm-kill-emacs nil) ;; Exit modules. (exwm-input--exit) (exwm-manage--exit) (exwm-workspace--exit) (exwm-floating--exit) (exwm-layout--exit) (when exwm--connection (xcb:flush exwm--connection) (xcb:disconnect exwm--connection)) (setq exwm--connection nil)) ;;;###autoload (defun exwm-enable (&optional undo) "Enable/Disable EXWM." (exwm--log "%s" undo) (pcase undo (`undo ;prevent reinitialization (remove-hook 'window-setup-hook #'exwm-init) (remove-hook 'after-make-frame-functions #'exwm-init)) (`undo-all ;attempt to revert everything (remove-hook 'window-setup-hook #'exwm-init) (remove-hook 'after-make-frame-functions #'exwm-init) (remove-hook 'kill-emacs-hook #'exwm--server-stop) (dolist (i exwm-blocking-subrs) (advice-remove i #'exwm--server-eval-at))) (_ ;enable EXWM (setq frame-resize-pixelwise t ;mandatory; before init window-resize-pixelwise t) ;; Ignore unrecognized command line arguments. This can be helpful ;; when EXWM is launched by some session manager. (push #'vector command-line-functions) ;; In case EXWM is to be started from a graphical Emacs instance. (add-hook 'window-setup-hook #'exwm-init t) ;; In case EXWM is to be started with emacsclient. (add-hook 'after-make-frame-functions #'exwm-init t) ;; Manage the subordinate Emacs server. (add-hook 'kill-emacs-hook #'exwm--server-stop) (dolist (i exwm-blocking-subrs) (advice-add i :around #'exwm--server-eval-at))))) (defun exwm--server-stop () "Stop the subordinate Emacs server." (exwm--log) (server-force-delete exwm--server-name) (when exwm--server-process (delete-process exwm--server-process) (setq exwm--server-process nil))) (defun exwm--server-eval-at (&rest args) "Wrapper of `server-eval-at' used to advice subrs." ;; Start the subordinate Emacs server if it's not alive (exwm--log "%s" args) (unless (server-running-p exwm--server-name) (when exwm--server-process (delete-process exwm--server-process)) (setq exwm--server-process (start-process exwm--server-name nil (car command-line-args) ;The executable file "-d" (frame-parameter nil 'display) "-Q" (concat "--daemon=" exwm--server-name) "--eval" ;; Create an invisible frame "(make-frame '((window-system . x) (visibility)))")) (while (not (server-running-p exwm--server-name)) (sit-for 0.001))) (server-eval-at exwm--server-name `(progn (select-frame (car (frame-list))) (let ((result ,(nconc (list (make-symbol (subr-name (car args)))) (cdr args)))) (pcase (type-of result) ;; Return the name of a buffer (`buffer (buffer-name result)) ;; We blindly convert all font objects to their XLFD names. This ;; might cause problems of course, but it still has a chance to ;; work (whereas directly passing font objects would merely ;; raise errors). ((or `font-entity `font-object `font-spec) (font-xlfd-name result)) ;; Passing following types makes little sense ((or `compiled-function `finalizer `frame `hash-table `marker `overlay `process `window `window-configuration)) ;; Passing the name of a subr (`subr (make-symbol (subr-name result))) ;; For other types, return the value as-is. (t result)))))) (defun exwm--confirm-kill-emacs (prompt &optional force) "Confirm before exiting Emacs." (exwm--log) (when (cond ((and force (not (eq force 'no-check))) ;; Force killing Emacs. t) ((or (eq force 'no-check) (not exwm--id-buffer-alist)) ;; Check if there's any unsaved file. (pcase (catch 'break (let ((kill-emacs-query-functions (append kill-emacs-query-functions (list (lambda () (throw 'break 'break)))))) (save-buffers-kill-emacs))) (`break (y-or-n-p prompt)) (x x))) (t (yes-or-no-p (format "[EXWM] %d window(s) will be destroyed. %s" (length exwm--id-buffer-alist) prompt)))) ;; Run `kill-emacs-hook' (`server-force-stop' excluded) before Emacs ;; frames are unmapped so that errors (if any) can be visible. (if (memq #'server-force-stop kill-emacs-hook) (progn (setq kill-emacs-hook (delq #'server-force-stop kill-emacs-hook)) (run-hooks 'kill-emacs-hook) (setq kill-emacs-hook (list #'server-force-stop))) (run-hooks 'kill-emacs-hook) (setq kill-emacs-hook nil)) ;; Exit each module, destroying all resources created by this connection. (exwm-exit) ;; Set the return value. t)) (provide 'exwm) ;;; exwm.el ends here exwm-0.26/xinitrc000066400000000000000000000007561414260560000140320ustar00rootroot00000000000000# Disable access control for the current user. xhost +SI:localuser:$USER # Make Java applications aware this is a non-reparenting window manager. export _JAVA_AWT_WM_NONREPARENTING=1 # Set default cursor. xsetroot -cursor_name left_ptr # Set keyboard repeat rate. xset r rate 200 60 # Uncomment the following block to use the exwm-xim module. #export XMODIFIERS=@im=exwm-xim #export GTK_IM_MODULE=xim #export QT_IM_MODULE=xim #export CLUTTER_IM_MODULE=xim # Finally start Emacs exec emacs