587a8cad1d
* exwm.el (exwm-reset): Remove autoload cookie. (exwm-init, exwm-exit): Add autoload cookie and interactive declaration.
869 lines
37 KiB
EmacsLisp
869 lines
37 KiB
EmacsLisp
;;; exwm.el --- Emacs X Window Manager -*- lexical-binding: t -*-
|
||
|
||
;; Copyright (C) 2015-2018 Free Software Foundation, Inc.
|
||
|
||
;; Author: Chris Feng <chris.w.feng@gmail.com>
|
||
;; Maintainer: Chris Feng <chris.w.feng@gmail.com>
|
||
;; Version: 0.17
|
||
;; Package-Requires: ((xelb "0.13"))
|
||
;; Keywords: unix
|
||
;; URL: https://github.com/ch11ng/exwm
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Overview
|
||
;; --------
|
||
;; EXWM (Emacs X Window Manager) is a full-featured tiling X window manager
|
||
;; for Emacs built on top of [XELB](https://github.com/ch11ng/xelb).
|
||
;; It features:
|
||
;; + Fully keyboard-driven operations
|
||
;; + Hybrid layout modes (tiling & stacking)
|
||
;; + Dynamic workspace support
|
||
;; + ICCCM/EWMH compliance
|
||
;; + (Optional) RandR (multi-monitor) support
|
||
;; + (Optional) Built-in system tray
|
||
|
||
;; Installation & configuration
|
||
;; ----------------------------
|
||
;; Here are the minimal steps to get EXWM working:
|
||
;; 1. Install XELB and EXWM, and make sure they are in `load-path'.
|
||
;; 2. In '~/.emacs', add following lines (please modify accordingly):
|
||
;;
|
||
;; (require 'exwm)
|
||
;; (require 'exwm-config)
|
||
;; (exwm-config-default)
|
||
;;
|
||
;; 3. Link or copy the file 'xinitrc' to '~/.xinitrc'.
|
||
;; 4. Launch EXWM in a console (e.g. tty1) with
|
||
;;
|
||
;; xinit -- vt01
|
||
;;
|
||
;; You should additionally hide the menu-bar, tool-bar, etc to increase the
|
||
;; usable space. Please check the wiki (https://github.com/ch11ng/exwm/wiki)
|
||
;; for more detailed instructions on installation, configuration, usage, etc.
|
||
|
||
;; References:
|
||
;; + dwm (http://dwm.suckless.org/)
|
||
;; + i3 wm (https://i3wm.org/)
|
||
;; + Also see references within each required library.
|
||
|
||
;;; Code:
|
||
|
||
(require 'server)
|
||
(require 'exwm-core)
|
||
(require 'exwm-workspace)
|
||
(require 'exwm-layout)
|
||
(require 'exwm-floating)
|
||
(require 'exwm-manage)
|
||
(require 'exwm-input)
|
||
|
||
(defgroup exwm nil
|
||
"Emacs X Window Manager."
|
||
:tag "EXWM"
|
||
:version "25.3"
|
||
:group 'applications
|
||
:prefix "exwm-")
|
||
|
||
(defcustom exwm-init-hook nil
|
||
"Normal hook run when EXWM has just finished initialization."
|
||
:type 'hook)
|
||
|
||
(defcustom exwm-exit-hook nil
|
||
"Normal hook run just before EXWM exits."
|
||
:type 'hook)
|
||
|
||
(defcustom exwm-update-class-hook nil
|
||
"Normal hook run when window class is updated."
|
||
:type 'hook)
|
||
|
||
(defcustom exwm-update-title-hook nil
|
||
"Normal hook run when window title is updated."
|
||
:type 'hook)
|
||
|
||
(defcustom exwm-blocking-subrs '(x-file-dialog x-popup-dialog x-select-font)
|
||
"Subrs (primitives) that would normally block EXWM."
|
||
:type '(repeat function))
|
||
|
||
(defconst exwm--server-name "server-exwm"
|
||
"Name of the subordinate Emacs server.")
|
||
|
||
(defvar exwm--server-process nil "Process of the subordinate Emacs server.")
|
||
|
||
(defun exwm-reset ()
|
||
"Reset the state of the selected window (non-fullscreen, line-mode, etc)."
|
||
(interactive)
|
||
(with-current-buffer (window-buffer)
|
||
(when (eq major-mode 'exwm-mode)
|
||
(when (exwm-layout--fullscreen-p)
|
||
(exwm-layout-unset-fullscreen))
|
||
;; Force refresh
|
||
(exwm-layout--refresh)
|
||
(call-interactively #'exwm-input-grab-keyboard))))
|
||
|
||
;;;###autoload
|
||
(defun exwm-restart ()
|
||
"Restart EXWM."
|
||
(interactive)
|
||
(when (exwm--confirm-kill-emacs "[EXWM] Restart? " 'no-check)
|
||
(let* ((attr (process-attributes (emacs-pid)))
|
||
(args (cdr (assq 'args attr)))
|
||
(ppid (cdr (assq 'ppid attr)))
|
||
(pargs (cdr (assq 'args (process-attributes ppid)))))
|
||
(cond
|
||
((= ppid 1)
|
||
;; The parent is the init process. This probably means this
|
||
;; instance is an emacsclient. Anyway, start a control instance
|
||
;; to manage the subsequent ones.
|
||
(call-process (car command-line-args))
|
||
(kill-emacs))
|
||
((string= args pargs)
|
||
;; This is a subordinate instance. Return a magic number to
|
||
;; inform the parent (control instance) to start another one.
|
||
(kill-emacs ?R))
|
||
(t
|
||
;; This is the control instance. Keep starting subordinate
|
||
;; instances until told to exit.
|
||
;; Run `server-force-stop' if it exists.
|
||
(run-hooks 'kill-emacs-hook)
|
||
(with-temp-buffer
|
||
(while (= ?R (shell-command-on-region (point) (point) args))))
|
||
(kill-emacs))))))
|
||
|
||
(defun exwm--update-desktop (xwin)
|
||
"Update _NET_WM_DESKTOP."
|
||
(with-current-buffer (exwm--id->buffer xwin)
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:ewmh:get-_NET_WM_DESKTOP
|
||
:window xwin)))
|
||
desktop)
|
||
(when reply
|
||
(setq desktop (slot-value reply 'value))
|
||
(cond
|
||
((eq desktop #xffffffff)
|
||
(unless (or (not exwm--floating-frame)
|
||
(eq exwm--frame exwm-workspace--current)
|
||
(and exwm--desktop
|
||
(= desktop exwm--desktop)))
|
||
(exwm-layout--show xwin (frame-root-window exwm--floating-frame)))
|
||
(setq exwm--desktop desktop))
|
||
((and desktop
|
||
(< desktop (exwm-workspace--count))
|
||
(if exwm--desktop
|
||
(/= desktop exwm--desktop)
|
||
(/= desktop (exwm-workspace--position exwm--frame))))
|
||
(exwm-workspace-move-window desktop xwin))
|
||
(t
|
||
(exwm-workspace--set-desktop xwin)))))))
|
||
|
||
(defun exwm--update-window-type (id &optional force)
|
||
"Update _NET_WM_WINDOW_TYPE."
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless (and exwm-window-type (not force))
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:ewmh:get-_NET_WM_WINDOW_TYPE
|
||
:window id))))
|
||
(when reply ;nil when destroyed
|
||
(setq exwm-window-type (append (slot-value reply 'value) nil)))))))
|
||
|
||
(defun exwm--update-class (id &optional force)
|
||
"Update WM_CLASS."
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless (and exwm-instance-name exwm-class-name (not force))
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:icccm:get-WM_CLASS :window id))))
|
||
(when reply ;nil when destroyed
|
||
(setq exwm-instance-name (slot-value reply 'instance-name)
|
||
exwm-class-name (slot-value reply 'class-name))
|
||
(when (and exwm-instance-name exwm-class-name)
|
||
(run-hooks 'exwm-update-class-hook)))))))
|
||
|
||
(defun exwm--update-utf8-title (id &optional force)
|
||
"Update _NET_WM_NAME."
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(when (or force (not exwm-title))
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:ewmh:get-_NET_WM_NAME :window id))))
|
||
(when reply ;nil when destroyed
|
||
(setq exwm-title (slot-value reply 'value))
|
||
(when exwm-title
|
||
(setq exwm--title-is-utf8 t)
|
||
(run-hooks 'exwm-update-title-hook)))))))
|
||
|
||
(defun exwm--update-ctext-title (id &optional force)
|
||
"Update WM_NAME."
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless (or exwm--title-is-utf8
|
||
(and exwm-title (not force)))
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:icccm:get-WM_NAME :window id))))
|
||
(when reply ;nil when destroyed
|
||
(setq exwm-title (slot-value reply 'value))
|
||
(when exwm-title
|
||
(run-hooks 'exwm-update-title-hook)))))))
|
||
|
||
(defun exwm--update-title (id)
|
||
"Update _NET_WM_NAME or WM_NAME."
|
||
(exwm--update-utf8-title id)
|
||
(exwm--update-ctext-title id))
|
||
|
||
(defun exwm--update-transient-for (id &optional force)
|
||
"Update WM_TRANSIENT_FOR."
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless (and exwm-transient-for (not force))
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:icccm:get-WM_TRANSIENT_FOR
|
||
:window id))))
|
||
(when reply ;nil when destroyed
|
||
(setq exwm-transient-for (slot-value reply 'value)))))))
|
||
|
||
(defun exwm--update-normal-hints (id &optional force)
|
||
"Update WM_NORMAL_HINTS."
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless (and (not force)
|
||
(or exwm--normal-hints-x exwm--normal-hints-y
|
||
exwm--normal-hints-width exwm--normal-hints-height
|
||
exwm--normal-hints-min-width exwm--normal-hints-min-height
|
||
exwm--normal-hints-max-width exwm--normal-hints-max-height
|
||
;; FIXME: other fields
|
||
))
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:icccm:get-WM_NORMAL_HINTS
|
||
:window id))))
|
||
(when (and reply (slot-value reply 'flags)) ;nil when destroyed
|
||
(with-slots (flags x y width height min-width min-height max-width
|
||
max-height base-width base-height ;; win-gravity
|
||
)
|
||
reply
|
||
(unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:USPosition))
|
||
(setq exwm--normal-hints-x x exwm--normal-hints-y y))
|
||
(unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:USSize))
|
||
(setq exwm--normal-hints-width width
|
||
exwm--normal-hints-height height))
|
||
(unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PMinSize))
|
||
(setq exwm--normal-hints-min-width min-width
|
||
exwm--normal-hints-min-height min-height))
|
||
(unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PMaxSize))
|
||
(setq exwm--normal-hints-max-width max-width
|
||
exwm--normal-hints-max-height max-height))
|
||
(unless (or exwm--normal-hints-min-width
|
||
(= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PBaseSize)))
|
||
(setq exwm--normal-hints-min-width base-width
|
||
exwm--normal-hints-min-height base-height))
|
||
;; (unless (= 0 (logand flags xcb:icccm:WM_SIZE_HINTS:PWinGravity))
|
||
;; (setq exwm--normal-hints-win-gravity win-gravity))
|
||
(setq exwm--fixed-size
|
||
(and exwm--normal-hints-min-width
|
||
exwm--normal-hints-min-height
|
||
exwm--normal-hints-max-width
|
||
exwm--normal-hints-max-height
|
||
(/= 0 exwm--normal-hints-min-width)
|
||
(/= 0 exwm--normal-hints-min-height)
|
||
(= exwm--normal-hints-min-width
|
||
exwm--normal-hints-max-width)
|
||
(= exwm--normal-hints-min-height
|
||
exwm--normal-hints-max-height)))))))))
|
||
|
||
(defun exwm--update-hints (id &optional force)
|
||
"Update WM_HINTS."
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless (and (not force) exwm--hints-input exwm--hints-urgency)
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:icccm:get-WM_HINTS :window id))))
|
||
(when (and reply (slot-value reply 'flags)) ;nil when destroyed
|
||
(with-slots (flags input initial-state) reply
|
||
(when flags
|
||
(unless (= 0 (logand flags xcb:icccm:WM_HINTS:InputHint))
|
||
(setq exwm--hints-input (when input (= 1 input))))
|
||
(unless (= 0 (logand flags xcb:icccm:WM_HINTS:StateHint))
|
||
(setq exwm-state initial-state))
|
||
(unless (= 0 (logand flags xcb:icccm:WM_HINTS:UrgencyHint))
|
||
(setq exwm--hints-urgency t))))
|
||
(when (and exwm--hints-urgency
|
||
(not (eq exwm--frame exwm-workspace--current)))
|
||
(unless (frame-parameter exwm--frame 'exwm-urgency)
|
||
(set-frame-parameter exwm--frame 'exwm-urgency t)
|
||
(setq exwm-workspace--switch-history-outdated t))))))))
|
||
|
||
(defun exwm--update-protocols (id &optional force)
|
||
"Update WM_PROTOCOLS."
|
||
(with-current-buffer (exwm--id->buffer id)
|
||
(unless (and exwm--protocols (not force))
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:icccm:get-WM_PROTOCOLS
|
||
:window id))))
|
||
(when reply ;nil when destroyed
|
||
(setq exwm--protocols (append (slot-value reply 'value) nil)))))))
|
||
|
||
(defun exwm--update-struts-legacy (id)
|
||
"Update _NET_WM_STRUT."
|
||
(let ((pair (assq id exwm-workspace--id-struts-alist))
|
||
reply struts)
|
||
(unless (and pair (< 4 (length (cdr pair))))
|
||
(setq reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:ewmh:get-_NET_WM_STRUT
|
||
:window id)))
|
||
(when reply
|
||
(setq struts (slot-value reply 'value))
|
||
(if pair
|
||
(setcdr pair struts)
|
||
(push (cons id struts) exwm-workspace--id-struts-alist))
|
||
(exwm-workspace--update-struts))
|
||
;; Update workareas.
|
||
(exwm-workspace--update-workareas)
|
||
;; Update workspaces.
|
||
(dolist (f exwm-workspace--list)
|
||
(exwm-workspace--set-fullscreen f)))))
|
||
|
||
(defun exwm--update-struts-partial (id)
|
||
"Update _NET_WM_STRUT_PARTIAL."
|
||
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
||
(make-instance 'xcb:ewmh:get-_NET_WM_STRUT_PARTIAL
|
||
:window id)))
|
||
struts pair)
|
||
(when reply
|
||
(setq struts (slot-value reply 'value)
|
||
pair (assq id exwm-workspace--id-struts-alist))
|
||
(if pair
|
||
(setcdr pair struts)
|
||
(push (cons id struts) exwm-workspace--id-struts-alist))
|
||
(exwm-workspace--update-struts))
|
||
;; Update workareas.
|
||
(exwm-workspace--update-workareas)
|
||
;; Update workspaces.
|
||
(dolist (f exwm-workspace--list)
|
||
(exwm-workspace--set-fullscreen f))))
|
||
|
||
(defun exwm--update-struts (id)
|
||
"Update _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT."
|
||
(exwm--update-struts-partial id)
|
||
(exwm--update-struts-legacy id))
|
||
|
||
(defun exwm--on-PropertyNotify (data _synthetic)
|
||
"Handle PropertyNotify event."
|
||
(let ((obj (make-instance 'xcb:PropertyNotify))
|
||
atom id buffer)
|
||
(xcb:unmarshal obj data)
|
||
(setq id (slot-value obj 'window)
|
||
atom (slot-value obj 'atom))
|
||
(setq buffer (exwm--id->buffer id))
|
||
(if (not (buffer-live-p buffer))
|
||
;; Properties of unmanaged X windows.
|
||
(cond ((= atom xcb:Atom:_NET_WM_STRUT)
|
||
(exwm--update-struts-legacy id))
|
||
((= atom xcb:Atom:_NET_WM_STRUT_PARTIAL)
|
||
(exwm--update-struts-partial id)))
|
||
(with-current-buffer buffer
|
||
(cond ((= atom xcb:Atom:_NET_WM_WINDOW_TYPE)
|
||
(exwm--update-window-type id t))
|
||
((= atom xcb:Atom:WM_CLASS)
|
||
(exwm--update-class id t))
|
||
((= atom xcb:Atom:_NET_WM_NAME)
|
||
(exwm--update-utf8-title id t))
|
||
((= atom xcb:Atom:WM_NAME)
|
||
(exwm--update-ctext-title id t))
|
||
((= atom xcb:Atom:WM_TRANSIENT_FOR)
|
||
(exwm--update-transient-for id t))
|
||
((= atom xcb:Atom:WM_NORMAL_HINTS)
|
||
(exwm--update-normal-hints id t))
|
||
((= atom xcb:Atom:WM_HINTS)
|
||
(exwm--update-hints id t))
|
||
((= atom xcb:Atom:WM_PROTOCOLS)
|
||
(exwm--update-protocols id t))
|
||
((= atom xcb:Atom:_NET_WM_USER_TIME)) ;ignored
|
||
(t (exwm--log "Unhandled PropertyNotify: %s(%d)"
|
||
(x-get-atom-name atom exwm-workspace--current)
|
||
atom)))))))
|
||
|
||
(defun exwm--on-ClientMessage (raw-data _synthetic)
|
||
"Handle ClientMessage event."
|
||
(let ((obj (make-instance 'xcb:ClientMessage))
|
||
type id data)
|
||
(xcb:unmarshal obj raw-data)
|
||
(setq type (slot-value obj 'type)
|
||
id (slot-value obj 'window)
|
||
data (slot-value (slot-value obj 'data) 'data32))
|
||
(cond
|
||
;; _NET_NUMBER_OF_DESKTOPS.
|
||
((= type xcb:Atom:_NET_NUMBER_OF_DESKTOPS)
|
||
(let ((current (exwm-workspace--count))
|
||
(requested (elt data 0)))
|
||
;; Only allow increasing/decreasing the workspace number by 1.
|
||
(cond
|
||
((< current requested)
|
||
(make-frame))
|
||
((and (> current requested)
|
||
(> current 1))
|
||
(delete-frame (car (last exwm-workspace--list)))))))
|
||
;; _NET_CURRENT_DESKTOP.
|
||
((= type xcb:Atom:_NET_CURRENT_DESKTOP)
|
||
(exwm-workspace-switch (elt data 0)))
|
||
;; _NET_ACTIVE_WINDOW.
|
||
((= type xcb:Atom:_NET_ACTIVE_WINDOW)
|
||
(let ((buffer (exwm--id->buffer id)))
|
||
(when (buffer-live-p buffer)
|
||
(with-current-buffer buffer
|
||
(when (eq exwm--frame exwm-workspace--current)
|
||
(when (exwm-layout--iconic-state-p)
|
||
;; State change: iconic => normal.
|
||
(set-window-buffer (frame-selected-window exwm--frame)
|
||
(current-buffer)))
|
||
;; Focus transfer.
|
||
(select-window (get-buffer-window nil t)))))))
|
||
;; _NET_CLOSE_WINDOW.
|
||
((= type xcb:Atom:_NET_CLOSE_WINDOW)
|
||
(let ((buffer (exwm--id->buffer id)))
|
||
(when (buffer-live-p buffer)
|
||
(kill-buffer buffer))))
|
||
;; _NET_WM_MOVERESIZE
|
||
((= type xcb:Atom:_NET_WM_MOVERESIZE)
|
||
(let ((direction (elt data 2))
|
||
(buffer (exwm--id->buffer id)))
|
||
(unless (and buffer
|
||
(not (buffer-local-value 'exwm--floating-frame buffer)))
|
||
(cond ((= direction
|
||
xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_KEYBOARD)
|
||
;; FIXME
|
||
)
|
||
((= direction
|
||
xcb:ewmh:_NET_WM_MOVERESIZE_MOVE_KEYBOARD)
|
||
;; FIXME
|
||
)
|
||
((= direction xcb:ewmh:_NET_WM_MOVERESIZE_CANCEL)
|
||
(exwm-floating--stop-moveresize))
|
||
(t (exwm-floating--start-moveresize id direction))))))
|
||
;; _NET_REQUEST_FRAME_EXTENTS
|
||
((= type xcb:Atom:_NET_REQUEST_FRAME_EXTENTS)
|
||
(let ((buffer (exwm--id->buffer id))
|
||
top btm)
|
||
(if (or (not buffer)
|
||
(not (buffer-local-value 'exwm--floating-frame buffer)))
|
||
(setq top 0
|
||
btm 0)
|
||
(setq top (window-header-line-height)
|
||
btm (window-mode-line-height)))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ewmh:set-_NET_FRAME_EXTENTS
|
||
:window id
|
||
:left 0
|
||
:right 0
|
||
:top top
|
||
:bottom btm)))
|
||
(xcb:flush exwm--connection))
|
||
;; _NET_WM_DESKTOP.
|
||
((= type xcb:Atom:_NET_WM_DESKTOP)
|
||
(let ((buffer (exwm--id->buffer id)))
|
||
(when (buffer-live-p buffer)
|
||
(exwm-workspace-move-window (elt data 0) id))))
|
||
;; _NET_WM_STATE
|
||
((= type xcb:Atom:_NET_WM_STATE)
|
||
(let ((action (elt data 0))
|
||
(props (list (elt data 1) (elt data 2)))
|
||
(buffer (exwm--id->buffer id))
|
||
props-new)
|
||
;; only support _NET_WM_STATE_FULLSCREEN / _NET_WM_STATE_ADD for frames
|
||
(when (and (not buffer)
|
||
(memq xcb:Atom:_NET_WM_STATE_FULLSCREEN props)
|
||
(= action xcb:ewmh:_NET_WM_STATE_ADD))
|
||
(xcb:+request
|
||
exwm--connection
|
||
(make-instance 'xcb:ewmh:set-_NET_WM_STATE
|
||
:window id
|
||
:data (vector xcb:Atom:_NET_WM_STATE_FULLSCREEN)))
|
||
(xcb:flush exwm--connection))
|
||
(when buffer ;ensure it's managed
|
||
(with-current-buffer buffer
|
||
;; _NET_WM_STATE_FULLSCREEN
|
||
(when (or (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN props)
|
||
(memq xcb:Atom:_NET_WM_STATE_ABOVE props))
|
||
(cond ((= action xcb:ewmh:_NET_WM_STATE_ADD)
|
||
(unless (exwm-layout--fullscreen-p)
|
||
(exwm-layout-set-fullscreen id))
|
||
(push xcb:Atom:_NET_WM_STATE_FULLSCREEN props-new))
|
||
((= action xcb:ewmh:_NET_WM_STATE_REMOVE)
|
||
(when (exwm-layout--fullscreen-p)
|
||
(exwm-layout-unset-fullscreen id)))
|
||
((= action xcb:ewmh:_NET_WM_STATE_TOGGLE)
|
||
(if (exwm-layout--fullscreen-p)
|
||
(exwm-layout-unset-fullscreen id)
|
||
(exwm-layout-set-fullscreen id)
|
||
(push xcb:Atom:_NET_WM_STATE_FULLSCREEN props-new)))))
|
||
;; _NET_WM_STATE_DEMANDS_ATTENTION
|
||
;; FIXME: check (may require other properties set)
|
||
(when (memq xcb:Atom:_NET_WM_STATE_DEMANDS_ATTENTION props)
|
||
(when (= action xcb:ewmh:_NET_WM_STATE_ADD)
|
||
(unless (eq exwm--frame exwm-workspace--current)
|
||
(set-frame-parameter exwm--frame 'exwm-urgency t)
|
||
(setq exwm-workspace--switch-history-outdated t)))
|
||
;; xcb:ewmh:_NET_WM_STATE_REMOVE?
|
||
;; xcb:ewmh:_NET_WM_STATE_TOGGLE?
|
||
)
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ewmh:set-_NET_WM_STATE
|
||
:window id :data (vconcat props-new)))
|
||
(xcb:flush exwm--connection)))))
|
||
((= type xcb:Atom:WM_PROTOCOLS)
|
||
(let ((type (elt data 0)))
|
||
(cond ((= type xcb:Atom:_NET_WM_PING)
|
||
(setq exwm-manage--ping-lock nil))
|
||
(t (exwm--log "Unhandled WM_PROTOCOLS of type: %d" type)))))
|
||
((= type xcb:Atom:WM_CHANGE_STATE)
|
||
(let ((buffer (exwm--id->buffer id)))
|
||
(when (and (buffer-live-p buffer)
|
||
(= (elt data 0) xcb:icccm:WM_STATE:IconicState))
|
||
(with-current-buffer buffer
|
||
(bury-buffer)))))
|
||
(t (exwm--log "Unhandled client message: %s" obj)))))
|
||
|
||
(defun exwm--init-icccm-ewmh ()
|
||
"Initialize ICCCM/EWMH support."
|
||
;; Handle PropertyNotify event
|
||
(xcb:+event exwm--connection 'xcb:PropertyNotify #'exwm--on-PropertyNotify)
|
||
;; Handle relevant client messages
|
||
(xcb:+event exwm--connection 'xcb:ClientMessage #'exwm--on-ClientMessage)
|
||
;; Set _NET_SUPPORTED
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ewmh:set-_NET_SUPPORTED
|
||
:window exwm--root
|
||
:data (vector
|
||
;; Root windows properties.
|
||
xcb:Atom:_NET_SUPPORTED
|
||
xcb:Atom:_NET_CLIENT_LIST
|
||
xcb:Atom:_NET_CLIENT_LIST_STACKING
|
||
xcb:Atom:_NET_NUMBER_OF_DESKTOPS
|
||
xcb:Atom:_NET_DESKTOP_GEOMETRY
|
||
xcb:Atom:_NET_DESKTOP_VIEWPORT
|
||
xcb:Atom:_NET_CURRENT_DESKTOP
|
||
;; xcb:Atom:_NET_DESKTOP_NAMES
|
||
xcb:Atom:_NET_ACTIVE_WINDOW
|
||
;; xcb:Atom:_NET_WORKAREA
|
||
xcb:Atom:_NET_SUPPORTING_WM_CHECK
|
||
;; xcb:Atom:_NET_VIRTUAL_ROOTS
|
||
;; xcb:Atom:_NET_DESKTOP_LAYOUT
|
||
;; xcb:Atom:_NET_SHOWING_DESKTOP
|
||
|
||
;; Other root window messages.
|
||
xcb:Atom:_NET_CLOSE_WINDOW
|
||
;; xcb:Atom:_NET_MOVERESIZE_WINDOW
|
||
xcb:Atom:_NET_WM_MOVERESIZE
|
||
;; xcb:Atom:_NET_RESTACK_WINDOW
|
||
xcb:Atom:_NET_REQUEST_FRAME_EXTENTS
|
||
|
||
;; Application window properties.
|
||
xcb:Atom:_NET_WM_NAME
|
||
;; xcb:Atom:_NET_WM_VISIBLE_NAME
|
||
;; xcb:Atom:_NET_WM_ICON_NAME
|
||
;; xcb:Atom:_NET_WM_VISIBLE_ICON_NAME
|
||
xcb:Atom:_NET_WM_DESKTOP
|
||
;;
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE
|
||
;; xcb:Atom:_NET_WM_WINDOW_TYPE_DESKTOP
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLBAR
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_MENU
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_DROPDOWN_MENU
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_POPUP_MENU
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLTIP
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_NOTIFICATION
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_COMBO
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_DND
|
||
xcb:Atom:_NET_WM_WINDOW_TYPE_NORMAL
|
||
;;
|
||
xcb:Atom:_NET_WM_STATE
|
||
;; xcb:Atom:_NET_WM_STATE_MODAL
|
||
;; xcb:Atom:_NET_WM_STATE_STICKY
|
||
;; xcb:Atom:_NET_WM_STATE_MAXIMIZED_VERT
|
||
;; xcb:Atom:_NET_WM_STATE_MAXIMIZED_HORZ
|
||
;; xcb:Atom:_NET_WM_STATE_SHADED
|
||
;; xcb:Atom:_NET_WM_STATE_SKIP_TASKBAR
|
||
;; xcb:Atom:_NET_WM_STATE_SKIP_PAGER
|
||
;; xcb:Atom:_NET_WM_STATE_HIDDEN
|
||
xcb:Atom:_NET_WM_STATE_FULLSCREEN
|
||
;; xcb:Atom:_NET_WM_STATE_ABOVE
|
||
;; xcb:Atom:_NET_WM_STATE_BELOW
|
||
xcb:Atom:_NET_WM_STATE_DEMANDS_ATTENTION
|
||
;; xcb:Atom:_NET_WM_STATE_FOCUSED
|
||
;;
|
||
xcb:Atom:_NET_WM_ALLOWED_ACTIONS
|
||
xcb:Atom:_NET_WM_ACTION_MOVE
|
||
xcb:Atom:_NET_WM_ACTION_RESIZE
|
||
xcb:Atom:_NET_WM_ACTION_MINIMIZE
|
||
;; xcb:Atom:_NET_WM_ACTION_SHADE
|
||
;; xcb:Atom:_NET_WM_ACTION_STICK
|
||
;; xcb:Atom:_NET_WM_ACTION_MAXIMIZE_HORZ
|
||
;; xcb:Atom:_NET_WM_ACTION_MAXIMIZE_VERT
|
||
xcb:Atom:_NET_WM_ACTION_FULLSCREEN
|
||
xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP
|
||
xcb:Atom:_NET_WM_ACTION_CLOSE
|
||
;; xcb:Atom:_NET_WM_ACTION_ABOVE
|
||
;; xcb:Atom:_NET_WM_ACTION_BELOW
|
||
;;
|
||
xcb:Atom:_NET_WM_STRUT
|
||
xcb:Atom:_NET_WM_STRUT_PARTIAL
|
||
;; xcb:Atom:_NET_WM_ICON_GEOMETRY
|
||
;; xcb:Atom:_NET_WM_ICON
|
||
xcb:Atom:_NET_WM_PID
|
||
;; xcb:Atom:_NET_WM_HANDLED_ICONS
|
||
;; xcb:Atom:_NET_WM_USER_TIME
|
||
;; xcb:Atom:_NET_WM_USER_TIME_WINDOW
|
||
xcb:Atom:_NET_FRAME_EXTENTS
|
||
;; xcb:Atom:_NET_WM_OPAQUE_REGION
|
||
;; xcb:Atom:_NET_WM_BYPASS_COMPOSITOR
|
||
|
||
;; Window manager protocols.
|
||
xcb:Atom:_NET_WM_PING
|
||
;; xcb:Atom:_NET_WM_SYNC_REQUEST
|
||
;; xcb:Atom:_NET_WM_FULLSCREEN_MONITORS
|
||
|
||
;; Other properties.
|
||
xcb:Atom:_NET_WM_FULL_PLACEMENT)))
|
||
;; Create a child window for setting _NET_SUPPORTING_WM_CHECK
|
||
(let ((new-id (xcb:generate-id exwm--connection)))
|
||
(setq exwm--guide-window new-id)
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:CreateWindow
|
||
:depth 0
|
||
:wid new-id
|
||
:parent exwm--root
|
||
:x -1
|
||
:y -1
|
||
:width 1
|
||
:height 1
|
||
:border-width 0
|
||
:class xcb:WindowClass:InputOnly
|
||
:visual 0
|
||
:value-mask xcb:CW:OverrideRedirect
|
||
:override-redirect 1))
|
||
(dolist (i (list exwm--root new-id))
|
||
;; Set _NET_SUPPORTING_WM_CHECK
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ewmh:set-_NET_SUPPORTING_WM_CHECK
|
||
:window i :data new-id))
|
||
;; Set _NET_WM_NAME
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
|
||
:window i :data "EXWM"))))
|
||
;; Set _NET_DESKTOP_VIEWPORT (we don't support large desktop).
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT
|
||
:window exwm--root
|
||
:data [0 0]))
|
||
(xcb:flush exwm--connection))
|
||
|
||
(defun exwm--exit-icccm-ewmh ()
|
||
"Remove ICCCM/EWMH properties."
|
||
(dolist (p (list
|
||
xcb:Atom:_NET_WM_NAME
|
||
xcb:Atom:_NET_SUPPORTED
|
||
xcb:Atom:_NET_CLIENT_LIST
|
||
xcb:Atom:_NET_CLIENT_LIST_STACKING
|
||
xcb:Atom:_NET_NUMBER_OF_DESKTOPS
|
||
xcb:Atom:_NET_DESKTOP_GEOMETRY
|
||
xcb:Atom:_NET_DESKTOP_VIEWPORT
|
||
xcb:Atom:_NET_CURRENT_DESKTOP
|
||
xcb:Atom:_NET_ACTIVE_WINDOW
|
||
xcb:Atom:_NET_SUPPORTING_WM_CHECK
|
||
;; TODO: Keep this list synchronized with that in
|
||
;; `exwm--init-icccm-ewmh'.
|
||
))
|
||
(xcb:+request exwm--connection
|
||
(make-instance 'xcb:DeleteProperty
|
||
:window exwm--root
|
||
:property p))
|
||
(xcb:flush exwm--connection)))
|
||
|
||
;;;###autoload
|
||
(defun exwm-init (&optional frame)
|
||
"Initialize EXWM."
|
||
(interactive)
|
||
(if frame
|
||
;; The frame might not be selected if it's created by emacslicnet.
|
||
(select-frame-set-input-focus frame)
|
||
(setq frame (selected-frame)))
|
||
(if (not (eq 'x (framep frame)))
|
||
(exwm--log "Not running under X environment")
|
||
(unless exwm--connection
|
||
(exwm-enable 'undo) ;never initialize again
|
||
(setq exwm--connection (xcb:connect))
|
||
(set-process-query-on-exit-flag (slot-value exwm--connection 'process)
|
||
nil) ;prevent query message on exit
|
||
(setq exwm--root
|
||
(slot-value (car (slot-value
|
||
(xcb:get-setup exwm--connection) 'roots))
|
||
'root))
|
||
(if (xcb:+request-checked+request-check exwm--connection
|
||
(make-instance 'xcb:ChangeWindowAttributes
|
||
:window exwm--root :value-mask xcb:CW:EventMask
|
||
:event-mask xcb:EventMask:SubstructureRedirect))
|
||
;; Other window manager is running
|
||
(progn (xcb:disconnect exwm--connection)
|
||
(setq exwm--connection nil)
|
||
(exwm--log "Other window manager detected"))
|
||
;; Disable some features not working well with EXWM
|
||
(setq use-dialog-box nil
|
||
confirm-kill-emacs #'exwm--confirm-kill-emacs)
|
||
;; Initialize ICCCM/EWMH support
|
||
(xcb:icccm:init exwm--connection t)
|
||
(xcb:ewmh:init exwm--connection t)
|
||
(exwm--lock)
|
||
(exwm--init-icccm-ewmh)
|
||
(exwm-layout--init)
|
||
(exwm-floating--init)
|
||
(exwm-manage--init)
|
||
(exwm-workspace--init)
|
||
(exwm-input--init)
|
||
(exwm--unlock)
|
||
(exwm-workspace--post-init)
|
||
(exwm-input--post-init)
|
||
;; Manage existing windows
|
||
(exwm-manage--scan)
|
||
(run-hooks 'exwm-init-hook)))))
|
||
|
||
;;;###autoload
|
||
(defun exwm-exit ()
|
||
"Exit EXWM."
|
||
(interactive)
|
||
(run-hooks 'exwm-exit-hook)
|
||
(setq confirm-kill-emacs nil)
|
||
;; Exit modules.
|
||
(exwm-input--exit)
|
||
(exwm-manage--exit)
|
||
(exwm-workspace--exit)
|
||
(exwm-floating--exit)
|
||
(exwm-layout--exit)
|
||
(exwm--exit-icccm-ewmh)
|
||
(xcb:+request-checked+request-check exwm--connection
|
||
(make-instance 'xcb:ChangeWindowAttributes
|
||
:window exwm--root :value-mask xcb:CW:EventMask
|
||
:event-mask xcb:EventMask:NoEvent))
|
||
(xcb:flush exwm--connection)
|
||
(xcb:disconnect exwm--connection)
|
||
(setq exwm--connection nil))
|
||
|
||
(defun exwm-enable (&optional undo)
|
||
"Enable/Disable EXWM."
|
||
(pcase undo
|
||
(`undo ;prevent reinitialization
|
||
(remove-hook 'window-setup-hook #'exwm-init)
|
||
(remove-hook 'after-make-frame-functions #'exwm-init))
|
||
(`undo-all ;attempt to revert everything
|
||
(remove-hook 'window-setup-hook #'exwm-init)
|
||
(remove-hook 'after-make-frame-functions #'exwm-init)
|
||
(remove-hook 'kill-emacs-hook #'exwm--server-stop)
|
||
(dolist (i exwm-blocking-subrs)
|
||
(advice-remove i #'exwm--server-eval-at)))
|
||
(_ ;enable EXWM
|
||
(setq frame-resize-pixelwise t ;mandatory; before init
|
||
window-resize-pixelwise t)
|
||
;; Ignore unrecognized command line arguments. This can be helpful
|
||
;; when EXWM is launched by some session manager.
|
||
(push #'vector command-line-functions)
|
||
(add-hook (if (daemonp)
|
||
'after-make-frame-functions ;emacsclient
|
||
'window-setup-hook) ;emacs
|
||
#'exwm-init t)
|
||
(add-hook 'kill-emacs-hook #'exwm--server-stop)
|
||
(dolist (i exwm-blocking-subrs)
|
||
(advice-add i :around #'exwm--server-eval-at)))))
|
||
|
||
(defun exwm--server-stop ()
|
||
"Stop the subordinate Emacs server."
|
||
(server-force-delete exwm--server-name)
|
||
(when exwm--server-process
|
||
(delete-process exwm--server-process)
|
||
(setq exwm--server-process nil)))
|
||
|
||
(defun exwm--server-eval-at (&rest args)
|
||
"Wrapper of `server-eval-at' used to advice subrs."
|
||
;; Start the subordinate Emacs server if it's not alive
|
||
(unless (server-running-p exwm--server-name)
|
||
(when exwm--server-process (delete-process exwm--server-process))
|
||
(setq exwm--server-process
|
||
(start-process exwm--server-name
|
||
nil
|
||
(car command-line-args) ;The executable file
|
||
"-d" (frame-parameter nil 'display)
|
||
"-Q"
|
||
(concat "--daemon=" exwm--server-name)
|
||
"--eval"
|
||
;; Create an invisible frame
|
||
"(make-frame '((window-system . x) (visibility)))"))
|
||
(while (not (server-running-p exwm--server-name))
|
||
(sit-for 0.001)))
|
||
(server-eval-at
|
||
exwm--server-name
|
||
`(progn (select-frame (car (frame-list)))
|
||
(let ((result ,(nconc (list (make-symbol (subr-name (car args))))
|
||
(cdr args))))
|
||
(pcase (type-of result)
|
||
;; Return the name of a buffer
|
||
(`buffer (buffer-name result))
|
||
;; We blindly convert all font objects to their XLFD names. This
|
||
;; might cause problems of course, but it still has a chance to
|
||
;; work (whereas directly passing font objects would merely
|
||
;; raise errors).
|
||
((or `font-entity `font-object `font-spec)
|
||
(font-xlfd-name result))
|
||
;; Passing following types makes little sense
|
||
((or `compiled-function `finalizer `frame `hash-table `marker
|
||
`overlay `process `window `window-configuration))
|
||
;; Passing the name of a subr
|
||
(`subr (make-symbol (subr-name result)))
|
||
;; For other types, return the value as-is.
|
||
(t result))))))
|
||
|
||
(defun exwm--confirm-kill-emacs (prompt &optional force)
|
||
"Confirm before exiting Emacs."
|
||
(when (cond
|
||
((and force (not (eq force 'no-check)))
|
||
;; Force killing Emacs.
|
||
t)
|
||
((or (eq force 'no-check) (not exwm--id-buffer-alist))
|
||
;; Check if there's any unsaved file.
|
||
(pcase (catch 'break
|
||
(let ((kill-emacs-query-functions
|
||
(append kill-emacs-query-functions
|
||
(list (lambda ()
|
||
(throw 'break 'break))))))
|
||
(save-buffers-kill-emacs)))
|
||
(`break (y-or-n-p prompt))
|
||
(x x)))
|
||
(t
|
||
(yes-or-no-p (format "[EXWM] %d window(s) will be destroyed. %s"
|
||
(length exwm--id-buffer-alist) prompt))))
|
||
;; Run `kill-emacs-hook' (`server-force-stop' excluded) before Emacs
|
||
;; frames are unmapped so that errors (if any) can be visible.
|
||
(if (memq #'server-force-stop kill-emacs-hook)
|
||
(progn
|
||
(setq kill-emacs-hook (delq #'server-force-stop kill-emacs-hook))
|
||
(run-hooks 'kill-emacs-hook)
|
||
(setq kill-emacs-hook (list #'server-force-stop)))
|
||
(run-hooks 'kill-emacs-hook)
|
||
(setq kill-emacs-hook nil))
|
||
;; Exit each module, destroying all resources created by this connection.
|
||
(exwm-exit)
|
||
;; Set the return value.
|
||
t))
|
||
|
||
|
||
|
||
(provide 'exwm)
|
||
|
||
;;; exwm.el ends here
|