Add initial support for dock (panel) applications

* exwm-layout.el (exwm-layout--fullscreen-frame-count)
(exwm-layout--set-frame-fullscreen): Moved to workspace module.
* exwm-workspace.el (exwm-workspace--fullscreen-frame-count)
(exwm-workspace--set-fullscreen):
Moved from layout module.

* exwm-manage.el (exwm-manage--manage-window):
Update struts for dock applications.
* exwm-workspace.el (exwm-workspace--strut)
(exwm-workspace--strut-is-partial): New variables for storing struts.
(exwm-workspace--resize-minibuffer-frame)
(exwm-workspace--on-ConfigureNotify): Take struts into consideration.
* exwm.el (exwm--update-strut-legacy, exwm--update-strut-partial)
(exwm--update-strut): New functions for updating _NET_WM_STRUT
or _NET_WM_STRUT_PARTIAL.
(exwm--on-PropertyNotify): Update struts on corresponding event.
(exwm--init-icccm-ewmh): Declare _NET_WM_STRUT
and _NET_WM_STRUT_PARTIAL as supported.

* exwm-workspace.el (exwm-workspace--update-workareas):
Dedicated function for updating _NET_WORKAREA.
* exwm-randr.el (exwm-randr--refresh):
* exwm-workspace.el (exwm-workspace--init):
Use `exwm-workspace--update-workareas'.
* exwm.el (exwm--init-icccm-ewmh): Do not set _NET_WORKAREA here.
This commit is contained in:
Chris Feng 2016-07-12 18:35:51 +08:00
parent 0863f41490
commit 650ed0013c
5 changed files with 163 additions and 61 deletions

View file

@ -213,34 +213,6 @@
(setq exwm--fullscreen nil) (setq exwm--fullscreen nil)
(call-interactively #'exwm-input-grab-keyboard))) (call-interactively #'exwm-input-grab-keyboard)))
(defvar exwm-layout--fullscreen-frame-count 0
"Count the fullscreen workspace frames.")
;; This function is superficially similar to `exwm-layout-set-fullscreen', but
;; they do very different things: `exwm-layout--set-frame-fullscreen' resizes a
;; frame to the actual monitor size, `exwm-layout-set-fullscreen' resizes an X
;; window to the frame size.
(defun exwm-layout--set-frame-fullscreen (frame)
"Make frame FRAME fullscreen, with regard to its RandR output if applicable."
(let ((geometry (or (frame-parameter frame 'exwm-geometry)
(xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry
:drawable exwm--root))
(make-instance 'xcb:RECTANGLE :x 0 :y 0
:width (x-display-pixel-width)
:height (x-display-pixel-height))))
(id (frame-parameter frame 'exwm-outer-id))
(container (frame-parameter frame 'exwm-container))
(workspace (frame-parameter frame 'exwm-workspace)))
(with-slots (x y width height) geometry
(when (and (eq frame exwm-workspace--current)
(exwm-workspace--minibuffer-own-frame-p))
(exwm-workspace--resize-minibuffer-frame width height))
(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)))
(cl-incf exwm-layout--fullscreen-frame-count))
(defvar exwm-layout--other-buffer-exclude-exwm-mode-buffers nil (defvar exwm-layout--other-buffer-exclude-exwm-mode-buffers nil
"When non-nil, prevent EXWM buffers from being selected by `other-buffer'.") "When non-nil, prevent EXWM buffers from being selected by `other-buffer'.")

View file

@ -79,6 +79,7 @@ corresponding buffer.")
(declare-function exwm--update-hints "exwm.el" (id &optional force)) (declare-function exwm--update-hints "exwm.el" (id &optional force))
(declare-function exwm--update-protocols "exwm.el" (id &optional force)) (declare-function exwm--update-protocols "exwm.el" (id &optional force))
(declare-function exwm--update-state "exwm.el" (id &optional force)) (declare-function exwm--update-state "exwm.el" (id &optional force))
(declare-function exwm--update-strut "exwm.el" (id))
(declare-function exwm-floating--set-floating "exwm-floating.el" (id)) (declare-function exwm-floating--set-floating "exwm-floating.el" (id))
(declare-function exwm-floating--unset-floating "exwm-floating.el" (id)) (declare-function exwm-floating--unset-floating "exwm-floating.el" (id))
@ -120,11 +121,19 @@ corresponding buffer.")
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG
exwm-window-type)))) exwm-window-type))))
(exwm--log "No need to manage #x%x" id) (exwm--log "No need to manage #x%x" id)
;; Update struts.
(when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK exwm-window-type)
(exwm--update-strut id))
;; Remove all events ;; Remove all events
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes (make-instance 'xcb:ChangeWindowAttributes
:window id :value-mask xcb:CW:EventMask :window id :value-mask xcb:CW:EventMask
:event-mask xcb:EventMask:NoEvent)) :event-mask
(if (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK
exwm-window-type)
;; Listen for change of struts property of dock.
xcb:EventMask:PropertyChange
xcb:EventMask:NoEvent)))
;; The window needs to be mapped ;; The window needs to be mapped
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window id)) (make-instance 'xcb:MapWindow :window id))

View file

@ -54,16 +54,18 @@
(defvar exwm-randr-refresh-hook nil (defvar exwm-randr-refresh-hook nil
"Normal hook run when the RandR module just refreshed.") "Normal hook run when the RandR module just refreshed.")
(defvar exwm-layout--fullscreen-frame-count) (defvar exwm-workspace--fullscreen-frame-count)
(defvar exwm-workspace-number) (defvar exwm-workspace-number)
(defvar exwm-workspace--list) (defvar exwm-workspace--list)
(declare-function exwm-layout--set-frame-fullscreen "exwm-layout.el" (frame)) (declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
(declare-function exwm-workspace--update-workareas "exwm-workspace.el"
(&optional workareas))
(defun exwm-randr--refresh () (defun exwm-randr--refresh ()
"Refresh workspaces according to the updated RandR info." "Refresh workspaces according to the updated RandR info."
(let (output-name geometry output-plist default-geometry workareas (let (output-name geometry output-plist default-geometry workareas
workarea-offset viewports) viewports)
;; Query all outputs ;; Query all outputs
(with-slots (config-timestamp outputs) (with-slots (config-timestamp outputs)
(xcb:+request-unchecked+reply exwm--connection (xcb:+request-unchecked+reply exwm--connection
@ -93,10 +95,7 @@
(setq default-geometry geometry))))))) (setq default-geometry geometry)))))))
(exwm--log "(randr) outputs: %s" output-plist) (exwm--log "(randr) outputs: %s" output-plist)
(when output-plist (when output-plist
(setq workarea-offset (if (exwm-workspace--minibuffer-own-frame-p) (setq exwm-workspace--fullscreen-frame-count 0)
0
(window-pixel-height (minibuffer-window))))
(setq exwm-layout--fullscreen-frame-count 0)
(dotimes (i exwm-workspace-number) (dotimes (i exwm-workspace-number)
(let* ((output (plist-get exwm-randr-workspace-output-plist i)) (let* ((output (plist-get exwm-randr-workspace-output-plist i))
(geometry (lax-plist-get output-plist output)) (geometry (lax-plist-get output-plist output))
@ -106,16 +105,13 @@
output nil)) output nil))
(set-frame-parameter frame 'exwm-randr-output output) (set-frame-parameter frame 'exwm-randr-output output)
(set-frame-parameter frame 'exwm-geometry geometry) (set-frame-parameter frame 'exwm-geometry geometry)
(exwm-layout--set-frame-fullscreen frame) (exwm-workspace--set-fullscreen frame)
(with-slots (x y width height) geometry (with-slots (x y width height) geometry
(setq workareas (setq workareas
(nconc workareas (list x y width (- height (nconc workareas (list x y width height))
workarea-offset)))
viewports (nconc viewports (list x y)))))) viewports (nconc viewports (list x y))))))
;; Update _NET_WORKAREA ;; Update _NET_WORKAREA
(xcb:+request exwm--connection (exwm-workspace--update-workareas (vconcat workareas))
(make-instance 'xcb:ewmh:set-_NET_WORKAREA
:window exwm--root :data (vconcat workareas)))
;; Update _NET_DESKTOP_VIEWPORT ;; Update _NET_DESKTOP_VIEWPORT
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT (make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT

View file

@ -128,6 +128,50 @@ Value nil means to use the default position which is fixed at bottom, while
"Reports whether the minibuffer is displayed in its own frame." "Reports whether the minibuffer is displayed in its own frame."
(memq exwm-workspace-minibuffer-position '(top bottom))) (memq exwm-workspace-minibuffer-position '(top bottom)))
;; FIXME: RandR and multiple docks.
(defvar exwm-workspace--strut nil "Areas occupied by struts.")
(defvar exwm-workspace--strut-is-partial nil
"Whether the struts are from _NET_WM_STRUT_PARTIAL.")
(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, with regard to its RandR output if applicable."
(let ((geometry (or (frame-parameter frame 'exwm-geometry)
(xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry
:drawable exwm--root))
(make-instance 'xcb:RECTANGLE :x 0 :y 0
:width (x-display-pixel-width)
:height (x-display-pixel-height))))
(id (frame-parameter frame 'exwm-outer-id))
(container (frame-parameter frame 'exwm-container))
(workspace (frame-parameter frame 'exwm-workspace))
x* y* width* height*)
(with-slots (x y width height) geometry
(if exwm-workspace--strut
(setq x* (+ x (aref exwm-workspace--strut 0))
y* (+ y (aref exwm-workspace--strut 2))
width* (- width (aref exwm-workspace--strut 0)
(aref exwm-workspace--strut 1))
height* (- height (aref exwm-workspace--strut 2)
(aref exwm-workspace--strut 3)))
(setq x* x
y* y
width* width
height* height))
(when (and (eq frame exwm-workspace--current)
(exwm-workspace--minibuffer-own-frame-p))
(exwm-workspace--resize-minibuffer-frame width* height*))
(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)))
(cl-incf exwm-workspace--fullscreen-frame-count))
;;;###autoload ;;;###autoload
(defun exwm-workspace--resize-minibuffer-frame (&optional width height) (defun exwm-workspace--resize-minibuffer-frame (&optional width height)
"Resize minibuffer (and its container) to fit the size of workspace. "Resize minibuffer (and its container) to fit the size of workspace.
@ -138,10 +182,19 @@ workspace frame."
(let ((y (if (eq exwm-workspace-minibuffer-position 'top) (let ((y (if (eq exwm-workspace-minibuffer-position 'top)
0 0
(- (or height (exwm-workspace--current-height)) (- (or height (exwm-workspace--current-height))
(if exwm-workspace--strut
(+ (aref exwm-workspace--strut 2)
(aref exwm-workspace--strut 3))
0)
(frame-pixel-height exwm-workspace--minibuffer)))) (frame-pixel-height exwm-workspace--minibuffer))))
(width (or width (exwm-workspace--current-width)))
(container (frame-parameter exwm-workspace--minibuffer (container (frame-parameter exwm-workspace--minibuffer
'exwm-container))) 'exwm-container)))
(unless width
(setq width (exwm-workspace--current-width)))
(when exwm-workspace--strut
(setq width (- width
(aref exwm-workspace--strut 0)
(aref exwm-workspace--strut 1))))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow
:window container :window container
@ -491,7 +544,12 @@ The optional FORCE option is for internal use only."
(setq value-mask xcb:ConfigWindow:Height (setq value-mask xcb:ConfigWindow:Height
y 0) y 0)
(setq value-mask (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height) (setq value-mask (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height)
y (- (exwm-workspace--current-height) height))) y (- (exwm-workspace--current-height)
(if exwm-workspace--strut
(+ (aref exwm-workspace--strut 2)
(aref exwm-workspace--strut 3))
0)
height)))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow
:window (frame-parameter exwm-workspace--minibuffer :window (frame-parameter exwm-workspace--minibuffer
@ -638,6 +696,38 @@ The optional FORCE option is for internal use only."
(server-save-buffers-kill-terminal nil) (server-save-buffers-kill-terminal nil)
nil))) nil)))
(defun exwm-workspace--update-workareas (&optional workareas)
"Update _NET_WORKAREA."
;; Calculate workareas if not present.
(unless workareas
(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 (vconcat workareas (vector x y width height)))))
(let ((workarea (vector 0 0 (x-display-pixel-width)
(x-display-pixel-height))))
(dotimes (_ exwm-workspace-number)
(setq workareas (vconcat workareas workarea))))))
;; Exclude areas occupied by struts.
;; FIXME: RandR.
(when exwm-workspace--strut
(let ((dx (aref exwm-workspace--strut 0))
(dy (aref exwm-workspace--strut 2))
(dw (- (+ (aref exwm-workspace--strut 0)
(aref exwm-workspace--strut 1))))
(dh (- (+ (aref exwm-workspace--strut 2)
(aref exwm-workspace--strut 3)))))
(dotimes (i exwm-workspace-number)
(cl-incf (aref workareas (* i 4)) dx)
(cl-incf (aref workareas (+ (* i 4))) dy)
(cl-incf (aref workareas (+ (* i 4) 2)) dw)
(cl-incf (aref workareas (+ (* i 4) 3)) dh))))
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WORKAREA
:window exwm--root :data workareas))
(xcb:flush exwm--connection))
(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--init () (defun exwm-workspace--init ()
@ -794,6 +884,8 @@ The optional FORCE option is for internal use only."
(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_WORKAREA.
(exwm-workspace--update-workareas)
;; Set _NET_VIRTUAL_ROOTS ;; Set _NET_VIRTUAL_ROOTS
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_VIRTUAL_ROOTS (make-instance 'xcb:ewmh:set-_NET_VIRTUAL_ROOTS
@ -824,8 +916,6 @@ The optional FORCE option is for internal use only."
(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))
(defvar exwm-layout--fullscreen-frame-count)
(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."
;; Make the workspaces fullscreen. ;; Make the workspaces fullscreen.
@ -833,7 +923,7 @@ The optional FORCE option is for internal use only."
(set-frame-parameter i 'fullscreen 'fullboth)) (set-frame-parameter i 'fullscreen 'fullboth))
;; Wait until all workspace frames are resized. ;; Wait until all workspace frames are resized.
(with-timeout (1) (with-timeout (1)
(while (< exwm-layout--fullscreen-frame-count exwm-workspace-number) (while (< exwm-workspace--fullscreen-frame-count exwm-workspace-number)
(accept-process-output nil 0.1)))) (accept-process-output nil 0.1))))

