tvl-depot/exwm-workspace.el
Chris Feng 9c95c03e18 Rework the X windows hierarchy model
This commit add workspace and X window containers support to avoid using
Emacs frames as the parents of X windows.  This should make it easier to
set input focus.

* exwm-core.el (exwm--container, exwm--floating-frame-position): New file
local variables.
(exwm--floating-frame-geometry): Removed file local variable.
* exwm-floating.el (exwm-floating--set-floating)
(exwm-floating--unset-floating, exwm-floating--do-moveresize)
(exwm-floating-move): Use container.
(exwm-floating--fit-frame-to-window): No longer adjust stacking order.
(exwm-floating--fit-frame-to-window): The first member is changed to
buffer.
(exwm-floating--start-moveresize): Use container.  Correctly set input
focus.
* exwm-input.el (exwm-input--redirected, exwm-input--on-focus-in): Removed.
(exwm-input--on-buffer-list-update): Remove the restriction on floating
frames which is no longer valid.
(exwm-input--update-focus): Adjust stacking order.
(exwm-input--on-minibuffer-setup): New function for setting focus on the
Emacs frame when entering minibuffer.
(exwm-input--on-KeyPress-line-mode): No longer compensate FocusOut event.
(exwm-input--grab-keyboard, exwm-input--release-keyboard): Local keys are
now grabbed on the X window container.
(exwm-input--init): Add `exwm-input--on-minibuffer-setup' to
`minibuffer-setup-hook'.
* exwm-layout.el (exwm-layout--resize-container): New function to
resize/reposition both the X window and its container.
(exwm-layout--show, exwm-layout--hide): Use container.
(exwm-layout-set-fullscreen): Use container.  No longer save width and
height.
(exwm-layout-unset-fullscreen, exwm-layout--set-frame-fullscreen): Use
container.
(exwm-layout--refresh): Update a frame parameter.  Remove dead code.
* exwm-manage.el (exwm-manage--manage-window): Reparent unmanaged X windows
to the workspace.  Create X window container as the parent of the X window.
(exwm-manage--unmanage-window): Unmap/destroy container when appropriate.
Use the position of container.
(exwm-manage--unmanage-window): Destroy the container.
* exwm-randr.el (exwm-randr--refresh): Resize workspace using container.
* exwm-workspace.el (exwm-workspace-switch): Raise workspace.
Correctly set input focus.
(exwm-workspace--on-focus-in): Removed.
(exwm-workspace-move-window): Reparent to workspace container.
(exwm-workspace--init): Create workspace frames as visible.
Create workspace containers.
Remove exwm-workspace--on-focus-in from focus-in-hook.
Update _NET_VIRTUAL_ROOTS.
* exwm.el (exwm-init): No longer disable hourglass window.
Initialize workspace module before input.

* exwm-core.el (exwm--debug): New macro for setting debug forms.

* exwm-floating.el (exwm-floating--set-floating): No longer do `exwm--lock'
and `exwm--unlock' since `make-frame' is already adviced to take care of
everything.  Correctly set input focus to the newly created floating
X window.

* exwm-core.el (exwm--floating-edges): Removed file local variable.
* exwm-floating.el (exwm-floating--set-floating)
(exwm-floating--unset-floating):
* exwm-layout.el (exwm-layout--show, exwm-layout-enlarge-window):
* exwm-manage.el (exwm-manage--on-ConfigureRequest):
No longer use floating geometry.

* exwm-input.el (exwm-input--update-global-prefix-keys): Grab global keys
on workspaces containers instead of the root window (or input focus would
transfer to the workspace containing the pointer when the grab is active).
* exwm-workspace.el (exwm-workspace-switch): No longer move mouse.
2016-02-03 12:12:24 +08:00

