add exwm--client-message-functions

* exwm.el (exwm--client-message-functions):
Alist for dispatching client messages to handlers.
(exwm-init): set exwm--client-message-functions once exwmh support enabled.
(exwm--on-ClientMessage): delegate via exwm--client-message-functions,
decompose body into separate handlers.

See: https://github.com/ch11ng/exwm/issues/931
This commit is contained in:
Nicholas Vollmer 2024-06-05 13:09:21 -04:00 committed by Steven Allen
parent d41de490e3
commit 4042de16fd

94
exwm.el
View file

@ -122,6 +122,10 @@ After this time, the server will be killed.")
(defvar exwm--server-process nil "Process of the subordinate Emacs server.") (defvar exwm--server-process nil "Process of the subordinate Emacs server.")
(defvar exwm--client-message-functions nil
"Alist of form ((MESSAGE . MESSAGE-HANDLER)...).
Set during `exwm-init'.")
(defun exwm-reset () (defun exwm-reset ()
"Reset the state of the selected window (non-fullscreen, line-mode, etc)." "Reset the state of the selected window (non-fullscreen, line-mode, etc)."
(interactive) (interactive)
@ -463,20 +467,8 @@ DATA contains unmarshalled PropertyNotify event data."
(x-get-atom-name atom exwm-workspace--current) (x-get-atom-name atom exwm-workspace--current)
atom))))))) atom)))))))
(defun exwm--on-ClientMessage (raw-data _synthetic) (defun exwm--on-net-number-of-desktops (_id data)
"Handle ClientMessage event. "Handle _NET_NUMBER_OF_DESKTOPS_ message with DATA."
RAW-DATA contains unmarshalled ClientMessage event data."
(let ((obj (make-instance 'xcb:ClientMessage))
type id data)
(xcb:unmarshal obj raw-data)
(setq type (slot-value obj 'type)
id (slot-value obj 'window)
data (slot-value (slot-value obj 'data) 'data32))
(exwm--log "atom=%s(%s) id=#x%x data=%s" (x-get-atom-name type exwm-workspace--current)
type (or id 0) data)
(cond
;; _NET_NUMBER_OF_DESKTOPS.
((= type xcb:Atom:_NET_NUMBER_OF_DESKTOPS)
(let ((current (exwm-workspace--count)) (let ((current (exwm-workspace--count))
(requested (elt data 0))) (requested (elt data 0)))
;; Only allow increasing/decreasing the workspace number by 1. ;; Only allow increasing/decreasing the workspace number by 1.
@ -487,11 +479,13 @@ RAW-DATA contains unmarshalled ClientMessage event data."
(> current 1)) (> current 1))
(let ((frame (car (last exwm-workspace--list)))) (let ((frame (car (last exwm-workspace--list))))
(delete-frame frame)))))) (delete-frame frame))))))
;; _NET_CURRENT_DESKTOP.
((= type xcb:Atom:_NET_CURRENT_DESKTOP) (defun exwm--on-net-current-desktop (_id data)
"Handle _NET_CURRENT_DESKTOP message with DATA."
(exwm-workspace-switch (elt data 0))) (exwm-workspace-switch (elt data 0)))
;; _NET_ACTIVE_WINDOW.
((= type xcb:Atom:_NET_ACTIVE_WINDOW) (defun exwm--on-net-active-window (id _data)
"Handle _NET_ACTIVE_WINDOW message with ID."
(let ((buffer (exwm--id->buffer id)) (let ((buffer (exwm--id->buffer id))
window) window)
(if (buffer-live-p buffer) (if (buffer-live-p buffer)
@ -511,13 +505,15 @@ RAW-DATA contains unmarshalled ClientMessage event data."
(dolist (f exwm-workspace--list) (dolist (f exwm-workspace--list)
(when (eq id (frame-parameter f 'exwm-outer-id)) (when (eq id (frame-parameter f 'exwm-outer-id))
(x-focus-frame f t)))))) (x-focus-frame f t))))))
;; _NET_CLOSE_WINDOW.
((= type xcb:Atom:_NET_CLOSE_WINDOW) (defun exwm--on-net-close-window (id _data)
"Handle _NET_CLOSE_WINDOW message with ID."
(let ((buffer (exwm--id->buffer id))) (let ((buffer (exwm--id->buffer id)))
(when (buffer-live-p buffer) (when (buffer-live-p buffer)
(exwm--defer 0 #'kill-buffer buffer)))) (exwm--defer 0 #'kill-buffer buffer))))
;; _NET_WM_MOVERESIZE
((= type xcb:Atom:_NET_WM_MOVERESIZE) (defun exwm--on-net-wm-moveresize (id data)
"Handle _NET_WM_MOVERESIZE message with ID and DATA."
(let ((direction (elt data 2)) (let ((direction (elt data 2))
(buffer (exwm--id->buffer id))) (buffer (exwm--id->buffer id)))
(unless (and buffer (unless (and buffer
@ -559,8 +555,9 @@ RAW-DATA contains unmarshalled ClientMessage event data."
(throw 'break nil)))))) (throw 'break nil))))))
;; Start to move it. ;; Start to move it.
(exwm-floating--start-moveresize id direction)))))) (exwm-floating--start-moveresize id direction))))))
;; _NET_REQUEST_FRAME_EXTENTS
((= type xcb:Atom:_NET_REQUEST_FRAME_EXTENTS) (defun exwm--on-net-request-frame-extents (id _data)
"Handle _NET_REQUEST_FRAME_EXTENTS message with ID."
(let ((buffer (exwm--id->buffer id)) (let ((buffer (exwm--id->buffer id))
top btm) top btm)
(if (or (not buffer) (if (or (not buffer)
@ -577,13 +574,15 @@ RAW-DATA contains unmarshalled ClientMessage event data."
:top top :top top
:bottom btm))) :bottom btm)))
(xcb:flush exwm--connection)) (xcb:flush exwm--connection))
;; _NET_WM_DESKTOP.
((= type xcb:Atom:_NET_WM_DESKTOP) (defun exwm--on-net-wm-desktop (id data)
"Handle _NET_WM_DESKTOP message with ID and DATA."
(let ((buffer (exwm--id->buffer id))) (let ((buffer (exwm--id->buffer id)))
(when (buffer-live-p buffer) (when (buffer-live-p buffer)
(exwm-workspace-move-window (elt data 0) id)))) (exwm-workspace-move-window (elt data 0) id))))
;; _NET_WM_STATE
((= type xcb:Atom:_NET_WM_STATE) (defun exwm--on-net-wm-state (id data)
"Handle _NET_WM_STATE message with ID and DATA."
(let ((action (elt data 0)) (let ((action (elt data 0))
(props (list (elt data 1) (elt data 2))) (props (list (elt data 1) (elt data 2)))
(buffer (exwm--id->buffer id)) (buffer (exwm--id->buffer id))
@ -629,12 +628,16 @@ RAW-DATA contains unmarshalled ClientMessage event data."
(make-instance 'xcb:ewmh:set-_NET_WM_STATE (make-instance 'xcb:ewmh:set-_NET_WM_STATE
:window id :data (vconcat props-new))) :window id :data (vconcat props-new)))
(xcb:flush exwm--connection))))) (xcb:flush exwm--connection)))))
((= type xcb:Atom:WM_PROTOCOLS)
(defun exwm--on-wm-protocols (_id data)
"Handle WM_PROTOCOLS message with DATA."
(let ((type (elt data 0))) (let ((type (elt data 0)))
(cond ((= type xcb:Atom:_NET_WM_PING) (cond ((= type xcb:Atom:_NET_WM_PING)
(setq exwm-manage--ping-lock nil)) (setq exwm-manage--ping-lock nil))
(t (exwm--log "Unhandled WM_PROTOCOLS of type: %d" type))))) (t (exwm--log "Unhandled WM_PROTOCOLS of type: %d" type)))))
((= type xcb:Atom:WM_CHANGE_STATE)
(defun exwm--on-wm-change-state (id data)
"Handle WM_CHANGE_STATE message with ID and DATA."
(let ((buffer (exwm--id->buffer id))) (let ((buffer (exwm--id->buffer id)))
(when (and (buffer-live-p buffer) (when (and (buffer-live-p buffer)
(= (elt data 0) xcb:icccm:WM_STATE:IconicState)) (= (elt data 0) xcb:icccm:WM_STATE:IconicState))
@ -642,9 +645,24 @@ RAW-DATA contains unmarshalled ClientMessage event data."
(if exwm--floating-frame (if exwm--floating-frame
(call-interactively #'exwm-floating-hide) (call-interactively #'exwm-floating-hide)
(bury-buffer)))))) (bury-buffer))))))
(t
(defun exwm--on-ClientMessage (raw-data _synthetic)
"Handle ClientMessage event.
RAW-DATA contains unmarshalled ClientMessage event data."
(let* ((obj (let ((m (make-instance 'xcb:ClientMessage)))
(xcb:unmarshal m raw-data)
m))
(type (slot-value obj 'type))
(id (slot-value obj 'window))
(data (slot-value (slot-value obj 'data) 'data32))
(fn (alist-get type exwm--client-message-functions)))
(if (not fn)
(exwm--log "Unhandled: %s(%d)" (exwm--log "Unhandled: %s(%d)"
(x-get-atom-name type exwm-workspace--current) type))))) (x-get-atom-name type exwm-workspace--current) type)
(exwm--log "atom=%s(%s) id=#x%x data=%s"
(x-get-atom-name type exwm-workspace--current)
type (or id 0) data)
(funcall fn id data))))
(defun exwm--on-SelectionClear (data _synthetic) (defun exwm--on-SelectionClear (data _synthetic)
"Handle SelectionClear events. "Handle SelectionClear events.
@ -918,6 +936,18 @@ FRAME, if given, indicates the X display EXWM should manage."
;; Initialize ICCCM/EWMH support ;; Initialize ICCCM/EWMH support
(xcb:icccm:init exwm--connection t) (xcb:icccm:init exwm--connection t)
(xcb:ewmh:init exwm--connection t) (xcb:ewmh:init exwm--connection t)
(setq
exwm--client-message-functions
(list (cons xcb:Atom:_NET_NUMBER_OF_DESKTOPS #'exwm--on-net-number-of-desktops)
(cons xcb:Atom:_NET_CURRENT_DESKTOP #'exwm--on-net-current-desktop)
(cons xcb:Atom:_NET_ACTIVE_WINDOW #'exwm--on-net-active-window)
(cons xcb:Atom:_NET_CLOSE_WINDOW #'exwm--on-net-close-window)
(cons xcb:Atom:_NET_REQUEST_FRAME_EXTENTS
#'exwm--on-net-request-frame-extents)
(cons xcb:Atom:_NET_WM_DESKTOP #'exwm--on-net-wm-desktop)
(cons xcb:Atom:_NET_WM_STATE #'exwm--on-net-wm-state)
(cons xcb:Atom:WM_PROTOCOLS #'exwm--on-wm-protocols)
(cons xcb:Atom:WM_CHANGE_STATE #'exwm--on-wm-change-state)))
;; Try to register window manager selection. ;; Try to register window manager selection.
(exwm--wmsn-acquire exwm-replace) (exwm--wmsn-acquire exwm-replace)
(when (xcb:+request-checked+request-check exwm--connection (when (xcb:+request-checked+request-check exwm--connection