63
exwm.el
View file

@ -236,6 +236,46 @@
;; Default to normal state ;; Default to normal state
xcb:icccm:WM_STATE:NormalState))))))) xcb:icccm:WM_STATE:NormalState)))))))
(defun exwm--update-strut-legacy (id)
"Update _NET_WM_STRUT."
(unless exwm-workspace--strut-is-partial
(let ((reply (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:ewmh:get-_NET_WM_STRUT
:window id))))
(setq exwm-workspace--strut (when reply (slot-value reply 'value)))
;; Update workspaces.
(dolist (f exwm-workspace--list)
(exwm-workspace--set-fullscreen f))
;; Resize the minibuffer frame.
(when (exwm-workspace--minibuffer-own-frame-p)
(exwm-workspace--resize-minibuffer-frame))
;; Update _NET_WORKAREA.
(exwm-workspace--update-workareas))))
(defun exwm--update-strut-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))))
(setq exwm-workspace--strut (when reply (slot-value reply 'value)))
(if (not exwm-workspace--strut)
(setq exwm-workspace--strut-is-partial nil)
(setq exwm-workspace--strut (substring exwm-workspace--strut 0 4))
(setq exwm-workspace--strut-is-partial t))
;; Update workspaces.
(dolist (f exwm-workspace--list)
(exwm-workspace--set-fullscreen f))
;; Resize the minibuffer frame.
(when (exwm-workspace--minibuffer-own-frame-p)
(exwm-workspace--resize-minibuffer-frame))
;; Update _NET_WORKAREA.
(exwm-workspace--update-workareas)))
(defun exwm--update-strut (id)
"Update _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT."
(exwm--update-strut-partial id)
(exwm--update-strut-legacy id))
(defun exwm--on-PropertyNotify (data _synthetic) (defun exwm--on-PropertyNotify (data _synthetic)
"Handle PropertyNotify event." "Handle PropertyNotify event."
(let ((obj (make-instance 'xcb:PropertyNotify)) (let ((obj (make-instance 'xcb:PropertyNotify))
@ -245,7 +285,12 @@
atom (slot-value obj 'atom) atom (slot-value obj 'atom)
exwm-input--timestamp (slot-value obj 'time)) exwm-input--timestamp (slot-value obj 'time))
(setq buffer (exwm--id->buffer id)) (setq buffer (exwm--id->buffer id))
(when (buffer-live-p buffer) (if (not (buffer-live-p buffer))
;; Properties of unmanaged X windows.
(cond ((= atom xcb:Atom:_NET_WM_STRUT)
(exwm--update-strut-legacy id))
((= atom xcb:Atom:_NET_WM_STRUT_PARTIAL)
(exwm--update-strut-partial id)))
(with-current-buffer buffer (with-current-buffer buffer
(cond ((= atom xcb:Atom:_NET_WM_WINDOW_TYPE) (cond ((= atom xcb:Atom:_NET_WM_WINDOW_TYPE)
(exwm--update-window-type id t)) (exwm--update-window-type id t))
@ -326,7 +371,7 @@
(= action xcb:ewmh:_NET_WM_STATE_ADD)) (= action xcb:ewmh:_NET_WM_STATE_ADD))
(dolist (f exwm-workspace--list) (dolist (f exwm-workspace--list)
(when (equal (frame-parameter f 'exwm-outer-id) id) (when (equal (frame-parameter f 'exwm-outer-id) id)
(exwm-layout--set-frame-fullscreen f) (exwm-workspace--set-fullscreen f)
(xcb:+request (xcb:+request
exwm--connection exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_STATE (make-instance 'xcb:ewmh:set-_NET_WM_STATE
@ -410,6 +455,8 @@
xcb:Atom:_NET_REQUEST_FRAME_EXTENTS xcb:Atom:_NET_REQUEST_FRAME_EXTENTS
xcb:Atom:_NET_FRAME_EXTENTS xcb:Atom:_NET_FRAME_EXTENTS
xcb:Atom:_NET_WM_NAME xcb:Atom:_NET_WM_NAME
xcb:Atom:_NET_WM_STRUT
xcb:Atom:_NET_WM_STRUT_PARTIAL
;; ;;
xcb:Atom:_NET_WM_WINDOW_TYPE xcb:Atom:_NET_WM_WINDOW_TYPE
xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLBAR xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLBAR
@ -458,18 +505,6 @@
(make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT (make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT
:window exwm--root :window exwm--root
:data (make-vector (* 2 exwm-workspace-number) 0))) :data (make-vector (* 2 exwm-workspace-number) 0)))
;; Set _NET_WORKAREA (with minibuffer excluded)
(let* ((workareas
(vector 0 0 (x-display-pixel-width)
(- (x-display-pixel-height)
(if (exwm-workspace--minibuffer-own-frame-p)
0
(window-pixel-height (minibuffer-window))))))
(workareas (mapconcat (lambda (_) workareas)
(make-list exwm-workspace-number 0) [])))
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WORKAREA
:window exwm--root :data workareas)))
(xcb:flush exwm--connection)) (xcb:flush exwm--connection))
(defvar exwm-init-hook nil (defvar exwm-init-hook nil