Support adding and removing workspaces

Frames created via `make-frame' are added to the workspace list;
`delete-frame' removes them from the list.  Floating frames,
non-graphical frames, as well as those associated to different
displays are ignored.

When deleting a workspace, care is taken to reparent that all X clients
another workspace.

	* exwm-workspace.el (exwm-workspace--add-frame-as-workspace)
	(exwm-workspace--remove-frame-as-workspace): New functions that
	intercept created and deleted frames and configure them as EXWM
	workspaces.
	(exwm-workspace--update-ewmh-props): New function to update
	desktop-related EWMH properties after workspace changes.
	(exwm-workspace--init): Use
	`exwm-workspace--add-frame-as-workspace' to create the initial
	workspaces.
This commit is contained in:
Adrián Medraño Calvo 2016-07-17 12:00:00 +00:00
parent f4b8cc47c7
commit 0fbc725de1

View file

@ -851,129 +851,41 @@ before it."
(defvar exwm-workspace--timer nil "Timer used to track echo area changes.") (defvar exwm-workspace--timer nil "Timer used to track echo area changes.")
(defun exwm-workspace--modify-all-x-frames-parameters (new-x-parameters) (defun exwm-workspace--add-frame-as-workspace (frame)
"Modifies `window-system-default-frame-alist' for the X Window System. "Configure frame FRAME to be treated as a workspace."
NEW-X-PARAMETERS is an alist of frame parameters, merged into current (cond
`window-system-default-frame-alist' for the X Window System. The parameters are ((>= (exwm-workspace--count) exwm-workspace-number)
applied to all subsequently created X frames." (delete-frame frame)
;; The parameters are modified in place; take current (user-error "[EXWM] Too many workspaces: maximum is %d" exwm-workspace-number))
;; ones or insert a new X-specific list. ((exwm-workspace--workspace-p frame)
(let ((x-parameters (or (assq 'x window-system-default-frame-alist) (exwm--log "Frame `%s' is already a workspace" frame))
(let ((new-x-parameters '(x))) ((not (display-graphic-p frame))
(push new-x-parameters window-system-default-frame-alist) (exwm--log "Frame `%s' is not graphical" frame))
new-x-parameters)))) ((not (string-equal (slot-value exwm--connection 'display)
(setf (cdr x-parameters) (frame-parameter frame 'display)))
(append new-x-parameters (cdr x-parameters))))) (exwm--log "Frame `%s' is on a different DISPLAY (%S instead of %S)"
frame
(defun exwm-workspace--init () (frame-parameter frame 'display)
"Initialize workspace module." (slot-value exwm--connection 'display)))
(cl-assert (and (< 0 exwm-workspace-number) (>= 10 exwm-workspace-number))) ((frame-parameter frame 'exwm-floating)
;; Prevent unexpected exit (exwm--log "Frame `%s' is floating" frame))
(setq confirm-kill-emacs #'exwm-workspace--confirm-kill-emacs) (t
(if (not (exwm-workspace--minibuffer-own-frame-p)) (exwm--log "Adding frame `%s' as workspace" frame)
;; Initialize workspaces with minibuffers. (setq exwm-workspace--list (nconc exwm-workspace--list (list frame))
(progn exwm-workspace--current frame)
(setq exwm-workspace--list (frame-list)) (let ((outer-id (string-to-number (frame-parameter frame 'outer-window-id)))
(when (< 1 (exwm-workspace--count))
;; Exclude the initial frame.
(dolist (i exwm-workspace--list)
(unless (frame-parameter i 'window-id)
(setq exwm-workspace--list (delq i exwm-workspace--list))))
(cl-assert (= 1 (exwm-workspace--count)))
(setq exwm-workspace--client
(frame-parameter (car exwm-workspace--list) 'client))
(let ((f (car exwm-workspace--list)))
;; Remove the possible internal border.
(set-frame-parameter f 'internal-border-width 0)
;; Prevent user from deleting this frame by accident.
(set-frame-parameter f 'client nil))
;; Create remaining frames.
(dotimes (_ (1- exwm-workspace-number))
(nconc exwm-workspace--list
(list (make-frame '((window-system . x)
(internal-border-width . 0))))))))
;; Initialize workspaces without minibuffers.
(let ((old-frames (frame-list)))
(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 old-frames)
(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)
;; Create workspace frames.
(dotimes (_ exwm-workspace-number)
(push (make-frame `((window-system . x)
(internal-border-width . 0)
(client . nil)))
exwm-workspace--list))
;; 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 exwm-workspace--list)
(let ((outer-id (string-to-number (frame-parameter i 'outer-window-id)))
(container (xcb:generate-id exwm--connection)) (container (xcb:generate-id exwm--connection))
(workspace (xcb:generate-id exwm--connection))) (workspace (xcb:generate-id exwm--connection)))
;; Save window IDs ;; Save window IDs
(set-frame-parameter i 'exwm-outer-id outer-id) (set-frame-parameter frame 'exwm-outer-id outer-id)
(set-frame-parameter i 'exwm-container container) (set-frame-parameter frame 'exwm-container container)
(set-frame-parameter i 'exwm-workspace workspace) (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 (xcb:+request exwm--connection
(make-instance 'xcb:CreateWindow (make-instance 'xcb:CreateWindow
:depth 0 :wid workspace :parent exwm--root :depth 0 :wid workspace :parent exwm--root
@ -1002,44 +914,208 @@ applied to all subsequently created X frames."
:window workspace :window workspace
:data :data
(format "EXWM workspace %d" (format "EXWM workspace %d"
(exwm-workspace--position i)))) (exwm-workspace--position frame))))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME (make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window container :window container
:data :data
(format "EXWM workspace %d frame container" (format "EXWM workspace %d frame container"
(exwm-workspace--position i))))) (exwm-workspace--position frame)))))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow (make-instance 'xcb:ReparentWindow
:window outer-id :parent container :x 0 :y 0)) :window outer-id :parent container :x 0 :y 0))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window container)) (make-instance 'xcb:MapWindow :window container))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window workspace)))) (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."
(cl-assert (and (< 0 exwm-workspace-number) (>= 10 exwm-workspace-number)))
;; 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.
(progn
(when (< 1 (exwm-workspace--count))
;; Exclude the initial frame.
(dolist (i initial-workspaces)
(unless (frame-parameter i 'window-id)
(setq initial-workspaces (delq i initial-workspaces))))
(cl-assert (= 1 (length 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 this frame by accident.
(set-frame-parameter f 'client nil)))
;; Create remaining frames.
(dotimes (_ (1- exwm-workspace-number))
(nconc initial-workspaces
(list (make-frame '((window-system . x)
(internal-border-width . 0)))))))
;; 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)
;; Create workspace frames.
(dotimes (_ exwm-workspace-number)
(push (make-frame `((window-system . x)
(internal-border-width . 0)
(client . nil)))
exwm-workspace--list))
;; 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) (xcb:flush exwm--connection)
;; We have to advice `x-create-frame' or every call to it would hang EXWM ;; 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) (advice-add 'x-create-frame :around #'exwm-workspace--x-create-frame)
;; Set _NET_NUMBER_OF_DESKTOPS (it's currently fixed). ;; Make new frames create new workspaces.
(xcb:+request exwm--connection (add-hook 'after-make-frame-functions #'exwm-workspace--add-frame-as-workspace)
(make-instance 'xcb:ewmh:set-_NET_NUMBER_OF_DESKTOPS (add-hook 'delete-frame-functions #'exwm-workspace--remove-frame-as-workspace)
:window exwm--root :data (exwm-workspace--count)))
;; 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 (exwm-workspace--count)) 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))))
;; Switch to the first workspace ;; Switch to the first workspace
(exwm-workspace-switch 0 t)) (exwm-workspace-switch 0 t))
@ -1060,7 +1136,9 @@ applied to all subsequently created X frames."
(cl-delete '(exwm-workspace--display-buffer) display-buffer-alist (cl-delete '(exwm-workspace--display-buffer) display-buffer-alist
:test #'equal)) :test #'equal))
(remove-hook 'focus-in-hook #'exwm-workspace--on-focus-in) (remove-hook 'focus-in-hook #'exwm-workspace--on-focus-in)
(advice-remove 'x-create-frame #'exwm-workspace--x-create-frame)) (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 () (defun exwm-workspace--post-init ()
"The second stage in the initialization of the workspace module." "The second stage in the initialization of the workspace module."