351 lines
16 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; exwm-workspace.el --- Workspace Module for EXWM -*- lexical-binding: t -*-
;; Copyright (C) 2015 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 workspace support for EXWM.
;; Todo:
;; + Auto hide minibuffer, or allow users to place it elsewhere.
;; + Add system tray support.
;;; Code:
(require 'exwm-core)
(defvar exwm-workspace-number 4 "Number of workspaces (1 ~ 10).")
(defvar exwm-workspace--list nil "List of all workspaces (Emacs frames).")
(defvar exwm-workspace--switch-map
(let ((map (make-sparse-keymap)))
(define-key map [t] (lambda () (interactive)))
(dotimes (i 10)
(define-key map (int-to-string i)
`(lambda ()
(interactive)
(when (< ,i exwm-workspace-number)
(goto-history-element ,(1+ i))
(exit-minibuffer)))))
(define-key map "\C-a" (lambda () (interactive) (goto-history-element 1)))
(define-key map "\C-e" (lambda ()
(interactive)
(goto-history-element exwm-workspace-number)))
(define-key map "\C-g" #'abort-recursive-edit)
(define-key map "\C-]" #'abort-recursive-edit)
(define-key map "\C-j" #'exit-minibuffer)
;; (define-key map "\C-m" #'exit-minibuffer) ;not working
(define-key map [return] #'exit-minibuffer)
(define-key map " " #'exit-minibuffer)
(define-key map "\C-f" #'previous-history-element)
(define-key map "\C-b" #'next-history-element)
;; Alternative keys
(define-key map [right] #'previous-history-element)
(define-key map [left] #'next-history-element)
map)
"Keymap used for interactively switch workspace.")
(defvar exwm-workspace--switch-history nil
"History for `read-from-minibuffer' to interactively switch workspace.")
(defvar exwm-workspace--switch-history-outdated nil
"Non-nil to indicate `exwm-workspace--switch-history' is outdated.")
;;;###autoload
(defun exwm-workspace--update-switch-history ()
"Update the history for switching workspace to reflect the latest status."
(when exwm-workspace--switch-history-outdated
(setq exwm-workspace--switch-history-outdated nil)
(let ((sequence (number-sequence 0 (1- exwm-workspace-number)))
(not-empty (make-vector exwm-workspace-number nil)))
(dolist (i exwm--id-buffer-alist)
(with-current-buffer (cdr i)
(when exwm--frame
(setf (aref not-empty
(cl-position exwm--frame exwm-workspace--list))
t))))
(setq exwm-workspace--switch-history
(mapcar
(lambda (i)
(mapconcat
(lambda (j)
(format (if (= i j) "[%s]" " %s ")
(propertize
(int-to-string j)
'face
(cond ((frame-parameter (elt exwm-workspace--list j)
'exwm--urgency)
'(:foreground "orange"))
((aref not-empty j) '(:foreground "green"))
(t nil)))))
sequence ""))
sequence)))))
(defvar exwm-workspace--current nil "Current active workspace.")
(defvar exwm-workspace-current-index 0 "Index of current active workspace.")
(defvar exwm-workspace-show-all-buffers nil
"Non-nil to show buffers on other workspaces.")
;;;###autoload
(defun exwm-workspace-switch (index &optional force)
"Switch to workspace INDEX. Query for INDEX if it's not specified.
The optional FORCE option is for internal use only."
(interactive
(list
(unless (and (eq major-mode 'exwm-mode) exwm--fullscreen) ;it's invisible
(exwm-workspace--update-switch-history)
(let* ((history-add-new-input nil) ;prevent modifying history
(idx (read-from-minibuffer
"Workspace: " (elt exwm-workspace--switch-history
exwm-workspace-current-index)
exwm-workspace--switch-map nil
`(exwm-workspace--switch-history
. ,(1+ exwm-workspace-current-index)))))
(cl-position idx exwm-workspace--switch-history :test #'equal)))))
(when index
(unless (and (<= 0 index) (< index exwm-workspace-number))
(user-error "[EXWM] Workspace index out of range: %d" index))
(when (or force (/= exwm-workspace-current-index index))
(let* ((frame (elt exwm-workspace--list index))
(workspace (frame-parameter frame 'exwm-workspace)))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window workspace
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:Above))
(setq exwm-workspace--current frame
exwm-workspace-current-index index)
(select-window (frame-selected-window frame))
;; Close the (possible) active minibuffer
(when (active-minibuffer-window)
(run-with-idle-timer 0 nil (lambda () (abort-recursive-edit))))
(setq default-minibuffer-frame frame)
;; Hide windows in other workspaces by preprending a space
(unless exwm-workspace-show-all-buffers
(dolist (i exwm--id-buffer-alist)
(with-current-buffer (cdr i)
(let ((name (replace-regexp-in-string "^\\s-*" ""
(buffer-name))))
(exwm-workspace-rename-buffer (if (eq frame exwm--frame)
name
(concat " " name)))))))
;; Update demands attention flag
(set-frame-parameter frame 'exwm--urgency nil)
;; Update switch workspace history
(setq exwm-workspace--switch-history-outdated t)
;; Update _NET_CURRENT_DESKTOP
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_CURRENT_DESKTOP
:window exwm--root :data index))
(xcb:flush exwm--connection)))))
;;;###autoload
(defun exwm-workspace-move-window (index &optional id)
"Move window ID to workspace INDEX."
(interactive
(list
(progn
(exwm-workspace--update-switch-history)
(let* ((history-add-new-input nil) ;prevent modifying history
(idx (read-from-minibuffer
"Workspace: " (elt exwm-workspace--switch-history
exwm-workspace-current-index)
exwm-workspace--switch-map nil
`(exwm-workspace--switch-history
. ,(1+ exwm-workspace-current-index)))))
(cl-position idx exwm-workspace--switch-history :test #'equal)))))
(unless id (setq id (exwm--buffer->id (window-buffer))))
(unless (and (<= 0 index) (< index exwm-workspace-number))
(user-error "[EXWM] Workspace index out of range: %d" index))
(with-current-buffer (exwm--id->buffer id)
(let ((frame (elt exwm-workspace--list index)))
(unless (eq exwm--frame frame)
(unless exwm-workspace-show-all-buffers
(let ((name (replace-regexp-in-string "^\\s-*" "" (buffer-name))))
(exwm-workspace-rename-buffer
(if (= index exwm-workspace-current-index)
name
(concat " " name)))))
(setq exwm--frame frame)
(if exwm--floating-frame
;; Move the floating frame is enough
(progn
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window exwm--container
:parent
(frame-parameter frame 'exwm-workspace)
:x 0 :y 0))
(xcb:flush exwm--connection))
;; Move the window itself
(if (/= index exwm-workspace-current-index)
(bury-buffer)
(set-window-buffer (get-buffer-window (current-buffer) t)
(or (get-buffer "*scratch*")
(progn
(set-buffer-major-mode
(get-buffer-create "*scratch*"))
(get-buffer "*scratch*")))))
(exwm-layout--hide id)
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
;; (current-buffer) is changed.
:window (with-current-buffer (exwm--id->buffer id)
exwm--container)
:parent (frame-parameter frame 'exwm-workspace)
:x 0 :y 0))
(xcb:flush exwm--connection)
(set-window-buffer (frame-selected-window frame)
(exwm--id->buffer id)))))
(setq exwm-workspace--switch-history-outdated t)))
(defun exwm-workspace-switch-to-buffer ()
"Make the current Emacs window display another buffer."
(interactive)
;; Show all buffers
(unless exwm-workspace-show-all-buffers
(dolist (pair exwm--id-buffer-alist)
(with-current-buffer (cdr pair)
(when (= ?\s (aref (buffer-name) 0))
(rename-buffer (substring (buffer-name) 1))))))
(let ((buffer (read-buffer "Switch to buffer: " nil t)))
(when buffer
(with-current-buffer buffer
(if (and (eq major-mode 'exwm-mode)
(not (eq exwm--frame exwm-workspace--current)))
(exwm-workspace-move-window exwm-workspace-current-index
exwm--id)
(switch-to-buffer buffer)))))
;; Hide buffers on other workspaces
(unless exwm-workspace-show-all-buffers
(dolist (pair exwm--id-buffer-alist)
(with-current-buffer (cdr pair)
(unless (or (eq exwm--frame exwm-workspace--current)
(= ?\s (aref (buffer-name) 0)))
(rename-buffer (concat " " (buffer-name))))))))
(defun exwm-workspace-rename-buffer (newname)
"Rename a buffer."
(let ((hidden (= ?\s (aref newname 0)))
(basename (replace-regexp-in-string "<[0-9]+>$" "" newname))
(counter 1)
tmp)
(when hidden (setq basename (substring basename 1)))
(setq newname basename)
(while (and (setq tmp (or (get-buffer newname)
(get-buffer (concat " " newname))))
(not (eq tmp (current-buffer))))
(setq newname (format "%s<%d>" basename (cl-incf counter))))
(rename-buffer (concat (and hidden " ") newname))))
(defun exwm-workspace--x-create-frame (orig-fun params)
"Set override-redirect on the frame created by `x-create-frame'."
(let ((frame (funcall orig-fun params)))
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window (string-to-number
(frame-parameter frame 'outer-window-id))
:value-mask xcb:CW:OverrideRedirect
:override-redirect 1))
(xcb:flush exwm--connection)
frame))
(defun exwm-workspace--init ()
"Initialize workspace module."
(cl-assert (and (< 0 exwm-workspace-number) (>= 10 exwm-workspace-number)))
;; Prevent unexpected exit
(setq confirm-kill-emacs
(lambda (prompt)
(pcase (length exwm--id-buffer-alist)
(0 (y-or-n-p prompt))
(x (yes-or-no-p (format "[EXWM] %d window%s currently alive. %s"
x (if (= x 1) "" "s") prompt))))))
;; Initialize workspaces
(setq exwm-workspace--list (frame-list))
(when (< 1 (length exwm-workspace--list))
;; Emacs client creates an extra (but unusable) frame
(dolist (i exwm-workspace--list)
(unless (frame-parameter i 'window-id)
(setq exwm-workspace--list (delq i exwm-workspace--list))))
(cl-assert (= 1 (length exwm-workspace--list)))
;; Prevent user from deleting this frame by accident
(set-frame-parameter (car exwm-workspace--list) 'client nil))
;; Create remaining frames
(dotimes (_ (1- exwm-workspace-number))
(nconc exwm-workspace--list (list (make-frame '((window-system . x))))))
;; Configure workspaces
(dolist (i exwm-workspace--list)
(let ((outer-id (string-to-number (frame-parameter i 'outer-window-id)))
(workspace (xcb:generate-id exwm--connection)))
;; Save window IDs
(set-frame-parameter i 'exwm-outer-id outer-id)
(set-frame-parameter i 'exwm-workspace workspace)
;; Set OverrideRedirect on all frames
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window outer-id :value-mask xcb:CW:OverrideRedirect
:override-redirect 1))
(xcb:+request exwm--connection
(make-instance 'xcb:CreateWindow
:depth 0 :wid workspace :parent exwm--root
:x 0 :y 0
:width (x-display-pixel-width)
:height (x-display-pixel-height)
:border-width 0 :class xcb:WindowClass:CopyFromParent
:visual 0 ;CopyFromParent
:value-mask (logior xcb:CW:OverrideRedirect
xcb:CW:EventMask)
:override-redirect 1
:event-mask xcb:EventMask:SubstructureRedirect))
(exwm--debug
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window workspace
:data
(format "EXWM workspace %d"
(cl-position i exwm-workspace--list)))))
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window outer-id :parent workspace :x 0 :y 0))
(xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window workspace))))
(xcb:flush exwm--connection)
;; We have to advice `x-create-frame' or every call to it would hang EXWM
(advice-add 'x-create-frame :around #'exwm-workspace--x-create-frame)
;; Delay making the workspaces fullscreen until Emacs becomes idle
(run-with-idle-timer 0 nil
(lambda ()
(dolist (i exwm-workspace--list)
(set-frame-parameter i 'fullscreen 'fullboth))))
;; Set _NET_VIRTUAL_ROOTS
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_VIRTUAL_ROOTS
:window exwm--root
:data (vconcat (mapcar
(lambda (i)
(frame-parameter i 'exwm-workspace))
exwm-workspace--list))))
;; Switch to the first workspace
(exwm-workspace-switch 0 t))
(provide 'exwm-workspace)
;;; exwm-workspace.el ends here