mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add/improve some ICCCM/EWMH features

Browse source 
* exwm-floating.el (exwm-floating--set-allowed-actions)
(exwm-floating--set-floating, exwm-floating--unset-floating):
Add _NET_WM_ALLOWED_ACTIONS support.

* exwm-floating.el (exwm-floating--set-floating)
(exwm-floating--unset-floating): Support initial state hint.
* exwm.el (exwm--update-hints): Fetch initial state.
(exwm--update-state, exwm--on-PropertyNotify):
WM_STATE is not intended to be read.
* exwm-core.el (exwm-state):
* exwm-floating.el (exwm-floating-hide):
* exwm-input.el (exwm-input--update-focus):
* exwm-layout.el (exwm-layout--set-state)
(exwm-layout--iconic-state-p, exwm-layout--show, exwm-layout--hide):
* exwm-manage.el (exwm-manage--on-MapRequest):
Improve WM_STATE support.

* exwm-input.el (exwm-input--set-focus):
* exwm-input.el (exwm-input--update-focus)
(exwm-input--set-active-window):
* exwm.el (exwm--on-ClientMessage): Add _NET_ACTIVE_WINDOW support.

* exwm-layout.el (exwm-layout--set-client-list-stacking):
Improve _NET_CLIENT_LIST_STACKING support.

* exwm-manage.el (exwm-manage--set-client-list)
(exwm-manage--manage-window, exwm-manage--unmanage-window):
Improve _NET_CLIENT_LIST support.

* exwm-manage.el (exwm-manage--manage-window):
* exwm-workspace.el (exwm-workspace--set-desktop)
(exwm-workspace-move-window):
* exwm.el (exwm--on-ClientMessage): Add _NET_WM_DESKTOP support.

* exwm-randr.el (exwm-randr--refresh):
* exwm-workspace.el (exwm-workspace--set-desktop-geometry)
(exwm-workspace--init): Add _NET_DESKTOP_GEOMETRY support.

