mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
tvl-depot/exwm-workspace.el
Adrián Medraño Calvo d0797d03de Remove `exwm-worspace-number' 
No longer fill initial workspace list, nor limit the number of
workspaces to `exwm-worspace-number'.

Users are free to create as many as they like by hitting 'C-x 5 2' or
running `make-frame'.

The initial workspace list can be set up by creating frames in a
configuration file.  For example, to start up with 4 workspaces:

    (dolist (i 3)
      (make-frame))

The interactive workspace switcher is improved to support selecting
workspaces with a many-digits position.

	* exwm-workspace.el (exwm-workspace-number): Remove variable, as
	we no longer have a fixed number of workspaces.
	(exwm-workspace--switch-map)
	(exwm-workspace--switch-map-nth-prefix)
	(exwm-workspace--switch-map-select-nth): Improve support for
	selecting workspaces with multiple-digit positions (e.g. workspace
	number 12).
	(exwm-workspace--add-frame-as-workspace, exwm-workspace--init):
	Remove limit on number of workspaces.
	(exwm-workspace--init): Stop creating workspaces at startup.
	* exwm-config.el (exwm-config-default): Bind keys to namespaces
	0-9 in the default configuration.
2016-07-17 12:00:00 +00:00

1185 lines
54 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-2016 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.
;;; Code:
(require 'exwm-core)
(defvar exwm-workspace--list nil "List of all workspaces (Emacs frames).")
(defvar exwm-workspace--current nil "Current active workspace.")
(defvar exwm-workspace-current-index 0 "Index of current active workspace.")
(defsubst exwm-workspace--position (frame)
"Retrieve index of given FRAME in workspace list.
NIL if FRAME is not a workspace"
(cl-position frame exwm-workspace--list))
(defsubst exwm-workspace--count ()
"Retrieve total number of workspaces."
(length exwm-workspace--list))
(defsubst exwm-workspace--workspace-p (frame)
"Return t if FRAME is a workspace."
(memq frame exwm-workspace--list))
(defun exwm-workspace--workspace-from-frame-or-index (frame-or-index)
"Retrieve the workspace frame from FRAME-OR-INDEX."
(cond
((framep frame-or-index)
(unless (exwm-workspace--position frame-or-index)
(user-error "[EXWM] Frame is not a workspace %S" frame-or-index))
frame-or-index)
((integerp frame-or-index)
(unless (and (<= 0 frame-or-index) (< frame-or-index (exwm-workspace--count)))
(user-error "[EXWM] Workspace index out of range: %d" frame-or-index))
(elt exwm-workspace--list frame-or-index))
(t (user-error "[EXWM] Invalid workspace: %s" frame-or-index))))
(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) #'exwm-workspace--switch-map-nth-prefix))
(define-key map "\C-a" (lambda () (interactive) (goto-history-element 1)))
(define-key map "\C-e" (lambda ()
(interactive)
(goto-history-element (exwm-workspace--count))))
(define-key map "\C-g" #'abort-recursive-edit)
(define-key map "\C-]" #'abort-recursive-edit)
(define-key map "\C-j" #'exit-minibuffer)
;; (define-key map "\C-m" #'exit-minibuffer) ;not working
(define-key map [return] #'exit-minibuffer)
(define-key map " " #'exit-minibuffer)
(define-key map "\C-f" #'previous-history-element)
(define-key map "\C-b" #'next-history-element)
;; Alternative keys
(define-key map [right] #'previous-history-element)
(define-key map [left] #'next-history-element)
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.")
(defun exwm-workspace--prompt-for-workspace ()
"Prompt for a workspace, returning the workspace frame."
(exwm-workspace--update-switch-history)
(let* ((current-idx (exwm-workspace--position exwm-workspace--current))
(history-add-new-input nil) ;prevent modifying history
(history-idx (read-from-minibuffer
"Workspace: " (elt exwm-workspace--switch-history current-idx)
exwm-workspace--switch-map nil
`(exwm-workspace--switch-history . ,(1+ current-idx))))
(workspace-idx (cl-position history-idx exwm-workspace--switch-history :test #'equal)))
(elt exwm-workspace--list workspace-idx)))
(defun exwm-workspace--update-switch-history ()
"Update the history for switching workspace to reflect the latest status."
(when exwm-workspace--switch-history-outdated
(setq exwm-workspace--switch-history-outdated nil)
(let* ((num (exwm-workspace--count))
(sequence (number-sequence 0 (1- num)))
(not-empty (make-vector num nil)))
(dolist (i exwm--id-buffer-alist)
(with-current-buffer (cdr i)
(when exwm--frame
(setf (aref not-empty
(exwm-workspace--position exwm--frame))
t))))
(setq exwm-workspace--switch-history
(mapcar
(lambda (i)
(mapconcat
(lambda (j)
(format (if (= i j) "[%s]" " %s ")
(propertize
(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-show-all-buffers nil
"Non-nil to show buffers on other workspaces.")
(defvar exwm-workspace--minibuffer nil
"The minibuffer frame shared among all frames.")
(defvar exwm-workspace-minibuffer-position nil
"Position of the minibuffer frame.
Value nil means to use the default position which is fixed at bottom, while
'top and 'bottom mean to use an auto-hiding minibuffer.")
(defvar exwm-workspace-display-echo-area-timeout 1
"Timeout for displaying echo area.")
(defvar exwm-workspace--display-echo-area-timer nil
"Timer for auto-hiding echo area.")
;;;###autoload
(defun exwm-workspace--get-geometry (frame)
"Return the geometry of frame FRAME."
(or (frame-parameter frame 'exwm-geometry)
(make-instance 'xcb:RECTANGLE
:x 0
:y 0
:width (x-display-pixel-width)
:height (x-display-pixel-height))))
;;;###autoload
(defun exwm-workspace--current-width ()
"Return the width of current workspace."
(let ((geometry (frame-parameter exwm-workspace--current 'exwm-geometry)))
(if geometry
(slot-value geometry 'width)
(x-display-pixel-width))))
;;;###autoload
(defun exwm-workspace--current-height ()
"Return the height of current workspace."
(let ((geometry (frame-parameter exwm-workspace--current 'exwm-geometry)))
(if geometry
(slot-value geometry 'height)
(x-display-pixel-height))))
;;;###autoload
(defun exwm-workspace--minibuffer-own-frame-p ()
"Reports whether the minibuffer is displayed in its own frame."
(memq exwm-workspace-minibuffer-position '(top bottom)))
(defvar exwm-workspace--id-struts-alist nil "Alist of X window and struts.")
(defvar exwm-workspace--struts nil "Areas occupied by struts.")
(defun exwm-workspace--update-struts ()
"Update `exwm-workspace--struts'."
(setq exwm-workspace--struts nil)
(let (struts struts*)
(dolist (pair exwm-workspace--id-struts-alist)
(setq struts (cdr pair))
(dotimes (i 4)
(when (/= 0 (aref struts i))
(setq struts*
(vector (aref [left right top bottom] i)
(aref struts i)
(when (= 12 (length struts))
(substring struts (+ 4 (* i 2)) (+ 6 (* i 2))))))
(if (= 0 (mod i 2))
;; Make left/top processed first.
(push struts* exwm-workspace--struts)
(setq exwm-workspace--struts
(append exwm-workspace--struts (list struts*)))))))))
(defvar exwm-workspace--workareas nil "Workareas (struts excluded).")
(defun exwm-workspace--update-workareas ()
"Update `exwm-workspace--workareas' and set _NET_WORKAREA."
(let ((root-width (x-display-pixel-width))
(root-height (x-display-pixel-height))
workareas
edge width position
delta)
;; Calculate workareas with no struts.
(if (frame-parameter (car exwm-workspace--list) 'exwm-geometry)
;; Use the 'exwm-geometry' frame parameter if possible.
(dolist (f exwm-workspace--list)
(with-slots (x y width height) (frame-parameter f 'exwm-geometry)
(setq workareas (append workareas
(list (vector x y width height))))))
;; Fall back to use the screen size.
(let ((workarea (vector 0 0 root-width root-height)))
(setq workareas (make-list (exwm-workspace--count) workarea))))
;; Exclude areas occupied by struts.
(dolist (struts exwm-workspace--struts)
(setq edge (aref struts 0)
width (aref struts 1)
position (aref struts 2))
(dolist (w workareas)
(pcase edge
;; Left and top are always processed first.
(`left
(setq delta (- (aref w 0) width))
(when (and (< delta 0)
(< (max (aref position 0) (aref w 1))
(min (aref position 1)
(+ (aref w 1) (aref w 3)))))
(cl-incf (aref w 2) delta)
(setf (aref w 0) width)))
(`right
(setq delta (- root-width (aref w 0) (aref w 2) width))
(when (and (< delta 0)
(< (max (aref position 0) (aref w 1))
(min (aref position 1)
(+ (aref w 1) (aref w 3)))))
(cl-incf (aref w 2) delta)))
(`top
(setq delta (- (aref w 1) width))
(when (and (< delta 0)
(< (max (aref position 0) (aref w 0))
(min (aref position 1)
(+ (aref w 0) (aref w 2)))))
(cl-incf (aref w 3) delta)
(setf (aref w 1) width)))
(`bottom
(setq delta (- root-height (aref w 1) (aref w 3) width))
(when (and (< delta 0)
(< (max (aref position 0) (aref w 0))
(min (aref position 1)
(+ (aref w 0) (aref w 2)))))
(cl-incf (aref w 3) delta))))))
;; Save the result.
(setq exwm-workspace--workareas workareas)
;; Update _NET_WORKAREA.
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WORKAREA
:window exwm--root
:data (mapconcat #'vconcat workareas [])))
(xcb:flush exwm--connection)))
(defvar exwm-workspace--fullscreen-frame-count 0
"Count the fullscreen workspace frames.")
(declare-function exwm-layout--resize-container "exwm-layout.el"
(id container x y width height &optional container-only))
(defun exwm-workspace--set-fullscreen (frame)
"Make frame FRAME fullscreen according to `exwm-workspace--workareas'."
(let ((workarea (elt exwm-workspace--workareas
(cl-position frame exwm-workspace--list)))
(id (frame-parameter frame 'exwm-outer-id))
(container (frame-parameter frame 'exwm-container))
(workspace (frame-parameter frame 'exwm-workspace))
x y width height)
(setq x (aref workarea 0)
y (aref workarea 1)
width (aref workarea 2)
height (aref workarea 3))
(when (and (eq frame exwm-workspace--current)
(exwm-workspace--minibuffer-own-frame-p))
(exwm-workspace--resize-minibuffer-frame))
(exwm-layout--resize-container id container 0 0 width height)
(exwm-layout--resize-container nil workspace x y width height t)
(xcb:flush exwm--connection))
;; This is only used for workspace initialization.
(when exwm-workspace--fullscreen-frame-count
(cl-incf exwm-workspace--fullscreen-frame-count)))
(defun exwm-workspace--resize-minibuffer-frame ()
"Resize minibuffer (and its container) to fit the size of workspace."
(cl-assert (exwm-workspace--minibuffer-own-frame-p))
(let ((workarea (elt exwm-workspace--workareas exwm-workspace-current-index))
(container (frame-parameter exwm-workspace--minibuffer
'exwm-container))
y width)
(setq y (if (eq exwm-workspace-minibuffer-position 'top)
0
(- (aref workarea 3)
(frame-pixel-height exwm-workspace--minibuffer)))
width (aref workarea 2))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window container
:value-mask (logior xcb:ConfigWindow:Y
xcb:ConfigWindow:Width
xcb:ConfigWindow:StackMode)
:y y
:width width
:stack-mode xcb:StackMode:Above))
(set-frame-width exwm-workspace--minibuffer width nil t)))
(defun exwm-workspace--switch-map-nth-prefix (&optional prefix-digits)
"Allow selecting a workspace by number.
PREFIX-DIGITS is a list of the digits introduced so far."
(interactive)
(let* ((ev (this-command-keys-vector))
(off (1- (length ev)))
(k (elt ev off))
;; 0 is ASCII 48.
(d (- k 48))
;; Convert prefix-digits to number. For example, '(2 1) to 120.
(o 1)
(pn (apply #'+ (mapcar (lambda (x)
(setq o (* 10 o))
(* o x))
prefix-digits)))
(n (+ pn d))
(num-workspaces (exwm-workspace--count)))
(if (= (length prefix-digits) ; Go ahead if there are enough
(floor (log num-workspaces 10))) ; digits to select any workspace.
(exwm-workspace--switch-map-select-nth n)
(set-transient-map
(let ((map (make-sparse-keymap))
(cmd `(lambda ()
(interactive)
(exwm-workspace--switch-map-nth-prefix ',(cons d prefix-digits))
)))
(dotimes (i 10)
(define-key map (int-to-string i) cmd))
;; Accept
(define-key map [return]
`(lambda ()
(interactive)
(exwm-workspace--switch-map-select-nth ,n)))
map)))))
(defun exwm-workspace--switch-map-select-nth (n)
"Select Nth workspace."
(interactive)
(goto-history-element (1+ n))
(exit-minibuffer))
(defvar exwm-workspace-switch-hook nil
"Normal hook run after switching workspace.")
;;;###autoload
(defun exwm-workspace-switch (frame-or-index &optional force)
"Switch to workspace INDEX. Query for FRAME-OR-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--prompt-for-workspace))))
(let* ((frame (exwm-workspace--workspace-from-frame-or-index frame-or-index))
(index (exwm-workspace--position frame))
(workspace (frame-parameter frame 'exwm-workspace))
(window (frame-parameter frame 'exwm-selected-window)))
(when (or force (not (eq frame exwm-workspace--current)))
(unless (window-live-p window)
(setq window (frame-selected-window frame)))
;; Raise the workspace container.
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window workspace
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:Above))
;; Raise X windows with struts set if there's no fullscreen X window.
(unless (buffer-local-value 'exwm--fullscreen (window-buffer window))
(dolist (pair exwm-workspace--id-struts-alist)
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window (car pair)
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:Above))))
(setq exwm-workspace--current frame
exwm-workspace-current-index index)
(unless (exwm-workspace--workspace-p (selected-frame))
;; Save the floating frame window selected on the previous workspace.
(set-frame-parameter (with-current-buffer (window-buffer)
exwm--frame)
'exwm-selected-window (selected-window)))
(select-window window)
(set-frame-parameter frame 'exwm-selected-window nil)
;; Close the (possible) active minibuffer
(when (active-minibuffer-window)
(run-with-idle-timer 0 nil (lambda () (abort-recursive-edit))))
(if (not (exwm-workspace--minibuffer-own-frame-p))
(setq default-minibuffer-frame frame)
;; Resize/reposition the minibuffer frame
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window
(frame-parameter exwm-workspace--minibuffer
'exwm-container)
:parent (frame-parameter frame 'exwm-workspace)
:x 0 :y 0))
(exwm-workspace--resize-minibuffer-frame))
;; Hide windows in other workspaces by preprending a space
(unless exwm-workspace-show-all-buffers
(dolist (i exwm--id-buffer-alist)
(with-current-buffer (cdr i)
(let ((name (replace-regexp-in-string "^\\s-*" ""
(buffer-name))))
(exwm-workspace-rename-buffer (if (eq frame exwm--frame)
name
(concat " " name)))))))
;; Update demands attention flag
(set-frame-parameter frame 'exwm--urgency nil)
;; Update switch workspace history
(setq exwm-workspace--switch-history-outdated t)
;; Set _NET_CURRENT_DESKTOP
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_CURRENT_DESKTOP
:window exwm--root :data index))
(xcb:flush exwm--connection))
(run-hooks 'exwm-workspace-switch-hook)))
;;;###autoload
(defun exwm-workspace-swap-workspaces (workspace1 workspace2)
"Interchange position of WORKSPACE1 with that of WORKSPACE2."
(interactive
(unless (and (eq major-mode 'exwm-mode) exwm--fullscreen) ;it's invisible
(list
(exwm-workspace--prompt-for-workspace)
(exwm-workspace--prompt-for-workspace))))
(let ((pos1 (exwm-workspace--position workspace1))
(pos2 (exwm-workspace--position workspace2)))
(if (and pos1 pos2)
(progn
(setf (elt exwm-workspace--list pos1) workspace2)
(setf (elt exwm-workspace--list pos2) workspace1)
(cond
((eq exwm-workspace--current workspace1)
(setq exwm-workspace-current-index pos2))
((eq exwm-workspace--current workspace2)
(setq exwm-workspace-current-index pos1))))
(user-error "[EXWM] Frames are not workspaces"))))
;;;###autoload
(defun exwm-workspace-move-workspace (workspace nth)
"Move WORKSPACE to the NTH position.
When called interactively, prompt for a workspace and move current one just
before it."
(interactive
(unless (and (eq major-mode 'exwm-mode) exwm--fullscreen) ;it's invisible
(list exwm-workspace--current
(exwm-workspace--position (exwm-workspace--prompt-for-workspace)))))
(let ((pos (exwm-workspace--position workspace)))
(if (= nth pos)
(user-error "[EXWM] Cannot move to same position")
(pop (nthcdr pos exwm-workspace--list))
(push workspace (nthcdr nth exwm-workspace--list)))))
(defun exwm-workspace--on-focus-in ()
"Handle unexpected frame switch."
;; `focus-in-hook' is run by `handle-switch-frame'.
(unless (eq this-command #'handle-switch-frame)
(let ((index (cl-position (selected-frame) exwm-workspace--list)))
(exwm--log "Focus on workspace %s" index)
(when (and index (/= index exwm-workspace-current-index))
(exwm--log "Workspace was switched unexpectedly")
(exwm-workspace-switch index)))))
(defun exwm-workspace--set-desktop (id)
"Set _NET_WM_DESKTOP for X window ID."
(with-current-buffer (exwm--id->buffer id)
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_DESKTOP
:window id
:data (cl-position exwm--frame exwm-workspace--list)))))
(defvar exwm-floating-border-width)
(defvar exwm-floating-border-color)
(declare-function exwm-layout--show "exwm-layout.el" (id &optional window))
(declare-function exwm-layout--hide "exwm-layout.el" (id))
(declare-function exwm-layout--refresh "exwm-layout.el")
(declare-function exwm-layout--other-buffer-predicate "exwm-layout.el" (buffer))
;;;###autoload
(defun exwm-workspace-move-window (frame-or-index &optional id)
"Move window ID to workspace FRAME-OR-INDEX."
(interactive (list (exwm-workspace--prompt-for-workspace)))
(let ((frame (exwm-workspace--workspace-from-frame-or-index frame-or-index)))
(unless id (setq id (exwm--buffer->id (window-buffer))))
(with-current-buffer (exwm--id->buffer id)
(unless (eq exwm--frame frame)
(unless exwm-workspace-show-all-buffers
(let ((name (replace-regexp-in-string "^\\s-*" "" (buffer-name))))
(exwm-workspace-rename-buffer
(if (eq frame exwm-workspace--current)
name
(concat " " name)))))
(setq exwm--frame frame)
(if exwm--floating-frame
;; Move the floating container.
(with-slots (x y)
(xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry :drawable exwm--container))
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window exwm--container
:parent
(frame-parameter frame 'exwm-workspace)
:x x :y y))
(xcb:flush exwm--connection)
(if (exwm-workspace--minibuffer-own-frame-p)
(when (eq frame exwm-workspace--current)
(select-frame-set-input-focus exwm--floating-frame)
(exwm-layout--refresh))
;; The frame needs to be recreated since it won't use the
;; minibuffer on the new workspace.
(let* ((old-frame exwm--floating-frame)
(new-frame
(with-current-buffer
(or (get-buffer "*scratch*")
(progn
(set-buffer-major-mode
(get-buffer-create "*scratch*"))
(get-buffer "*scratch*")))
(make-frame
`((minibuffer . ,(minibuffer-window frame))
(background-color . ,exwm-floating-border-color)
(internal-border-width
. ,exwm-floating-border-width)
(left . 10000)
(top . 10000)
(width . ,window-min-width)
(height . ,window-min-height)
(unsplittable . t)))))
(outer-id (string-to-number
(frame-parameter new-frame
'outer-window-id)))
(frame-container (frame-parameter old-frame
'exwm-container))
(window (frame-root-window new-frame)))
(set-frame-parameter new-frame 'exwm-outer-id outer-id)
(set-frame-parameter new-frame 'exwm-container
frame-container)
(make-frame-invisible new-frame)
(set-frame-size new-frame
(frame-pixel-width old-frame)
(frame-pixel-height old-frame)
t)
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window outer-id
:parent frame-container
:x 0 :y 0))
(xcb:flush exwm--connection)
(with-current-buffer (exwm--id->buffer id)
(setq window-size-fixed nil
exwm--frame frame
exwm--floating-frame new-frame)
(set-window-dedicated-p (frame-root-window old-frame) nil)
(remove-hook 'window-configuration-change-hook
#'exwm-layout--refresh)
(set-window-buffer window (current-buffer))
(add-hook 'window-configuration-change-hook
#'exwm-layout--refresh)
(delete-frame old-frame)
(set-window-dedicated-p window t)
(exwm-layout--show id window))
(if (not (eq frame exwm-workspace--current))
(make-frame-visible new-frame)
(select-frame-set-input-focus new-frame)
(redisplay))))
;; Update the 'exwm-selected-window' frame parameter.
(when (not (eq frame exwm-workspace--current))
(with-current-buffer (exwm--id->buffer id)
(set-frame-parameter frame 'exwm-selected-window
(frame-root-window
exwm--floating-frame)))))
;; Move the X window container.
(if (eq frame exwm-workspace--current)
(set-window-buffer (get-buffer-window (current-buffer) t)
(other-buffer))
(bury-buffer)
;; Clear the 'exwm-selected-window' frame parameter.
(set-frame-parameter frame 'exwm-selected-window nil))
(exwm-layout--hide id)
;; (current-buffer) is changed.
(with-current-buffer (exwm--id->buffer id)
;; Reparent to the destination workspace.
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window exwm--container
:parent (frame-parameter frame 'exwm-workspace)
:x 0 :y 0))
;; Place it just above the destination frame container.
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window exwm--container
:value-mask (logior xcb:ConfigWindow:Sibling
xcb:ConfigWindow:StackMode)
:sibling (frame-parameter frame 'exwm-container)
:stack-mode xcb:StackMode:Above)))
(xcb:flush exwm--connection)
(set-window-buffer (frame-selected-window frame)
(exwm--id->buffer id)))
;; Set _NET_WM_DESKTOP.
(exwm-workspace--set-desktop id)
(xcb:flush exwm--connection)))
(setq exwm-workspace--switch-history-outdated t)))
;;;###autoload
(defun exwm-workspace-switch-to-buffer (buffer-or-name)
"Make the current Emacs window display another buffer."
(interactive
(let ((inhibit-quit t))
;; Show all buffers
(unless exwm-workspace-show-all-buffers
(dolist (pair exwm--id-buffer-alist)
(with-current-buffer (cdr pair)
(when (= ?\s (aref (buffer-name) 0))
(rename-buffer (substring (buffer-name) 1))))))
(prog1
(with-local-quit
(list (get-buffer (read-buffer "Switch to buffer: " nil t))))
;; 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))))))))))
(when buffer-or-name
(with-current-buffer buffer-or-name
(if (eq major-mode 'exwm-mode)
;; EXWM buffer.
(if (eq exwm--frame exwm-workspace--current)
;; On the current workspace.
(if (not exwm--floating-frame)
(switch-to-buffer buffer-or-name)
;; Select the floating frame.
(select-frame-set-input-focus exwm--floating-frame)
(select-window (frame-root-window exwm--floating-frame)))
;; On another workspace.
(exwm-workspace-move-window exwm-workspace--current
exwm--id))
;; Ordinary buffer.
(switch-to-buffer buffer-or-name)))))
(defun exwm-workspace-rename-buffer (newname)
"Rename a buffer."
(let ((hidden (= ?\s (aref newname 0)))
(basename (replace-regexp-in-string "<[0-9]+>$" "" newname))
(counter 1)
tmp)
(when hidden (setq basename (substring basename 1)))
(setq newname basename)
(while (and (setq tmp (or (get-buffer newname)
(get-buffer (concat " " newname))))
(not (eq tmp (current-buffer))))
(setq newname (format "%s<%d>" basename (cl-incf counter))))
(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--update-minibuffer (&optional echo-area)
"Update the minibuffer frame."
(let ((height
(with-current-buffer
(window-buffer (minibuffer-window exwm-workspace--minibuffer))
(max 1
(if echo-area
(let ((width (frame-width exwm-workspace--minibuffer))
(result 0))
(mapc (lambda (i)
(setq result
(+ result
(ceiling (1+ (length i)) width))))
(split-string (or (current-message) "") "\n"))
result)
(count-screen-lines))))))
(when (and (integerp max-mini-window-height)
(> height max-mini-window-height))
(setq height max-mini-window-height))
(set-frame-height exwm-workspace--minibuffer height)))
(defun exwm-workspace--on-ConfigureNotify (data _synthetic)
"Adjust the container to fit the minibuffer frame."
(let ((obj (make-instance 'xcb:ConfigureNotify))
value-mask y)
(xcb:unmarshal obj data)
(with-slots (window height) obj
(when (eq (frame-parameter exwm-workspace--minibuffer 'exwm-outer-id)
window)
(when (and (floatp max-mini-window-height)
(> height (* max-mini-window-height
(exwm-workspace--current-height))))
(setq height (floor
(* max-mini-window-height
(exwm-workspace--current-height))))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window window
:value-mask xcb:ConfigWindow:Height
:height height)))
(if (eq exwm-workspace-minibuffer-position 'top)
(setq value-mask xcb:ConfigWindow:Height
y 0)
(setq value-mask (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height)
y (- (aref (elt exwm-workspace--workareas
exwm-workspace-current-index)
3)
height)))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window (frame-parameter exwm-workspace--minibuffer
'exwm-container)
:value-mask value-mask
:y y
:height height))
(xcb:flush exwm--connection)))))
(defun exwm-workspace--display-buffer (buffer alist)
"Display BUFFER as if the current workspace is selected."
;; Only when the floating minibuffer frame is selected.
;; This also protect this functions from being recursively called.
(when (eq (selected-frame) exwm-workspace--minibuffer)
(with-selected-frame exwm-workspace--current
(display-buffer buffer alist))))
(defun exwm-workspace--show-minibuffer ()
"Show the minibuffer frame."
;; Cancel pending timer.
(when exwm-workspace--display-echo-area-timer
(cancel-timer exwm-workspace--display-echo-area-timer)
(setq exwm-workspace--display-echo-area-timer nil))
;; Show the minibuffer frame.
(xcb:+request exwm--connection
(make-instance 'xcb:MapWindow
:window (frame-parameter exwm-workspace--minibuffer
'exwm-container)))
(xcb:flush exwm--connection)
;; Unfortunately we need the following lines to workaround a cursor
;; flickering issue for line-mode floating X windows. They just make the
;; minibuffer appear to be focused.
(with-current-buffer (window-buffer (minibuffer-window
exwm-workspace--minibuffer))
(setq cursor-in-non-selected-windows
(frame-parameter exwm-workspace--minibuffer 'cursor-type))))
(defun exwm-workspace--hide-minibuffer ()
"Hide the minibuffer frame."
;; Hide the minibuffer frame.
(xcb:+request exwm--connection
(make-instance 'xcb:UnmapWindow
:window (frame-parameter exwm-workspace--minibuffer
'exwm-container)))
(xcb:flush exwm--connection))
(defun exwm-workspace--on-minibuffer-setup ()
"Run in minibuffer-setup-hook to show the minibuffer and its container."
(when (and (= 1 (minibuffer-depth))
;; Exclude non-graphical frames.
(frame-parameter nil 'exwm-outer-id))
(add-hook 'post-command-hook #'exwm-workspace--update-minibuffer)
(exwm-workspace--show-minibuffer)
;; Set input focus on the Emacs frame
(x-focus-frame (window-frame (minibuffer-selected-window)))))
(defun exwm-workspace--on-minibuffer-exit ()
"Run in minibuffer-exit-hook to hide the minibuffer container."
(when (and (= 1 (minibuffer-depth))
;; Exclude non-graphical frames.
(frame-parameter nil 'exwm-outer-id))
(remove-hook 'post-command-hook #'exwm-workspace--update-minibuffer)
(exwm-workspace--hide-minibuffer)))
(defvar exwm-input--during-command)
(defun exwm-workspace--on-echo-area-dirty ()
"Run when new message arrives to show the echo area and its container."
(when (and (not (active-minibuffer-window))
;; Exclude non-graphical frames.
(frame-parameter nil 'exwm-outer-id)
(or (current-message)
cursor-in-echo-area))
(exwm-workspace--update-minibuffer t)
(exwm-workspace--show-minibuffer)
(unless (or (not exwm-workspace-display-echo-area-timeout)
exwm-input--during-command ;e.g. read-event
input-method-use-echo-area)
(setq exwm-workspace--display-echo-area-timer
(run-with-timer exwm-workspace-display-echo-area-timeout nil
#'exwm-workspace--on-echo-area-clear)))))
(defun exwm-workspace--on-echo-area-clear ()
"Run in echo-area-clear-hook to hide echo area container."
(when (frame-parameter nil 'exwm-outer-id) ;Exclude non-graphical frames.
(unless (active-minibuffer-window)
(exwm-workspace--hide-minibuffer))
(when exwm-workspace--display-echo-area-timer
(cancel-timer exwm-workspace--display-echo-area-timer)
(setq exwm-workspace--display-echo-area-timer nil))))
(defvar exwm-workspace--client nil
"The 'client' frame parameter of emacsclient frames.")
(declare-function exwm-manage--unmanage-window "exwm-manage.el")
(declare-function exwm--exit "exwm.el")
(defun exwm-workspace--confirm-kill-emacs (prompt)
"Confirm before exiting Emacs."
(when (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))))
;; Unmanage all X windows.
(dolist (i exwm--id-buffer-alist)
(exwm-manage--unmanage-window (car i) 'quit)
(xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window (car i))))
;; Reparent out the minibuffer frame.
(when (exwm-workspace--minibuffer-own-frame-p)
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window (frame-parameter exwm-workspace--minibuffer
'exwm-outer-id)
:parent exwm--root
:x 0
:y 0)))
;; Reparent out all workspace frames.
(dolist (f exwm-workspace--list)
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window (frame-parameter f 'exwm-outer-id)
:parent exwm--root
:x 0
:y 0)))
(xcb:flush exwm--connection)
(if (not exwm-workspace--client)
(progn
;; Destroy all resources created by this connection.
(xcb:disconnect exwm--connection)
t)
;; Extra cleanups for emacsclient.
(dolist (f exwm-workspace--list)
(set-frame-parameter f 'client exwm-workspace--client))
(when (exwm-workspace--minibuffer-own-frame-p)
(set-frame-parameter exwm-workspace--minibuffer 'client
exwm-workspace--client))
(let ((connection exwm--connection))
(exwm--exit)
;; Destroy all resources created by this connection.
(xcb:disconnect connection))
;; Kill the client.
(server-save-buffers-kill-terminal nil)
nil)))
(defun exwm-workspace--set-desktop-geometry ()
"Set _NET_DESKTOP_GEOMETRY."
;; We don't support large desktop so it's the same with screen size.
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_DESKTOP_GEOMETRY
:window exwm--root
:width (x-display-pixel-width)
:height (x-display-pixel-height))))
(defvar exwm-workspace--timer nil "Timer used to track echo area changes.")
(defun exwm-workspace--add-frame-as-workspace (frame)
"Configure frame FRAME to be treated as a workspace."
(cond
((exwm-workspace--workspace-p frame)
(exwm--log "Frame `%s' is already a workspace" frame))
((not (display-graphic-p frame))
(exwm--log "Frame `%s' is not graphical" frame))
((not (string-equal (slot-value exwm--connection 'display)
(frame-parameter frame 'display)))
(exwm--log "Frame `%s' is on a different DISPLAY (%S instead of %S)"
frame
(frame-parameter frame 'display)
(slot-value exwm--connection 'display)))
((frame-parameter frame 'exwm-floating)
(exwm--log "Frame `%s' is floating" frame))
(t
(exwm--log "Adding frame `%s' as workspace" frame)
(setq exwm-workspace--list (nconc exwm-workspace--list (list frame))
exwm-workspace--current frame)
(let ((outer-id (string-to-number (frame-parameter frame 'outer-window-id)))
(container (xcb:generate-id exwm--connection))
(workspace (xcb:generate-id exwm--connection)))
;; Save window IDs
(set-frame-parameter frame 'exwm-outer-id outer-id)
(set-frame-parameter frame 'exwm-container container)
(set-frame-parameter frame 'exwm-workspace workspace)
;; Use same RandR output and geometry as previous workspace.
(let ((prev-workspace (selected-frame)))
(dolist (param '(exwm-randr-output
exwm-geometry))
(set-frame-parameter frame param
(frame-parameter prev-workspace param))))
(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))
(xcb:+request exwm--connection
(make-instance 'xcb:CreateWindow
:depth 0 :wid container :parent workspace
: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 xcb:CW:OverrideRedirect
:override-redirect 1))
(exwm--debug
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window workspace
:data
(format "EXWM workspace %d"
(exwm-workspace--position frame))))
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window container
:data
(format "EXWM workspace %d frame container"
(exwm-workspace--position frame)))))
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window outer-id :parent container :x 0 :y 0))
(xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window container))
(xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window workspace)))
(xcb:flush exwm--connection)
;; Delay making the workspace fullscreen until Emacs becomes idle
(run-with-idle-timer 0 nil
`(lambda ()
(set-frame-parameter ,frame 'fullscreen 'fullboth)))
;; Update EWMH properties.
(exwm-workspace--update-ewmh-props)
(exwm-workspace-switch frame t))))
(defun exwm-workspace--remove-frame-as-workspace (frame)
"Stop treating frame FRAME as a workspace."
(cond
((= 1 (exwm-workspace--count))
(exwm--log "Cannot remove last workspace"))
((not (exwm-workspace--workspace-p frame))
(exwm--log "Frame `%s' is not a workspace" frame))
(t
(exwm--log "Removing frame `%s' as workspace" frame)
(let* ((index (exwm-workspace--position frame))
(lastp (= index (1- (exwm-workspace--count))))
;; As we are removing this workspace, the one on its left is its
;; natural substitutes... except when this is already the last one
;; and there is none on its left.
(nextw (elt exwm-workspace--list (+ index (if lastp -1 +1)))))
;; Clients need to be moved to some other workspace before this is being
;; removed.
(dolist (pair exwm--id-buffer-alist)
(with-current-buffer (cdr pair)
(when (eq exwm--frame frame)
(exwm-workspace-move-window nextw exwm--id))))
;; Need to remove the workspace from the list in order for
;; `exwm-workspace-switch' to calculate the right index.
(setq exwm-workspace--list (delete frame exwm-workspace--list))
(when (eq frame exwm-workspace--current)
(exwm-workspace-switch nextw)))
;; Update EWMH properties.
(exwm-workspace--update-ewmh-props)
;; Update switch history.
(setq exwm-workspace--switch-history-outdated t))))
(defun exwm-workspace--update-ewmh-props ()
"Update EWMH properties to match the workspace list."
(let ((num-workspaces (exwm-workspace--count)))
;; Set _NET_NUMBER_OF_DESKTOPS (it's currently fixed).
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_NUMBER_OF_DESKTOPS
:window exwm--root :data num-workspaces))
;; Set _NET_DESKTOP_GEOMETRY.
(exwm-workspace--set-desktop-geometry)
;; 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 (make-vector (* 2 num-workspaces) 0)))
;; Update and set _NET_WORKAREA.
(exwm-workspace--update-workareas)
;; Set _NET_VIRTUAL_ROOTS (it's currently fixed.)
(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)))))
(xcb:flush exwm--connection))
(defun exwm-workspace--modify-all-x-frames-parameters (new-x-parameters)
"Modifies `window-system-default-frame-alist' for the X Window System.
NEW-X-PARAMETERS is an alist of frame parameters, merged into current
`window-system-default-frame-alist' for the X Window System. The parameters are
applied to all subsequently created X frames."
;; The parameters are modified in place; take current
;; ones or insert a new X-specific list.
(let ((x-parameters (or (assq 'x window-system-default-frame-alist)
(let ((new-x-parameters '(x)))
(push new-x-parameters window-system-default-frame-alist)
new-x-parameters))))
(setf (cdr x-parameters)
(append new-x-parameters (cdr x-parameters)))))
(defun exwm-workspace--init ()
"Initialize workspace module."
;; Prevent unexpected exit
(setq confirm-kill-emacs #'exwm-workspace--confirm-kill-emacs)
(let ((initial-workspaces (frame-list)))
(if (not (exwm-workspace--minibuffer-own-frame-p))
;; Initialize workspaces with minibuffers.
(when (< 1 (length initial-workspaces))
;; Exclude the initial frame.
(dolist (i initial-workspaces)
(unless (frame-parameter i 'window-id)
(setq initial-workspaces (delq i initial-workspaces))))
(setq exwm-workspace--client
(frame-parameter (car exwm-workspace--list) 'client))
(let ((f (car initial-workspaces)))
;; Remove the possible internal border.
(set-frame-parameter f 'internal-border-width 0)
;; Prevent user from deleting the first frame by accident.
(set-frame-parameter f 'client nil)))
;; Initialize workspaces without minibuffers.
(setq exwm-workspace--minibuffer
(make-frame '((window-system . x) (minibuffer . only)
(left . 10000) (right . 10000)
(width . 0) (height . 0)
(internal-border-width . 0)
(client . nil))))
;; Remove/hide existing frames.
(dolist (f initial-workspaces)
(if (frame-parameter f 'client)
(progn
(unless exwm-workspace--client
(setq exwm-workspace--client (frame-parameter f 'client)))
(make-frame-invisible f))
(when (eq 'x (framep f)) ;do not delete the initial frame.
(delete-frame f))))
;; This is the only usable minibuffer frame.
(setq default-minibuffer-frame exwm-workspace--minibuffer)
(exwm-workspace--modify-all-x-frames-parameters
'((minibuffer . nil)))
(let ((outer-id (string-to-number
(frame-parameter exwm-workspace--minibuffer
'outer-window-id)))
(container (xcb:generate-id exwm--connection)))
(set-frame-parameter exwm-workspace--minibuffer 'exwm-outer-id outer-id)
(set-frame-parameter exwm-workspace--minibuffer 'exwm-container
container)
(xcb:+request exwm--connection
(make-instance 'xcb:CreateWindow
:depth 0 :wid container :parent exwm--root
:x -1 :y -1 :width 1 :height 1
:border-width 0 :class xcb:WindowClass:CopyFromParent
:visual 0 ;CopyFromParent
:value-mask xcb:CW:OverrideRedirect
:override-redirect 1))
(exwm--debug
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window container
:data "Minibuffer container")))
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window outer-id :parent container :x 0 :y 0))
;; Attach event listener for monitoring the frame
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window outer-id
:value-mask xcb:CW:EventMask
:event-mask xcb:EventMask:StructureNotify))
(xcb:+event exwm--connection 'xcb:ConfigureNotify
#'exwm-workspace--on-ConfigureNotify))
;; Show/hide minibuffer / echo area when they're active/inactive.
(add-hook 'minibuffer-setup-hook #'exwm-workspace--on-minibuffer-setup)
(add-hook 'minibuffer-exit-hook #'exwm-workspace--on-minibuffer-exit)
(setq exwm-workspace--timer
(run-with-idle-timer 0 t #'exwm-workspace--on-echo-area-dirty))
(add-hook 'echo-area-clear-hook #'exwm-workspace--on-echo-area-clear)
;; Recreate frames with the external minibuffer set.
(setq initial-workspaces
(mapcar
(lambda (_)
(make-frame `((window-system . x)
(internal-border-width . 0)
(client . nil))))
initial-workspaces))
;; The default behavior of `display-buffer' (indirectly called by
;; `minibuffer-completion-help') is not correct here.
(cl-pushnew '(exwm-workspace--display-buffer) display-buffer-alist
:test #'equal))
;; Handle unexpected frame switch.
(add-hook 'focus-in-hook #'exwm-workspace--on-focus-in)
;; Prevent `other-buffer' from selecting already displayed EXWM buffers.
(modify-all-frames-parameters
'((buffer-predicate . exwm-layout--other-buffer-predicate)))
;; Configure workspaces
(dolist (i initial-workspaces)
(exwm-workspace--add-frame-as-workspace i)))
(xcb:flush exwm--connection)
;; We have to advice `x-create-frame' or every call to it would hang EXWM
(advice-add 'x-create-frame :around #'exwm-workspace--x-create-frame)
;; Make new frames create new workspaces.
(add-hook 'after-make-frame-functions #'exwm-workspace--add-frame-as-workspace)
(add-hook 'delete-frame-functions #'exwm-workspace--remove-frame-as-workspace)
;; Switch to the first workspace
(exwm-workspace-switch 0 t))
(defun exwm-workspace--exit ()
"Exit the workspace module."
(setq confirm-kill-emacs nil
exwm-workspace--list nil
exwm-workspace--client nil
exwm-workspace--minibuffer nil
default-minibuffer-frame nil)
(remove-hook 'minibuffer-setup-hook #'exwm-workspace--on-minibuffer-setup)
(remove-hook 'minibuffer-exit-hook #'exwm-workspace--on-minibuffer-exit)
(when exwm-workspace--timer
(cancel-timer exwm-workspace--timer)
(setq exwm-workspace--timer nil))
(remove-hook 'echo-area-clear-hook #'exwm-workspace--on-echo-area-clear)
(setq display-buffer-alist
(cl-delete '(exwm-workspace--display-buffer) display-buffer-alist
:test #'equal))
(remove-hook 'focus-in-hook #'exwm-workspace--on-focus-in)
(advice-remove 'x-create-frame #'exwm-workspace--x-create-frame)
(remove-hook 'after-make-frame-functions #'exwm-workspace--add-frame-as-workspace)
(remove-hook 'delete-frame-functions #'exwm-workspace--remove-frame-as-workspace))
(defun exwm-workspace--post-init ()
"The second stage in the initialization of the workspace module."
;; Make the workspaces fullscreen.
(dolist (i exwm-workspace--list)
(set-frame-parameter i 'fullscreen 'fullboth))
;; Wait until all workspace frames are resized.
(with-timeout (1)
(while (< exwm-workspace--fullscreen-frame-count (exwm-workspace--count))
(accept-process-output nil 0.1)))
(setq exwm-workspace--fullscreen-frame-count nil))
(provide 'exwm-workspace)
;;; exwm-workspace.el ends here
Reference in a new issue View git blame Copy permalink