chore(3p/emacs/exwm): Import from commit '0368127976'

Imported from 0368127976

git-subtree-dir: third_party/emacs/exwm
git-subtree-mainline: e84f9ef0ad
git-subtree-split: 0368127976
Change-Id: Id3af5610254180f42947d71265aad89def7c6a3d

third_party/emacs/exwm/.elpaignore

@@ -0,0 +1 @@
+README.md

third_party/emacs/exwm/.gitignore

@@ -0,0 +1,3 @@
+*.elc
+*-pkg.el
+*-autoloads.el

third_party/emacs/exwm/README.md

@@ -0,0 +1,21 @@
+# 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).

third_party/emacs/exwm/exwm-cm.el

@@ -0,0 +1,50 @@
+;;; exwm-cm.el --- Compositing Manager for EXWM  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+
+;; Author: Chris Feng <chris.w.feng@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This 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

third_party/emacs/exwm/exwm-config.el

@@ -0,0 +1,131 @@
+;;; exwm-config.el --- Predefined configurations  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+
+;; Author: Chris Feng <chris.w.feng@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This 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

third_party/emacs/exwm/exwm-core.el

@@ -0,0 +1,375 @@
+;;; exwm-core.el --- Core definitions  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+
+;; Author: Chris Feng <chris.w.feng@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This 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 (<X window ID> . <Emacs buffer>).")
+
+(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

third_party/emacs/exwm/exwm-floating.el

@@ -0,0 +1,783 @@
+;;; exwm-floating.el --- Floating Module for EXWM  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+
+;; Author: Chris Feng <chris.w.feng@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This 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

third_party/emacs/exwm/exwm-layout.el

@@ -0,0 +1,620 @@
+;;; exwm-layout.el --- Layout Module for EXWM  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+
+;; Author: Chris Feng <chris.w.feng@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This 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))
+    (setq exwm--ewmh-state
+          (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state))
+    (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))))
+    (setq exwm--ewmh-state
+          (delq 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) 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

third_party/emacs/exwm/exwm-manage.el

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

third_party/emacs/exwm/exwm-randr.el

@@ -0,0 +1,375 @@
+;;; exwm-randr.el --- RandR Module for EXWM  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+
+;; Author: Chris Feng <chris.w.feng@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This 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

third_party/emacs/exwm/exwm-systemtray.el

@@ -0,0 +1,587 @@
+;;; exwm-systemtray.el --- System Tray Module for  -*- lexical-binding: t -*-
+;;;                        EXWM
+
+;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+
+;; Author: Chris Feng <chris.w.feng@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This 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

third_party/emacs/exwm/exwm-xim.el

@@ -0,0 +1,800 @@
+;;; exwm-xim.el --- XIM Module for EXWM  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+;; Author: Chris Feng <chris.w.feng@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This 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)
+
+(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
+              ;; 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

third_party/emacs/exwm/xinitrc

@@ -0,0 +1,20 @@
+# 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