* exwm-workspace.el (exwm-workspace--set-desktop-geometry):
Renamed from `exwm-workspace--update-desktop-geometry'.
* exwm-randr.el (exwm-randr--refresh): Improve _NET_WORKAREA support.

* exwm-workspace.el (exwm-workspace--set-fullscreen):
Correct variables names.

* exwm-workspace.el (exwm-workspace--init):
* exwm.el (exwm--init-icccm-ewmh):
Set _NET_NUMBER_OF_DESKTOPS in workspace module.

* exwm-workspace.el (exwm-workspace--init):
* exwm.el (exwm--init-icccm-ewmh):
Set _NET_DESKTOP_VIEWPORT in workspace module.

* exwm.el (exwm--on-ClientMessage): Improve _NET_CURRENT_DESKTOP
support.

* exwm.el (exwm--on-ClientMessage): Add _NET_CLOSE_WINDOW support.

* exwm.el (exwm--on-ClientMessage): Add WM_CHANGE_STATE support.

* exwm.el (exwm--init-icccm-ewmh): Update supported atoms.
This commit is contained in:
Chris Feng 2016-07-13 18:51:32 +08:00
parent eee5c6fa4d
commit 6c8255bf39
8 changed files with 310 additions and 131 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
exwm-core.el
View file

@ -101,7 +101,7 @@
(defvar-local exwm--title-is-utf8 nil)
(defvar-local exwm-transient-for nil "WM_TRANSIENT_FOR.")
(defvar-local exwm--protocols nil)
(defvar-local exwm-state nil "WM_STATE.")
(defvar-local exwm-state xcb:icccm:WM_STATE:NormalState "WM_STATE.")
;; _NET_WM_NORMAL_HINTS
(defvar-local exwm--normal-hints-x nil)
(defvar-local exwm--normal-hints-y nil)

46
exwm-floating.el
View file

@ -49,13 +49,31 @@
(defvar exwm-floating--cursor-bottom-left nil)
(defvar exwm-floating--cursor-left nil)
(defun exwm-floating--set-allowed-actions (id tilling)
"Set _NET_WM_ALLOWED_ACTIONS."
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_ALLOWED_ACTIONS
:window id
:data (if tilling
(vector xcb:Atom:_NET_WM_ACTION_MINIMIZE
xcb:Atom:_NET_WM_ACTION_FULLSCREEN
xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP
xcb:Atom:_NET_WM_ACTION_CLOSE)
(vector xcb:Atom:_NET_WM_ACTION_MOVE
xcb:Atom:_NET_WM_ACTION_RESIZE
xcb:Atom:_NET_WM_ACTION_MINIMIZE
xcb:Atom:_NET_WM_ACTION_FULLSCREEN
xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP
xcb:Atom:_NET_WM_ACTION_CLOSE)))))
(defvar exwm-workspace--current)
(defvar exwm-workspace--list)
(defvar exwm-workspace-current-index)
(defvar exwm-workspace--switch-history-outdated)
(declare-function exwm-layout--refresh "exwm-layout.el")
(declare-function exwm-layout--show "exwm-layout.el")
(declare-function exwm-layout--refresh "exwm-layout.el" ())
(declare-function exwm-layout--show "exwm-layout.el" (id &optional window))
(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id))
(defun exwm-floating--set-floating (id)
"Make window ID floating."
@ -205,6 +223,7 @@
xcb:ConfigWindow:Y))
:x (- x exwm-floating-border-width)
:y (- y exwm-floating-border-width)))
(exwm-floating--set-allowed-actions id nil)
(xcb:flush exwm--connection)
;; Set window/buffer
(with-current-buffer (exwm--id->buffer id)
@ -217,9 +236,13 @@
(add-hook 'window-configuration-change-hook #'exwm-layout--refresh)
(set-window-dedicated-p window t)
(exwm-layout--show id window))
(with-selected-frame exwm-workspace--current
(exwm-layout--refresh))
(select-frame-set-input-focus frame))
(if (exwm-layout--iconic-state-p id)
;; Hide iconic floating X windows.
(with-current-buffer (exwm--id->buffer id)
(exwm-floating-hide))
(with-selected-frame exwm-workspace--current
(exwm-layout--refresh))
(select-frame-set-input-focus frame)))
(run-hooks 'exwm-floating-setup-hook)
;; Redraw the frame.
(redisplay))
@ -269,6 +292,7 @@
:sibling (frame-parameter exwm-workspace--current
'exwm-container)
:stack-mode xcb:StackMode:Above)))
(exwm-floating--set-allowed-actions id t)
(xcb:flush exwm--connection)
(with-current-buffer buffer
(when exwm--floating-frame ;from floating to non-floating
@ -278,9 +302,11 @@
(setq window-size-fixed nil
exwm--floating-frame nil
exwm--frame exwm-workspace--current))
(let ((window (frame-selected-window exwm-workspace--current)))
(set-window-buffer window buffer)
(select-window window)))
(unless (exwm-layout--iconic-state-p)
;; Only show X windows in normal state.
(let ((window (frame-selected-window exwm-workspace--current)))
(set-window-buffer window buffer)
(select-window window))))
(run-hooks 'exwm-floating-exit-hook))
;;;###autoload
@ -292,6 +318,8 @@
(exwm-floating--unset-floating exwm--id)
(exwm-floating--set-floating exwm--id))))
(declare-function exwm-layout--set-state "exwm-layout.el" (id state))
;;;###autoload
(defun exwm-floating-hide ()
"Hide the current floating X window (which would show again when selected)."
@ -304,7 +332,7 @@
:window exwm--container
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:Below))
;; FIXME: Should it be put into iconic state?
(exwm-layout--set-state exwm--id xcb:icccm:WM_STATE:IconicState)
(xcb:flush exwm--connection)
(select-frame-set-input-focus exwm-workspace--current)))

19
exwm-input.el
View file

@ -76,6 +76,7 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
:revert-to xcb:InputFocus:PointerRoot
:focus id
:time xcb:Time:CurrentTime)))
(exwm-input--set-active-window id)
(xcb:flush exwm--connection))))
(defvar exwm-input--focus-window nil "The (Emacs) window to be focused.")
@ -99,6 +100,9 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
(defvar exwm-workspace-current-index)
(defvar exwm-workspace--minibuffer)
(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id))
(declare-function exwm-layout--set-state "exwm-layout.el" (id state))
(defun exwm-input--update-focus ()
"Update input focus."
(when (and (window-live-p exwm-input--focus-window)
@ -136,13 +140,26 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
:window exwm--container
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:Above)))
;; This floating X window might be hide by `exwm-floating-hide'.
(when (exwm-layout--iconic-state-p)
(exwm-layout--set-state exwm--id
xcb:icccm:WM_STATE:NormalState))
(xcb:flush exwm--connection)))
(when (eq (selected-window) exwm-input--focus-window)
(exwm--log "Focus on %s" exwm-input--focus-window)
(select-frame-set-input-focus (window-frame exwm-input--focus-window)
t)))
t)
(exwm-input--set-active-window)
(xcb:flush exwm--connection)))
(setq exwm-input--focus-window nil))))
(defun exwm-input--set-active-window (&optional id)
"Set _NET_ACTIVE_WINDOW."
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_ACTIVE_WINDOW
:window exwm--root
:data (or id xcb:Window:None))))
(defvar exwm-input--during-key-sequence nil
"Non-nil indicates Emacs is waiting for more keys to form a key sequence.")
(defvar exwm-input--temp-line-mode nil

68
exwm-layout.el
View file

@ -50,6 +50,20 @@
xcb:ConfigWindow:Height))
:width width :height height))))
(defun exwm-layout--set-state (id state)
"Set WM_STATE."
(xcb:+request exwm--connection
(make-instance 'xcb:icccm:set-WM_STATE
:window id :state state :icon xcb:Window:None))
(with-current-buffer (exwm--id->buffer id)
(setq exwm-state state)))
(defun exwm-layout--iconic-state-p (&optional id)
(= xcb:icccm:WM_STATE:IconicState
(if id
(buffer-local-value 'exwm-state (exwm--id->buffer id))
exwm-state)))
(defun exwm-layout--show (id &optional window)
"Show window ID exactly fit in the Emacs window WINDOW."
(exwm--log "Show #x%x in %s" id window)
@ -101,11 +115,7 @@
(xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window id))
(xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window exwm--container))
(xcb:+request exwm--connection
(make-instance 'xcb:icccm:set-WM_STATE
:window id :state xcb:icccm:WM_STATE:NormalState
:icon xcb:Window:None))
(setq exwm-state xcb:icccm:WM_STATE:NormalState))
(exwm-layout--set-state id xcb:icccm:WM_STATE:NormalState))
(xcb:+request exwm--connection
(make-instance 'xcb:SendEvent
:propagate 0 :destination id
@ -125,25 +135,21 @@
(defun exwm-layout--hide (id)
"Hide window ID."
(with-current-buffer (exwm--id->buffer id)
(unless (eq xcb:icccm:WM_STATE:IconicState exwm-state) ;already hidden
(unless (exwm-layout--iconic-state-p) ;already hidden
(exwm--log "Hide #x%x" id)
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window id :value-mask xcb:CW:EventMask
:event-mask xcb:EventMask:NoEvent))
(xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window id))
(xcb:+request exwm--connection
(make-instance 'xcb:UnmapWindow :window id))
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window id :value-mask xcb:CW:EventMask
:event-mask exwm--client-event-mask))
(xcb:+request exwm--connection
(make-instance 'xcb:UnmapWindow :window exwm--container))
(xcb:+request exwm--connection
(make-instance 'xcb:icccm:set-WM_STATE
:window id
:state xcb:icccm:WM_STATE:IconicState
:icon xcb:Window:None))
(setq exwm-state xcb:icccm:WM_STATE:IconicState)
(exwm-layout--set-state id xcb:icccm:WM_STATE:IconicState)
(xcb:flush exwm--connection))))
(defvar exwm-workspace--current)
@ -243,6 +249,29 @@ selected by `other-buffer'."
(defvar exwm-layout-show-all-buffers nil
"Non-nil to allow switching to buffers on other workspaces.")
(defun exwm-layout--set-client-list-stacking ()
"Set _NET_CLIENT_LIST_STACKING."
(let (id clients-floating clients clients-iconic clients-other)
(dolist (pair exwm--id-buffer-alist)
(setq id (car pair))
(with-current-buffer (cdr pair)
(if (eq exwm--frame exwm-workspace--current)
(if exwm--floating-frame
;; A floating X window on the current workspace.
(setq clients-floating (cons id clients-floating))
(if (get-buffer-window (cdr pair) exwm-workspace--current)
;; A normal tilling X window on the current workspace.
(setq clients (cons id clients))
;; An iconic tilling X window on the current workspace.
(setq clients-iconic (cons id clients-iconic))))
;; X window on other workspaces.
(setq clients-other (cons id clients-other)))))
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST_STACKING
:window exwm--root
:data (vconcat (append clients-other clients-iconic
clients clients-floating))))))
(defun exwm-layout--refresh ()
"Refresh layout."
(let ((frame (selected-frame))
@ -310,18 +339,7 @@ selected by `other-buffer'."
(when (and (eq major-mode 'exwm-mode)
(or exwm--floating-frame (not (eq frame exwm--frame))))
(switch-to-prev-buffer window)))))
;; Update _NET_CLIENT_LIST_STACKING
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST_STACKING
:window exwm--root
:data (vconcat
(delq nil
(mapcar
(lambda (buffer)
(with-current-buffer buffer
(when (eq major-mode 'exwm-mode)
exwm--id)))
(buffer-list))))))
(exwm-layout--set-client-list-stacking)
(xcb:flush exwm--connection))))
(defun exwm-layout--on-minibuffer-setup ()

46
exwm-manage.el
View file

@ -68,8 +68,16 @@ corresponding buffer.")
(elt value 2))) ;MotifWmHints.decorations
(setq exwm--mwm-hints-decorations nil))))))))
(defun exwm-manage--set-client-list ()
"Set _NET_CLIENT_LIST."
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST
:window exwm--root
:data (vconcat (mapcar #'car exwm--id-buffer-alist)))))
(defvar exwm-workspace--current)
(defvar exwm-workspace--switch-history-outdated)
(defvar exwm-workspace-current-index)
(declare-function exwm--update-window-type "exwm.el" (id &optional force))
(declare-function exwm--update-class "exwm.el" (id &optional force))
@ -78,10 +86,10 @@ corresponding buffer.")
(declare-function exwm--update-title "exwm.el" (id))
(declare-function exwm--update-hints "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-strut "exwm.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-workspace--set-desktop "exwm-workspace.el" (id))
(defun exwm-manage--manage-window (id)
"Manage window ID."
@ -94,7 +102,9 @@ corresponding buffer.")
:event-mask exwm--client-event-mask))
(throw 'return 'dead))
(with-current-buffer (generate-new-buffer "*EXWM*")
(push `(,id . ,(current-buffer)) exwm--id-buffer-alist)
;; Keep the oldest X window first.
(setq exwm--id-buffer-alist
(nconc exwm--id-buffer-alist `((,id . ,(current-buffer)))))
(exwm-mode)
(setq exwm--id id)
(exwm--update-window-type id)
@ -213,14 +223,10 @@ corresponding buffer.")
:keyboard-mode xcb:GrabMode:Async
:confine-to xcb:Window:None :cursor xcb:Cursor:None
:button button :modifiers xcb:ModMask:Any)))
(xcb:+request exwm--connection ;update _NET_CLIENT_LIST
(make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST
:window exwm--root
:data (vconcat (mapcar #'car exwm--id-buffer-alist))))
(exwm-manage--set-client-list)
(xcb:flush exwm--connection)
(exwm--update-title id)
(exwm--update-protocols id)
(exwm--update-state id)
(if (or exwm-transient-for exwm--fixed-size
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY exwm-window-type)
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG exwm-window-type))
@ -228,6 +234,16 @@ corresponding buffer.")
(exwm-floating--unset-floating id))
(exwm-input-grab-keyboard id)
(setq exwm-workspace--switch-history-outdated t)
;; Set _NET_WM_DESKTOP or move window.
(let ((reply (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:ewmh:get-_NET_WM_DESKTOP
:window id)))
desktop)
(when reply
(setq desktop (slot-value reply 'value)))
(if (and desktop (/= desktop exwm-workspace-current-index))
(exwm-workspace-move-window desktop id)
(exwm-workspace--set-desktop id)))
(with-current-buffer (exwm--id->buffer id)
(run-hooks 'exwm-manage-finish-hook)))))
@ -297,10 +313,7 @@ corresponding buffer.")
(when floating
(select-window
(frame-selected-window exwm-workspace--current)))))
(xcb:+request exwm--connection ;update _NET_CLIENT_LIST
(make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST
:window exwm--root
:data (vconcat (mapcar #'car exwm--id-buffer-alist))))
(exwm-manage--set-client-list)
(xcb:flush exwm--connection))))
(defun exwm-manage--scan ()
@ -523,13 +536,22 @@ border-width: %d; sibling: #x%x; stack-mode: %d"
:stack-mode stack-mode))))))
(xcb:flush exwm--connection))
(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id))
(defun exwm-manage--on-MapRequest (data _synthetic)
"Handle MapRequest event."
(let ((obj (make-instance 'xcb:MapRequest)))
(xcb:unmarshal obj data)
(with-slots (parent window) obj
(if (assoc window exwm--id-buffer-alist)
(exwm--log "#x%x is already managed" window)
(with-current-buffer (exwm--id->buffer window)
(if (exwm-layout--iconic-state-p)
;; State change: iconic => normal.
(when (eq exwm--frame exwm-workspace--current)
(set-window-buffer (frame-selected-window exwm--frame)
(current-buffer))
(select-window (frame-selected-window exwm--frame)))
(exwm--log "#x%x is already managed" window)))
(if (/= exwm--root parent)
(progn (xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window window))

21
exwm-randr.el
View file

@ -59,13 +59,13 @@
(defvar exwm-workspace--list)
(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame))
(declare-function exwm-workspace--update-workareas "exwm-workspace.el"
(declare-function exwm-workspace--set-workareas "exwm-workspace.el"
(&optional workareas))
(declare-function exwm-workspace--set-desktop-geometry "exwm-workspace.el" ())
(defun exwm-randr--refresh ()
"Refresh workspaces according to the updated RandR info."
(let (output-name geometry output-plist default-geometry workareas
viewports)
(let (output-name geometry output-plist default-geometry workareas)
;; Query all outputs
(with-slots (config-timestamp outputs)
(xcb:+request-unchecked+reply exwm--connection
@ -107,16 +107,11 @@
(set-frame-parameter frame 'exwm-geometry geometry)
(exwm-workspace--set-fullscreen frame)
(with-slots (x y width height) geometry
(setq workareas
(nconc workareas (list x y width height))
viewports (nconc viewports (list x y))))))
;; Update _NET_WORKAREA
(exwm-workspace--update-workareas (vconcat workareas))
;; Update _NET_DESKTOP_VIEWPORT
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT
:window exwm--root
:data (vconcat viewports)))
(setq workareas (nconc workareas (list x y width height))))))
;; Set _NET_DESKTOP_GEOMETRY.
(exwm-workspace--set-desktop-geometry)
;; Set _NET_WORKAREA.
(exwm-workspace--set-workareas (vconcat workareas))
(xcb:flush exwm--connection)
(run-hooks 'exwm-randr-refresh-hook))))

45
exwm-workspace.el
View file

@ -166,7 +166,7 @@ Value nil means to use the default position which is fixed at bottom, while
height* height))
(when (and (eq frame exwm-workspace--current)
(exwm-workspace--minibuffer-own-frame-p))
(exwm-workspace--resize-minibuffer-frame width* height*))
(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)))
@ -275,7 +275,7 @@ The optional FORCE option is for internal use only."
(set-frame-parameter frame 'exwm--urgency nil)
;; Update switch workspace history
(setq exwm-workspace--switch-history-outdated t)
;; Update _NET_CURRENT_DESKTOP
;; Set _NET_CURRENT_DESKTOP.
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_CURRENT_DESKTOP
:window exwm--root :data index))
@ -292,6 +292,14 @@ The optional FORCE option is for internal use only."
(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)
@ -433,7 +441,10 @@ The optional FORCE option is for internal use only."
:stack-mode xcb:StackMode:Above)))
(xcb:flush exwm--connection)
(set-window-buffer (frame-selected-window frame)
(exwm--id->buffer id)))))
(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
@ -696,8 +707,17 @@ The optional FORCE option is for internal use only."
(server-save-buffers-kill-terminal nil)
nil)))
(defun exwm-workspace--update-workareas (&optional workareas)
"Update _NET_WORKAREA."
(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))))
(defun exwm-workspace--set-workareas (&optional workareas)
"Set _NET_WORKAREA."
;; Calculate workareas if not present.
(unless workareas
(if (frame-parameter (car exwm-workspace--list) 'exwm-geometry)
@ -884,9 +904,20 @@ The optional FORCE option is for internal use only."
(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)
;; 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 exwm-workspace-number))
;; 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-number) 0)))
;; Set _NET_WORKAREA.
(exwm-workspace--update-workareas)
;; Set _NET_VIRTUAL_ROOTS
(exwm-workspace--set-workareas)
;; Set _NET_VIRTUAL_ROOTS (it's currently fixed.)
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_VIRTUAL_ROOTS
:window exwm--root

194
exwm.el
View file

@ -203,10 +203,12 @@
(let ((reply (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:icccm:get-WM_HINTS :window id))))
(when (and reply (slot-value reply 'flags)) ;nil when destroyed
(with-slots (flags input) reply
(with-slots (flags input initial-state) reply
(when flags
(unless (= 0 (logand flags xcb:icccm:WM_HINTS:InputHint))
(setq exwm--hints-input (when input (= 1 input))))
(unless (= 0 (logand flags xcb:icccm:WM_HINTS:StateHint))
(setq exwm-state initial-state))
(unless (= 0 (logand flags xcb:icccm:WM_HINTS:UrgencyHint))
(setq exwm--hints-urgency t))))
(when (and exwm--hints-urgency
@ -225,17 +227,6 @@
(when reply ;nil when destroyed
(setq exwm--protocols (append (slot-value reply 'value) nil)))))))
(defun exwm--update-state (id &optional force)
"Update WM_STATE."
(with-current-buffer (exwm--id->buffer id)
(unless (and exwm-state (not force))
(let ((reply (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:icccm:get-WM_STATE :window id))))
(when reply ;nil when destroyed
(setq exwm-state (or (slot-value reply 'state)
;; Default to normal state
xcb:icccm:WM_STATE:NormalState)))))))
(defun exwm--update-strut-legacy (id)
"Update _NET_WM_STRUT."
(unless exwm-workspace--strut-is-partial
@ -250,7 +241,7 @@
(when (exwm-workspace--minibuffer-own-frame-p)
(exwm-workspace--resize-minibuffer-frame))
;; Update _NET_WORKAREA.
(exwm-workspace--update-workareas))))
(exwm-workspace--set-workareas))))
(defun exwm--update-strut-partial (id)
"Update _NET_WM_STRUT_PARTIAL."
@ -269,7 +260,7 @@
(when (exwm-workspace--minibuffer-own-frame-p)
(exwm-workspace--resize-minibuffer-frame))
;; Update _NET_WORKAREA.
(exwm-workspace--update-workareas)))
(exwm-workspace--set-workareas)))
(defun exwm--update-strut (id)
"Update _NET_WM_STRUT_PARTIAL or _NET_WM_STRUT."
@ -308,8 +299,6 @@
(exwm--update-hints id t))
((= atom xcb:Atom:WM_PROTOCOLS)
(exwm--update-protocols id t))
((= atom xcb:Atom:WM_STATE)
(exwm--update-state id t))
((= atom xcb:Atom:_NET_WM_USER_TIME)) ;ignored
(t (exwm--log "Unhandled PropertyNotify: %s(%d)"
(x-get-atom-name atom exwm-workspace--current)
@ -324,6 +313,26 @@
id (slot-value obj 'window)
data (slot-value (slot-value obj 'data) 'data32))
(cond
;; _NET_CURRENT_DESKTOP.
((= type xcb:Atom:_NET_CURRENT_DESKTOP)
(exwm-workspace-switch (elt data 0)))
;; _NET_ACTIVE_WINDOW.
((= type xcb:Atom:_NET_ACTIVE_WINDOW)
(let ((buffer (exwm--id->buffer id)))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (eq exwm--frame exwm-workspace--current)
(when (exwm-layout--iconic-state-p)
;; State change: iconic => normal.
(set-window-buffer (frame-selected-window exwm--frame)
(current-buffer)))
;; Focus transfer.
(select-window (get-buffer-window)))))))
;; _NET_CLOSE_WINDOW.
((= type xcb:Atom:_NET_CLOSE_WINDOW)
(let ((buffer (exwm--id->buffer id)))
(when (buffer-live-p buffer)
(kill-buffer buffer))))
;; _NET_WM_MOVERESIZE
((= type xcb:Atom:_NET_WM_MOVERESIZE)
(let ((direction (elt data 2))
@ -359,6 +368,11 @@
:window id :left left :right right
:top top :bottom btm)))
(xcb:flush exwm--connection))
;; _NET_WM_DESKTOP.
((= type xcb:Atom:_NET_WM_DESKTOP)
(let ((buffer (exwm--id->buffer id)))
(when (buffer-live-p buffer)
(exwm-workspace-move-window (elt data 0) id))))
;; _NET_WM_STATE
((= type xcb:Atom:_NET_WM_STATE)
(let ((action (elt data 0))
@ -428,6 +442,12 @@
(cond ((= type xcb:Atom:_NET_WM_PING)
(setq exwm-manage--ping-lock nil))
(t (exwm--log "Unhandled WM_PROTOCOLS of type: %d" type)))))
((= type xcb:Atom:WM_CHANGE_STATE)
(let ((buffer (exwm--id->buffer id)))
(when (and (buffer-live-p buffer)
(= (elt data 0) xcb:icccm:WM_STATE:IconicState))
(with-current-buffer buffer
(bury-buffer)))))
(t (exwm--log "Unhandled client message: %s" obj)))))
(defun exwm--init-icccm-ewmh ()
@ -435,49 +455,106 @@
;; Handle PropertyNotify event
(xcb:+event exwm--connection 'xcb:PropertyNotify #'exwm--on-PropertyNotify)
;; Handle relevant client messages
;; FIXME: WM_STATE client messages (normal => iconic)
;; WM_COLORMAP_NOTIFY
(xcb:+event exwm--connection 'xcb:ClientMessage #'exwm--on-ClientMessage)
;; Set _NET_SUPPORTED
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_SUPPORTED
:window exwm--root
:data (vector xcb:Atom:_NET_SUPPORTED
xcb:Atom:_NET_CLIENT_LIST
xcb:Atom:_NET_CLIENT_LIST_STACKING
xcb:Atom:_NET_NUMBER_OF_DESKTOPS
xcb:Atom:_NET_DESKTOP_VIEWPORT
xcb:Atom:_NET_CURRENT_DESKTOP
xcb:Atom:_NET_WORKAREA
xcb:Atom:_NET_SUPPORTING_WM_CHECK
xcb:Atom:_NET_VIRTUAL_ROOTS
xcb:Atom:_NET_WM_MOVERESIZE
xcb:Atom:_NET_REQUEST_FRAME_EXTENTS
xcb:Atom:_NET_FRAME_EXTENTS
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_TOOLBAR
xcb:Atom:_NET_WM_WINDOW_TYPE_MENU
xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY
xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH
xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG
xcb:Atom:_NET_WM_WINDOW_TYPE_DROPDOWN_MENU
xcb:Atom:_NET_WM_WINDOW_TYPE_POPUP_MENU
xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLTIP
xcb:Atom:_NET_WM_WINDOW_TYPE_NOTIFICATION
xcb:Atom:_NET_WM_WINDOW_TYPE_COMBO
xcb:Atom:_NET_WM_WINDOW_TYPE_DND
xcb:Atom:_NET_WM_WINDOW_TYPE_NORMAL
;;
xcb:Atom:_NET_WM_STATE
xcb:Atom:_NET_WM_STATE_MODAL
xcb:Atom:_NET_WM_STATE_FULLSCREEN
xcb:Atom:_NET_WM_STATE_DEMANDS_ATTENTION
;; FIXME: more?
)))
:data (vector
;; Root windows properties.
xcb:Atom:_NET_SUPPORTED
xcb:Atom:_NET_CLIENT_LIST
xcb:Atom:_NET_CLIENT_LIST_STACKING
xcb:Atom:_NET_NUMBER_OF_DESKTOPS
xcb:Atom:_NET_DESKTOP_GEOMETRY
xcb:Atom:_NET_DESKTOP_VIEWPORT
xcb:Atom:_NET_CURRENT_DESKTOP
;; xcb:Atom:_NET_DESKTOP_NAMES
xcb:Atom:_NET_ACTIVE_WINDOW
xcb:Atom:_NET_WORKAREA
xcb:Atom:_NET_SUPPORTING_WM_CHECK
xcb:Atom:_NET_VIRTUAL_ROOTS
;; xcb:Atom:_NET_DESKTOP_LAYOUT
;; xcb:Atom:_NET_SHOWING_DESKTOP
;; Other root window messages.
xcb:Atom:_NET_CLOSE_WINDOW
;; xcb:Atom:_NET_MOVERESIZE_WINDOW
xcb:Atom:_NET_WM_MOVERESIZE
;; xcb:Atom:_NET_RESTACK_WINDOW
xcb:Atom:_NET_REQUEST_FRAME_EXTENTS
;; Application window properties.
xcb:Atom:_NET_WM_NAME
;; xcb:Atom:_NET_WM_VISIBLE_NAME
;; xcb:Atom:_NET_WM_ICON_NAME
;; xcb:Atom:_NET_WM_VISIBLE_ICON_NAME
xcb:Atom:_NET_WM_DESKTOP
;;
xcb:Atom:_NET_WM_WINDOW_TYPE
;; xcb:Atom:_NET_WM_WINDOW_TYPE_DESKTOP
xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK
xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLBAR
xcb:Atom:_NET_WM_WINDOW_TYPE_MENU
xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY
xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH
xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG
xcb:Atom:_NET_WM_WINDOW_TYPE_DROPDOWN_MENU
xcb:Atom:_NET_WM_WINDOW_TYPE_POPUP_MENU
xcb:Atom:_NET_WM_WINDOW_TYPE_TOOLTIP
xcb:Atom:_NET_WM_WINDOW_TYPE_NOTIFICATION
xcb:Atom:_NET_WM_WINDOW_TYPE_COMBO
xcb:Atom:_NET_WM_WINDOW_TYPE_DND
xcb:Atom:_NET_WM_WINDOW_TYPE_NORMAL
;;
xcb:Atom:_NET_WM_STATE
xcb:Atom:_NET_WM_STATE_MODAL
;; xcb:Atom:_NET_WM_STATE_STICKY
;; xcb:Atom:_NET_WM_STATE_MAXIMIZED_VERT
;; xcb:Atom:_NET_WM_STATE_MAXIMIZED_HORZ
;; xcb:Atom:_NET_WM_STATE_SHADED
;; xcb:Atom:_NET_WM_STATE_SKIP_TASKBAR
;; xcb:Atom:_NET_WM_STATE_SKIP_PAGER
;; xcb:Atom:_NET_WM_STATE_HIDDEN
xcb:Atom:_NET_WM_STATE_FULLSCREEN
;; xcb:Atom:_NET_WM_STATE_ABOVE
;; xcb:Atom:_NET_WM_STATE_BELOW
xcb:Atom:_NET_WM_STATE_DEMANDS_ATTENTION
;; xcb:Atom:_NET_WM_STATE_FOCUSED
;;
xcb:Atom:_NET_WM_ALLOWED_ACTIONS
xcb:Atom:_NET_WM_ACTION_MOVE
xcb:Atom:_NET_WM_ACTION_RESIZE
xcb:Atom:_NET_WM_ACTION_MINIMIZE
;; xcb:Atom:_NET_WM_ACTION_SHADE
;; xcb:Atom:_NET_WM_ACTION_STICK
;; xcb:Atom:_NET_WM_ACTION_MAXIMIZE_HORZ
;; xcb:Atom:_NET_WM_ACTION_MAXIMIZE_VERT
xcb:Atom:_NET_WM_ACTION_FULLSCREEN
xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP
xcb:Atom:_NET_WM_ACTION_CLOSE
;; xcb:Atom:_NET_WM_ACTION_ABOVE
;; xcb:Atom:_NET_WM_ACTION_BELOW
;;
xcb:Atom:_NET_WM_STRUT
xcb:Atom:_NET_WM_STRUT_PARTIAL
;; xcb:Atom:_NET_WM_ICON_GEOMETRY
;; xcb:Atom:_NET_WM_ICON
xcb:Atom:_NET_WM_PID
;; xcb:Atom:_NET_WM_HANDLED_ICONS
;; xcb:Atom:_NET_WM_USER_TIME
;; xcb:Atom:_NET_WM_USER_TIME_WINDOW
xcb:Atom:_NET_FRAME_EXTENTS
;; xcb:Atom:_NET_WM_OPAQUE_REGION
;; xcb:Atom:_NET_WM_BYPASS_COMPOSITOR
;; Window manager protocols.
xcb:Atom:_NET_WM_PING
;; xcb:Atom:_NET_WM_SYNC_REQUEST
;; xcb:Atom:_NET_WM_FULLSCREEN_MONITORS
;; Other properties.
xcb:Atom:_NET_WM_FULL_PLACEMENT)))
;; Create a child window for setting _NET_SUPPORTING_WM_CHECK
(let ((new-id (xcb:generate-id exwm--connection)))
(xcb:+request exwm--connection
@ -496,15 +573,6 @@
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window i :data "EXWM"))))
;; Set _NET_NUMBER_OF_DESKTOPS
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_NUMBER_OF_DESKTOPS
:window exwm--root :data exwm-workspace-number))
;; Set _NET_DESKTOP_VIEWPORT
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_DESKTOP_VIEWPORT
:window exwm--root
:data (make-vector (* 2 exwm-workspace-number) 0)))
(xcb:flush exwm--connection))
(defvar exwm-init-hook nil