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

Merge branch 'feat/virtual-root'

Browse source
This commit is contained in:
Chris Feng 2016-02-03 13:30:14 +08:00
commit 2d42fee327
8 changed files with 370 additions and 354 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
exwm-core.el
View file

@ -38,6 +38,9 @@
(when exwm-debug-on (when exwm-debug-on
`(message (concat "[EXWM] " ,format-string) ,@args))) `(message (concat "[EXWM] " ,format-string) ,@args)))
(defmacro exwm--debug (&rest forms)
(when exwm-debug-on `(progn ,@forms)))
(defvar exwm--connection nil "X connection.") (defvar exwm--connection nil "X connection.")
(defvar exwm--root nil "Root window.") (defvar exwm--root nil "Root window.")
(defvar exwm--id-buffer-alist nil "Alist of (<X window ID> . <Emacs buffer>).") (defvar exwm--id-buffer-alist nil "Alist of (<X window ID> . <Emacs buffer>).")
@ -77,12 +80,12 @@
;; Internal variables ;; Internal variables
(defvar-local exwm--id nil) ;window ID (defvar-local exwm--id nil) ;window ID
(defvar-local exwm--container nil) ;container
(defvar-local exwm--frame nil) ;workspace frame (defvar-local exwm--frame nil) ;workspace frame
(defvar-local exwm--floating-frame nil) ;floating frame (defvar-local exwm--floating-frame nil) ;floating frame
(defvar-local exwm--floating-edges nil) ;four edges
(defvar-local exwm--floating-mode-line-format nil) ;save mode-line-format (defvar-local exwm--floating-mode-line-format nil) ;save mode-line-format
(defvar-local exwm--fullscreen nil) ;used in fullscreen (defvar-local exwm--fullscreen nil) ;used in fullscreen
(defvar-local exwm--floating-frame-geometry nil) ;in fullscreen (defvar-local exwm--floating-frame-position nil) ;used in fullscreen
(defvar-local exwm--fixed-size nil) ;fixed size (defvar-local exwm--fixed-size nil) ;fixed size
(defvar-local exwm--on-KeyPress ;KeyPress event handler (defvar-local exwm--on-KeyPress ;KeyPress event handler
#'exwm-input--on-KeyPress-line-mode) #'exwm-input--on-KeyPress-line-mode)

154
exwm-floating.el
View file

@ -65,7 +65,6 @@
exwm--frame) exwm--frame)
;; Fallback to current workspace ;; Fallback to current workspace
exwm-workspace--current))) exwm-workspace--current)))
(original-id (frame-parameter original-frame 'exwm-window-id))
;; Create new frame ;; Create new frame
(frame (with-current-buffer (frame (with-current-buffer
(or (get-buffer "*scratch*") (or (get-buffer "*scratch*")
@ -73,18 +72,16 @@
(set-buffer-major-mode (set-buffer-major-mode
(get-buffer-create "*scratch*")) (get-buffer-create "*scratch*"))
(get-buffer "*scratch*"))) (get-buffer "*scratch*")))
(prog2 (make-frame
(exwm--lock) `((minibuffer . nil) ;use the one on workspace
(make-frame (background-color . ,exwm-floating-border-color)
`((minibuffer . nil) ;use the one on workspace (internal-border-width . ,exwm-floating-border-width)
(background-color . ,exwm-floating-border-color) (left . 10000)
(internal-border-width . ,exwm-floating-border-width) (top . 10000)
(left . 10000) (unsplittable . t))))) ;and fix the size later
(top . 10000)
(unsplittable . t))) ;and fix the size later
(exwm--unlock))))
(frame-id (string-to-number (frame-parameter frame 'window-id)))
(outer-id (string-to-number (frame-parameter frame 'outer-window-id))) (outer-id (string-to-number (frame-parameter frame 'outer-window-id)))
(container (with-current-buffer (exwm--id->buffer id)
exwm--container))
(window (frame-first-window frame)) ;and it's the only window (window (frame-first-window frame)) ;and it's the only window
(x (slot-value exwm--geometry 'x)) (x (slot-value exwm--geometry 'x))
(y (slot-value exwm--geometry 'y)) (y (slot-value exwm--geometry 'y))
@ -99,7 +96,6 @@
(exwm--log "Floating geometry (original, relative): %dx%d%+d%+d" (exwm--log "Floating geometry (original, relative): %dx%d%+d%+d"
width height x y) width height x y)
;; Save window IDs ;; Save window IDs
(set-frame-parameter frame 'exwm-window-id frame-id)
(set-frame-parameter frame 'exwm-outer-id outer-id) (set-frame-parameter frame 'exwm-outer-id outer-id)
;; Set urgency flag if it's not appear in the active workspace ;; Set urgency flag if it's not appear in the active workspace
(let ((idx (cl-position original-frame exwm-workspace--list))) (let ((idx (cl-position original-frame exwm-workspace--list)))
@ -152,36 +148,19 @@
(setq x (/ (- display-width width) 2) (setq x (/ (- display-width width) 2)
y (/ (- display-height height) 2)))))) y (/ (- display-height height) 2))))))
(exwm--log "Floating geometry (corrected): %dx%d%+d%+d" width height x y) (exwm--log "Floating geometry (corrected): %dx%d%+d%+d" width height x y)
;; Set event mask
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window frame-id :value-mask xcb:CW:EventMask
:event-mask xcb:EventMask:SubstructureRedirect))
;; Save the geometry
;; Rationale: the frame will not be ready for some time, thus we cannot
;; infer the correct window size from its geometry.
(with-current-buffer (exwm--id->buffer id)
(setq exwm--floating-edges (vector x y (+ width x) (+ height y))))
;; Fit frame to client ;; Fit frame to client
(exwm-floating--fit-frame-to-window outer-id width height) (exwm-floating--fit-frame-to-window outer-id width height)
;; Reparent window to this frame ;; Reparent this frame to the container
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window id :value-mask xcb:CW:EventMask
:event-mask xcb:EventMask:NoEvent))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow (make-instance 'xcb:ReparentWindow
:window id :parent frame-id :window outer-id :parent container :x 0 :y 0))
:x exwm-floating-border-width ;; Place the container
:y exwm-floating-border-width))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes (make-instance 'xcb:ConfigureWindow
:window id :value-mask xcb:CW:EventMask :window container
:event-mask exwm--client-event-mask)) :value-mask (eval-when-compile
;; Reparent this frame to the original one (logior xcb:ConfigWindow:X
(xcb:+request exwm--connection xcb:ConfigWindow:Y))
(make-instance 'xcb:ReparentWindow
:window outer-id :parent original-id
:x (- x exwm-floating-border-width) :x (- x exwm-floating-border-width)
:y (- y exwm-floating-border-width))) :y (- y exwm-floating-border-width)))
(xcb:flush exwm--connection) (xcb:flush exwm--connection)
@ -192,7 +171,7 @@
exwm--floating-frame frame) exwm--floating-frame frame)
(set-window-buffer window (current-buffer)) ;this changes current buffer (set-window-buffer window (current-buffer)) ;this changes current buffer
(set-window-dedicated-p window t)) (set-window-dedicated-p window t))
(select-window window)) (select-frame-set-input-focus frame))
(run-hooks 'exwm-floating-setup-hook)) (run-hooks 'exwm-floating-setup-hook))
;;;###autoload ;;;###autoload
@ -200,25 +179,16 @@
"Make window ID non-floating." "Make window ID non-floating."
(interactive) (interactive)
(let ((buffer (exwm--id->buffer id))) (let ((buffer (exwm--id->buffer id)))
;; Reparent to workspace frame (with-current-buffer buffer
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes (make-instance 'xcb:ReparentWindow
:window id :value-mask xcb:CW:EventMask :window exwm--container
:event-mask xcb:EventMask:NoEvent)) :parent (frame-parameter exwm-workspace--current
(xcb:+request exwm--connection 'exwm-workspace)
(make-instance 'xcb:ReparentWindow :x 0 :y 0))) ;temporary position
:window id
:parent (frame-parameter exwm-workspace--current
'exwm-window-id)
:x 0 :y 0)) ;temporary position
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window id :value-mask xcb:CW:EventMask
:event-mask exwm--client-event-mask))
(xcb:flush exwm--connection) (xcb:flush exwm--connection)
(with-current-buffer buffer (with-current-buffer buffer
(when exwm--floating-frame ;from floating to non-floating (when exwm--floating-frame ;from floating to non-floating
(setq exwm--floating-edges nil) ;invalid by now
(set-window-dedicated-p (frame-first-window exwm--floating-frame) nil) (set-window-dedicated-p (frame-first-window exwm--floating-frame) nil)
(delete-frame exwm--floating-frame))) ;remove the floating frame (delete-frame exwm--floating-frame))) ;remove the floating frame
(with-current-buffer buffer (with-current-buffer buffer
@ -260,13 +230,11 @@ are provided. You should call `xcb:flush' and restore the value of
'exwm-outer-id)) 'exwm-outer-id))
:value-mask (eval-when-compile :value-mask (eval-when-compile
(logior xcb:ConfigWindow:Width (logior xcb:ConfigWindow:Width
xcb:ConfigWindow:Height xcb:ConfigWindow:Height))
xcb:ConfigWindow:StackMode))
:width (+ width (* 2 exwm-floating-border-width)) :width (+ width (* 2 exwm-floating-border-width))
:height (+ height (* 2 exwm-floating-border-width) :height (+ height (* 2 exwm-floating-border-width)
(window-mode-line-height) (window-mode-line-height)
(window-header-line-height)) (window-header-line-height)))))
:stack-mode xcb:StackMode:Above))) ;top-most
(defun exwm-floating-hide-mode-line () (defun exwm-floating-hide-mode-line ()
"Hide mode-line of a floating frame." "Hide mode-line of a floating frame."
@ -294,22 +262,23 @@ are provided. You should call `xcb:flush' and restore the value of
(setq window-size-fixed exwm--fixed-size))) (setq window-size-fixed exwm--fixed-size)))
(defvar exwm-floating--moveresize-calculate nil (defvar exwm-floating--moveresize-calculate nil
"Calculate move/resize parameters [frame-id event-mask x y width height].") "Calculate move/resize parameters [buffer event-mask x y width height].")
;;;###autoload ;;;###autoload
(defun exwm-floating--start-moveresize (id &optional type) (defun exwm-floating--start-moveresize (id &optional type)
"Start move/resize." "Start move/resize."
(let ((buffer (exwm--id->buffer id)) (let ((buffer (exwm--id->buffer id))
frame frame-id x y width height cursor) frame container x y width height cursor)
(when (and buffer (when (and buffer
(setq frame (with-current-buffer buffer exwm--floating-frame)) (with-current-buffer buffer
(setq frame-id (frame-parameter frame 'exwm-outer-id)) (setq frame exwm--floating-frame
container exwm--container))
;; Test if the pointer can be grabbed ;; Test if the pointer can be grabbed
(= xcb:GrabStatus:Success (= xcb:GrabStatus:Success
(slot-value (slot-value
(xcb:+request-unchecked+reply exwm--connection (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GrabPointer (make-instance 'xcb:GrabPointer
:owner-events 0 :grab-window frame-id :owner-events 0 :grab-window container
:event-mask xcb:EventMask:NoEvent :event-mask xcb:EventMask:NoEvent
:pointer-mode xcb:GrabMode:Async :pointer-mode xcb:GrabMode:Async
:keyboard-mode xcb:GrabMode:Async :keyboard-mode xcb:GrabMode:Async
@ -317,11 +286,10 @@ are provided. You should call `xcb:flush' and restore the value of
:cursor xcb:Cursor:None :cursor xcb:Cursor:None
:time xcb:Time:CurrentTime)) :time xcb:Time:CurrentTime))
'status))) 'status)))
(setq exwm--floating-edges nil) ;invalid by now
(with-slots (root-x root-y win-x win-y) (with-slots (root-x root-y win-x win-y)
(xcb:+request-unchecked+reply exwm--connection (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:QueryPointer :window id)) (make-instance 'xcb:QueryPointer :window id))
(select-frame-set-input-focus frame) ;raise and focus it (select-window (frame-first-window frame)) ;transfer input focus
(setq width (frame-pixel-width frame) (setq width (frame-pixel-width frame)
height (frame-pixel-height frame)) height (frame-pixel-height frame))
(unless type (unless type
@ -347,7 +315,7 @@ are provided. You should call `xcb:flush' and restore the value of
(setq cursor exwm-floating--cursor-move (setq cursor exwm-floating--cursor-move
exwm-floating--moveresize-calculate exwm-floating--moveresize-calculate
`(lambda (x y) `(lambda (x y)
(vector ,frame-id (vector ,buffer
,(eval-when-compile ,(eval-when-compile
(logior xcb:ConfigWindow:X (logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y)) xcb:ConfigWindow:Y))
@ -356,7 +324,7 @@ are provided. You should call `xcb:flush' and restore the value of
(setq cursor exwm-floating--cursor-top-left (setq cursor exwm-floating--cursor-top-left
exwm-floating--moveresize-calculate exwm-floating--moveresize-calculate
`(lambda (x y) `(lambda (x y)
(vector ,frame-id (vector ,buffer
,(eval-when-compile ,(eval-when-compile
(logior xcb:ConfigWindow:X (logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y xcb:ConfigWindow:Y
@ -369,7 +337,7 @@ are provided. You should call `xcb:flush' and restore the value of
(setq cursor exwm-floating--cursor-top (setq cursor exwm-floating--cursor-top
exwm-floating--moveresize-calculate exwm-floating--moveresize-calculate
`(lambda (x y) `(lambda (x y)
(vector ,frame-id (vector ,buffer
,(eval-when-compile ,(eval-when-compile
(logior xcb:ConfigWindow:Y (logior xcb:ConfigWindow:Y
xcb:ConfigWindow:Height)) xcb:ConfigWindow:Height))
@ -378,7 +346,7 @@ are provided. You should call `xcb:flush' and restore the value of
(setq cursor exwm-floating--cursor-top-right (setq cursor exwm-floating--cursor-top-right
exwm-floating--moveresize-calculate exwm-floating--moveresize-calculate
`(lambda (x y) `(lambda (x y)
(vector ,frame-id (vector ,buffer
,(eval-when-compile ,(eval-when-compile
(logior xcb:ConfigWindow:Y (logior xcb:ConfigWindow:Y
xcb:ConfigWindow:Width xcb:ConfigWindow:Width
@ -389,13 +357,13 @@ are provided. You should call `xcb:flush' and restore the value of
(setq cursor exwm-floating--cursor-right (setq cursor exwm-floating--cursor-right
exwm-floating--moveresize-calculate exwm-floating--moveresize-calculate
`(lambda (x y) `(lambda (x y)
(vector ,frame-id ,xcb:ConfigWindow:Width (vector ,buffer ,xcb:ConfigWindow:Width
0 0 (- x ,(- root-x width)) 0)))) 0 0 (- x ,(- root-x width)) 0))))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT)
(setq cursor exwm-floating--cursor-bottom-right (setq cursor exwm-floating--cursor-bottom-right
exwm-floating--moveresize-calculate exwm-floating--moveresize-calculate
`(lambda (x y) `(lambda (x y)
(vector ,frame-id (vector ,buffer
,(eval-when-compile ,(eval-when-compile
(logior xcb:ConfigWindow:Width (logior xcb:ConfigWindow:Width
xcb:ConfigWindow:Height)) xcb:ConfigWindow:Height))
@ -405,14 +373,14 @@ are provided. You should call `xcb:flush' and restore the value of
(setq cursor exwm-floating--cursor-bottom (setq cursor exwm-floating--cursor-bottom
exwm-floating--moveresize-calculate exwm-floating--moveresize-calculate
`(lambda (x y) `(lambda (x y)
(vector ,frame-id (vector ,buffer
,xcb:ConfigWindow:Height ,xcb:ConfigWindow:Height
0 0 0 (- y ,(- root-y height)))))) 0 0 0 (- y ,(- root-y height))))))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT)
(setq cursor exwm-floating--cursor-bottom-left (setq cursor exwm-floating--cursor-bottom-left
exwm-floating--moveresize-calculate exwm-floating--moveresize-calculate
`(lambda (x y) `(lambda (x y)
(vector ,frame-id (vector ,buffer
,(eval-when-compile ,(eval-when-compile
(logior xcb:ConfigWindow:X (logior xcb:ConfigWindow:X
xcb:ConfigWindow:Width xcb:ConfigWindow:Width
@ -425,7 +393,7 @@ are provided. You should call `xcb:flush' and restore the value of
(setq cursor exwm-floating--cursor-left (setq cursor exwm-floating--cursor-left
exwm-floating--moveresize-calculate exwm-floating--moveresize-calculate
`(lambda (x y) `(lambda (x y)
(vector ,frame-id (vector ,buffer
,(eval-when-compile ,(eval-when-compile
(logior xcb:ConfigWindow:X (logior xcb:ConfigWindow:X
xcb:ConfigWindow:Width)) xcb:ConfigWindow:Width))
@ -433,7 +401,7 @@ are provided. You should call `xcb:flush' and restore the value of
;; Select events and change cursor (should always succeed) ;; Select events and change cursor (should always succeed)
(xcb:+request-unchecked+reply exwm--connection (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GrabPointer (make-instance 'xcb:GrabPointer
:owner-events 0 :grab-window frame-id :owner-events 0 :grab-window container
:event-mask (eval-when-compile :event-mask (eval-when-compile
(logior xcb:EventMask:ButtonRelease (logior xcb:EventMask:ButtonRelease
xcb:EventMask:ButtonMotion)) xcb:EventMask:ButtonMotion))
@ -488,12 +456,26 @@ are provided. You should call `xcb:flush' and restore the value of
(xcb:unmarshal obj data) (xcb:unmarshal obj data)
(setq result (funcall exwm-floating--moveresize-calculate (setq result (funcall exwm-floating--moveresize-calculate
(slot-value obj 'root-x) (slot-value obj 'root-y))) (slot-value obj 'root-x) (slot-value obj 'root-y)))
(xcb:+request exwm--connection (with-current-buffer (aref result 0)
(make-instance 'xcb:ConfigureWindow (xcb:+request exwm--connection
:window (elt result 0) :value-mask (elt result 1) (make-instance 'xcb:ConfigureWindow
:x (- (elt result 2) frame-x) :window exwm--container
:y (- (elt result 3) frame-y) :value-mask (logand (aref result 1)
:width (elt result 4) :height (elt result 5))) (eval-when-compile
(logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y)))
:x (- (aref result 2) frame-x)
:y (- (aref result 3) frame-y)))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window (frame-parameter exwm--floating-frame
'exwm-outer-id)
:value-mask
(logand (aref result 1)
(eval-when-compile
(logior xcb:ConfigWindow:Width
xcb:ConfigWindow:Height)))
:width (aref result 4) :height (aref result 5))))
(xcb:flush exwm--connection)))) (xcb:flush exwm--connection))))
(defun exwm-floating-move (&optional delta-x delta-y) (defun exwm-floating-move (&optional delta-x delta-y)
@ -505,13 +487,13 @@ Both DELTA-X and DELTA-Y default to 1. This command should be bound locally."
(unless delta-x (setq delta-x 1)) (unless delta-x (setq delta-x 1))
(unless delta-y (setq delta-y 1)) (unless delta-y (setq delta-y 1))
(unless (and (= 0 delta-x) (= 0 delta-y)) (unless (and (= 0 delta-x) (= 0 delta-y))
(let* ((id (frame-parameter exwm--floating-frame 'exwm-outer-id)) (let* ((geometry (xcb:+request-unchecked+reply exwm--connection
(geometry (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry
(make-instance 'xcb:GetGeometry :drawable id))) :drawable exwm--container)))
(edges (window-inside-absolute-pixel-edges))) (edges (window-inside-absolute-pixel-edges)))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow
:window id :window exwm--container
:value-mask (eval-when-compile :value-mask (eval-when-compile
(logior xcb:ConfigWindow:X (logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y)) xcb:ConfigWindow:Y))

154
exwm-input.el
View file

@ -79,8 +79,6 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
(xcb:flush exwm--connection)))) (xcb:flush exwm--connection))))
(defvar exwm-input--focus-window nil "The (Emacs) window to be focused.") (defvar exwm-input--focus-window nil "The (Emacs) window to be focused.")
(defvar exwm-input--redirected nil
"Indicate next update on buffer list is actually a result of redirection.")
(defvar exwm-input--timer nil "Currently running timer.") (defvar exwm-input--timer nil "Currently running timer.")
(defun exwm-input--on-buffer-list-update () (defun exwm-input--on-buffer-list-update ()
@ -89,25 +87,12 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
(window (selected-window)) (window (selected-window))
(buffer (current-buffer))) (buffer (current-buffer)))
(when (and (not (minibufferp buffer)) (when (and (not (minibufferp buffer))
(frame-parameter frame 'exwm-window-id) ;e.g. emacsclient frame (frame-parameter frame 'exwm-outer-id) ;e.g. emacsclient frame
(eq buffer (window-buffer))) ;e.g. `with-temp-buffer' (eq buffer (window-buffer))) ;e.g. `with-temp-buffer'
(unless (and exwm-input--redirected (when exwm-input--timer (cancel-timer exwm-input--timer))
exwm-input--focus-window (setq exwm-input--focus-window window
(with-current-buffer (window-buffer exwm-input--timer
exwm-input--focus-window) (run-with-idle-timer 0.01 nil #'exwm-input--update-focus)))))
exwm--floating-frame))
(setq exwm-input--focus-window window)
(when exwm-input--timer (cancel-timer exwm-input--timer))
(setq exwm-input--timer
(run-with-idle-timer 0.01 nil #'exwm-input--update-focus)))
(setq exwm-input--redirected nil))))
(defun exwm-input--on-focus-in ()
"Run in focus-in-hook to remove redirected focus on frame."
(let ((frame (selected-frame)))
(when (and (frame-parameter frame 'exwm-window-id)
(not (memq frame exwm-workspace--list)))
(setq exwm-input--redirected t))))
(defun exwm-input--update-focus () (defun exwm-input--update-focus ()
"Update input focus." "Update input focus."
@ -122,22 +107,56 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
(force-mode-line-update) (force-mode-line-update)
;; The application may have changed its input focus ;; The application may have changed its input focus
(exwm-workspace-switch exwm-workspace-current-index t)) (exwm-workspace-switch exwm-workspace-current-index t))
(when exwm--floating-frame
(redirect-frame-focus exwm--floating-frame nil)
(select-frame-set-input-focus exwm--floating-frame t))
(exwm--log "Set focus on #x%x" exwm--id) (exwm--log "Set focus on #x%x" exwm--id)
(exwm-input--set-focus exwm--id)) (exwm-input--set-focus exwm--id)
;; Adjust stacking orders
(if exwm--floating-frame
;; Put this floating X window at top.
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window exwm--container
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:TopIf))
;; This should be the last X window but one in the siblings.
(with-slots (children)
(xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:QueryTree
:window
(frame-parameter exwm--frame
'exwm-workspace)))
(unless (eq (cadr children) exwm--container)
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window exwm--container
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:Below)))))
;; Make sure Emacs frames are at bottom.
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window (frame-parameter
(or exwm--floating-frame exwm--frame)
'exwm-outer-id)
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:BottomIf))
(xcb:flush exwm--connection))
(when (eq (selected-window) exwm-input--focus-window) (when (eq (selected-window) exwm-input--focus-window)
(exwm--log "Focus on %s" exwm-input--focus-window) (exwm--log "Focus on %s" exwm-input--focus-window)
(select-frame-set-input-focus (window-frame exwm-input--focus-window) (select-frame-set-input-focus (window-frame exwm-input--focus-window)
t) t)
(dolist (pair exwm--id-buffer-alist) (xcb:+request exwm--connection
(with-current-buffer (cdr pair) (make-instance 'xcb:ConfigureWindow
(when (and exwm--floating-frame :window (frame-parameter
(eq exwm--frame exwm-workspace--current)) (window-frame exwm-input--focus-window)
(redirect-frame-focus exwm--floating-frame exwm--frame)))))) 'exwm-outer-id)
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:Below))
(xcb:flush exwm--connection)))
(setq exwm-input--focus-window nil)))) (setq exwm-input--focus-window nil))))
(defun exwm-input--on-minibuffer-setup ()
"Run in minibuffer-setup-hook to set input focus to the frame."
(x-focus-frame (selected-frame)))
(defvar exwm-input--during-key-sequence nil (defvar exwm-input--during-key-sequence nil
"Non-nil indicates Emacs is waiting for more keys to form a key sequence.") "Non-nil indicates Emacs is waiting for more keys to form a key sequence.")
(defvar exwm-input--temp-line-mode nil (defvar exwm-input--temp-line-mode nil
@ -221,32 +240,38 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
"Update `exwm-input--global-prefix-keys'." "Update `exwm-input--global-prefix-keys'."
(when exwm--connection (when exwm--connection
(let ((original exwm-input--global-prefix-keys) (let ((original exwm-input--global-prefix-keys)
keysym keycode) keysym keycode ungrab-key grab-key workspace)
(setq exwm-input--global-prefix-keys nil) (setq exwm-input--global-prefix-keys nil)
(dolist (i exwm-input--global-keys) (dolist (i exwm-input--global-keys)
(cl-pushnew (elt i 0) exwm-input--global-prefix-keys)) (cl-pushnew (elt i 0) exwm-input--global-prefix-keys))
(unless (equal original exwm-input--global-prefix-keys) (unless (equal original exwm-input--global-prefix-keys)
;; Grab global keys on root window (setq ungrab-key (make-instance 'xcb:UngrabKey
(if (xcb:+request-checked+request-check exwm--connection :key xcb:Grab:Any :grab-window nil
(make-instance 'xcb:UngrabKey :modifiers xcb:ModMask:Any)
:key xcb:Grab:Any :grab-window exwm--root grab-key (make-instance 'xcb:GrabKey
:modifiers xcb:ModMask:Any)) :owner-events 0
(exwm--log "Failed to ungrab keys") :grab-window nil
(dolist (i exwm-input--global-prefix-keys) :modifiers nil
(setq keysym (xcb:keysyms:event->keysym exwm--connection i)) :key nil
(when (or (not keysym) :pointer-mode xcb:GrabMode:Async
(not (setq keycode (xcb:keysyms:keysym->keycode :keyboard-mode xcb:GrabMode:Async))
exwm--connection (car keysym)))) (dolist (w exwm-workspace--list)
(xcb:+request-checked+request-check exwm--connection (setq workspace (frame-parameter w 'exwm-workspace))
(make-instance 'xcb:GrabKey (setf (slot-value ungrab-key 'grab-window) workspace)
:owner-events 0 (if (xcb:+request-checked+request-check exwm--connection ungrab-key)
:grab-window exwm--root (exwm--log "Failed to ungrab keys")
:modifiers (cadr keysym) (dolist (k exwm-input--global-prefix-keys)
:key keycode (setq keysym (xcb:keysyms:event->keysym exwm--connection k)
:pointer-mode xcb:GrabMode:Async keycode (xcb:keysyms:keysym->keycode exwm--connection
:keyboard-mode xcb:GrabMode:Async))) (car keysym)))
(user-error "[EXWM] Failed to grab key: %s" (setf (slot-value grab-key 'grab-window) workspace
(single-key-description i))))))))) (slot-value grab-key 'modifiers) (cadr keysym)
(slot-value grab-key 'key) keycode)
(when (or (not keycode)
(xcb:+request-checked+request-check exwm--connection
grab-key))
(user-error "[EXWM] Failed to grab key: %s"
(single-key-description k))))))))))
(defun exwm-input-set-key (key command) (defun exwm-input-set-key (key command)
"Set a global key binding." "Set a global key binding."
@ -289,21 +314,6 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
(with-slots (detail state) key-press (with-slots (detail state) key-press
(let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state)) (let ((keysym (xcb:keysyms:keycode->keysym exwm--connection detail state))
event) event)
;; Compensate FocusOut event (prevent cursor style change)
(unless (eq major-mode 'exwm-mode)
(let ((id (frame-parameter nil 'exwm-window-id)))
(xcb:+request exwm--connection
(make-instance 'xcb:SendEvent
:propagate 0
:destination id
:event-mask xcb:EventMask:StructureNotify
:event
(xcb:marshal
(make-instance 'xcb:FocusIn
:detail xcb:NotifyDetail:Inferior
:event id
:mode xcb:NotifyMode:Normal)
exwm--connection)))))
(when (and keysym (when (and keysym
(setq event (xcb:keysyms:keysym->event exwm--connection (setq event (xcb:keysyms:keysym->event exwm--connection
keysym state))) keysym state)))
@ -324,7 +334,10 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
(when id (when id
(when (xcb:+request-checked+request-check exwm--connection (when (xcb:+request-checked+request-check exwm--connection
(make-instance 'xcb:GrabKey (make-instance 'xcb:GrabKey
:owner-events 0 :grab-window id :owner-events 0
:grab-window
(with-current-buffer (exwm--id->buffer id)
exwm--container)
:modifiers xcb:ModMask:Any :modifiers xcb:ModMask:Any
:key xcb:Grab:Any :key xcb:Grab:Any
:pointer-mode xcb:GrabMode:Async :pointer-mode xcb:GrabMode:Async
@ -338,7 +351,10 @@ It's updated in several occasions, and only used by `exwm-input--set-focus'.")
(when id (when id
(when (xcb:+request-checked+request-check exwm--connection (when (xcb:+request-checked+request-check exwm--connection
(make-instance 'xcb:UngrabKey (make-instance 'xcb:UngrabKey
:key xcb:Grab:Any :grab-window id :key xcb:Grab:Any
:grab-window
(with-current-buffer (exwm--id->buffer id)
exwm--container)
:modifiers xcb:ModMask:Any)) :modifiers xcb:ModMask:Any))
(exwm--log "Failed to release keyboard for #x%x" id)) (exwm--log "Failed to release keyboard for #x%x" id))
(setq exwm--on-KeyPress #'exwm-input--on-KeyPress-char-mode))) (setq exwm--on-KeyPress #'exwm-input--on-KeyPress-char-mode)))
@ -487,7 +503,7 @@ SIMULATION-KEYS is a list of alist (key-sequence1 . key-sequence2)."
(add-hook 'pre-command-hook #'exwm-input--finish-key-sequence) (add-hook 'pre-command-hook #'exwm-input--finish-key-sequence)
;; Update focus when buffer list updates ;; Update focus when buffer list updates
(add-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update) (add-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update)
(add-hook 'focus-in-hook #'exwm-input--on-focus-in) (add-hook 'minibuffer-setup-hook #'exwm-input--on-minibuffer-setup)
;; Update prefix keys for global keys ;; Update prefix keys for global keys
(exwm-input--update-global-prefix-keys)) (exwm-input--update-global-prefix-keys))

157
exwm-layout.el
View file

@ -30,41 +30,72 @@
(defvar exwm-floating-border-width) (defvar exwm-floating-border-width)
(defun exwm-layout--resize-container (id container x y width height
&optional container-only)
"Resize a container (and its content unless CONTAINER-ONLY is non-nil)."
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window container
:value-mask (eval-when-compile
(logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y
xcb:ConfigWindow:Width
xcb:ConfigWindow:Height))
:x x :y y :width width :height height))
(unless container-only
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window id
:value-mask (eval-when-compile
(logior xcb:ConfigWindow:Width
xcb:ConfigWindow:Height))
:width width :height height))))
;;;###autoload ;;;###autoload
(defun exwm-layout--show (id &optional window) (defun exwm-layout--show (id &optional window)
"Show window ID exactly fit in the Emacs window WINDOW." "Show window ID exactly fit in the Emacs window WINDOW."
(exwm--log "Show #x%x in %s" id window) (exwm--log "Show #x%x in %s" id window)
(xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window id)) (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window id))
(with-current-buffer (exwm--id->buffer id)
(xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window exwm--container)))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:icccm:set-WM_STATE (make-instance 'xcb:icccm:set-WM_STATE
:window id :state xcb:icccm:WM_STATE:NormalState :window id :state xcb:icccm:WM_STATE:NormalState
:icon xcb:Window:None)) :icon xcb:Window:None))
(let* ((buffer (exwm--id->buffer id)) (let* ((edges (window-inside-absolute-pixel-edges window))
(edges (or (and buffer
(with-current-buffer buffer exwm--floating-edges))
(window-inside-absolute-pixel-edges window)))
(width (- (elt edges 2) (elt edges 0))) (width (- (elt edges 2) (elt edges 0)))
(height (- (elt edges 3) (elt edges 1))) (height (- (elt edges 3) (elt edges 1))))
x y) (with-current-buffer (exwm--id->buffer id)
(if exwm--floating-edges (if exwm--floating-frame
;; The relative position of a floating X window is determinate ;; A floating X window is of the same size as the Emacs window,
(setq x exwm-floating-border-width ;; whereas its container is of the same size as the Emacs frame.
y exwm-floating-border-width) (progn
(let ((relative-edges (window-inside-pixel-edges window))) (xcb:+request exwm--connection
(setq x (elt relative-edges 0) (make-instance 'xcb:ConfigureWindow
y (elt relative-edges 1)))) :window exwm--container
(xcb:+request exwm--connection :value-mask (logior xcb:ConfigWindow:Width
(make-instance 'xcb:ConfigureWindow xcb:ConfigWindow:Height)
:window id :width (frame-pixel-width exwm--floating-frame)
:value-mask (eval-when-compile :height (frame-pixel-height
(logior xcb:ConfigWindow:X exwm--floating-frame)))
xcb:ConfigWindow:Y (xcb:+request exwm--connection
xcb:ConfigWindow:Width (make-instance 'xcb:ConfigureWindow
xcb:ConfigWindow:Height :window exwm--id
xcb:ConfigWindow:StackMode)) :value-mask (logior xcb:ConfigWindow:X
:x x :y y :width width :height height xcb:ConfigWindow:Y
;; In order to put non-floating window at bottom xcb:ConfigWindow:Width
:stack-mode xcb:StackMode:Below)) xcb:ConfigWindow:Height)
:x exwm-floating-border-width
:y exwm-floating-border-width
:width width
:height height)))
(let ((relative-edges (window-inside-pixel-edges window)))
(exwm-layout--resize-container id exwm--container
(elt relative-edges 0)
(elt relative-edges 1)
width height
(active-minibuffer-window)))))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:SendEvent (make-instance 'xcb:SendEvent
:propagate 0 :destination id :propagate 0 :destination id
@ -96,6 +127,9 @@
(make-instance 'xcb:ChangeWindowAttributes (make-instance 'xcb:ChangeWindowAttributes
:window id :value-mask xcb:CW:EventMask :window id :value-mask xcb:CW:EventMask
:event-mask exwm--client-event-mask)) :event-mask exwm--client-event-mask))
(with-current-buffer (exwm--id->buffer id)
(xcb:+request exwm--connection
(make-instance 'xcb:UnmapWindow :window exwm--container)))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:icccm:set-WM_STATE (make-instance 'xcb:icccm:set-WM_STATE
:window id :window id
@ -112,38 +146,16 @@
(user-error "Already in full-screen mode.")) (user-error "Already in full-screen mode."))
;; Set the floating frame fullscreen first when the client is floating ;; Set the floating frame fullscreen first when the client is floating
(when exwm--floating-frame (when exwm--floating-frame
(let* ((outer-id (frame-parameter exwm--floating-frame 'exwm-outer-id)) (let* ((geometry (xcb:+request-unchecked+reply exwm--connection
(geometry (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry (make-instance 'xcb:GetGeometry
:drawable outer-id)))) :drawable exwm--container))))
(setq exwm--floating-frame-geometry (setq exwm--floating-frame-position
(vector (slot-value geometry 'x) (slot-value geometry 'y) (vector (slot-value geometry 'x) (slot-value geometry 'y))))
(slot-value geometry 'width)
(slot-value geometry 'height)))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window outer-id
:value-mask (eval-when-compile
(logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y
xcb:ConfigWindow:Width
xcb:ConfigWindow:Height))
:x 0 :y 0
:width (frame-pixel-width exwm-workspace--current)
:height (frame-pixel-height
exwm-workspace--current))))
(xcb:flush exwm--connection)) (xcb:flush exwm--connection))
(xcb:+request exwm--connection (exwm-layout--resize-container exwm--id exwm--container 0 0
(make-instance 'xcb:ConfigureWindow (frame-pixel-width exwm-workspace--current)
:window exwm--id (frame-pixel-height
:value-mask (eval-when-compile exwm-workspace--current))
(logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y
xcb:ConfigWindow:Width
xcb:ConfigWindow:Height))
:x 0 :y 0
:width (frame-pixel-width exwm-workspace--current)
:height (frame-pixel-height exwm-workspace--current)))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_STATE (make-instance 'xcb:ewmh:set-_NET_WM_STATE
:window exwm--id :window exwm--id
@ -162,17 +174,12 @@
(when exwm--floating-frame (when exwm--floating-frame
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow
:window (frame-parameter exwm--floating-frame :window exwm--container
'exwm-outer-id)
:value-mask (eval-when-compile :value-mask (eval-when-compile
(logior xcb:ConfigWindow:X (logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y xcb:ConfigWindow:Y))
xcb:ConfigWindow:Width :x (elt exwm--floating-frame-position 0)
xcb:ConfigWindow:Height)) :y (elt exwm--floating-frame-position 1))))
:x (elt exwm--floating-frame-geometry 0)
:y (elt exwm--floating-frame-geometry 1)
:width (elt exwm--floating-frame-geometry 2)
:height (elt exwm--floating-frame-geometry 3))))
(exwm-layout--show exwm--id) (exwm-layout--show exwm--id)
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_STATE :window exwm--id :data [])) (make-instance 'xcb:ewmh:set-_NET_WM_STATE :window exwm--id :data []))
@ -193,19 +200,10 @@
(make-instance 'xcb:RECTANGLE :x 0 :y 0 (make-instance 'xcb:RECTANGLE :x 0 :y 0
:width (x-display-pixel-width) :width (x-display-pixel-width)
:height (x-display-pixel-height)))) :height (x-display-pixel-height))))
(id (frame-parameter frame 'exwm-outer-id))) (id (frame-parameter frame 'exwm-outer-id))
(workspace (frame-parameter frame 'exwm-workspace)))
(with-slots (x y width height) geometry (with-slots (x y width height) geometry
(xcb:+request exwm--connection (exwm-layout--resize-container id workspace x y width height)
(make-instance 'xcb:ConfigureWindow
:window id
:value-mask (eval-when-compile
(logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y
xcb:ConfigWindow:Width
xcb:ConfigWindow:Height))
:x x :y y
:width width
:height height))
(xcb:flush exwm--connection)))) (xcb:flush exwm--connection))))
(defvar exwm-layout-show-all-buffers nil (defvar exwm-layout-show-all-buffers nil
@ -221,7 +219,7 @@
(get-buffer "*scratch*")))) (get-buffer "*scratch*"))))
windows) windows)
(if (not (memq frame exwm-workspace--list)) (if (not (memq frame exwm-workspace--list))
(if (frame-parameter frame 'exwm-window-id) (if (frame-parameter frame 'exwm-outer-id)
;; Refresh a floating frame ;; Refresh a floating frame
(when (eq major-mode 'exwm-mode) (when (eq major-mode 'exwm-mode)
(let ((window (frame-first-window frame))) (let ((window (frame-first-window frame)))
@ -230,9 +228,6 @@
(exwm-layout--show exwm--id window)))) (exwm-layout--show exwm--id window))))
;; Other frames (e.g. terminal/graphical frame of emacsclient) ;; Other frames (e.g. terminal/graphical frame of emacsclient)
;; We shall bury all `exwm-mode' buffers in this case ;; We shall bury all `exwm-mode' buffers in this case
(unless placeholder ;create the *scratch* buffer if it's killed
(setq placeholder (get-buffer-create "*scratch*"))
(set-buffer-major-mode placeholder))
(setq windows (window-list frame 0)) ;exclude minibuffer (setq windows (window-list frame 0)) ;exclude minibuffer
(dolist (window windows) (dolist (window windows)
(with-current-buffer (window-buffer window) (with-current-buffer (window-buffer window)
@ -329,7 +324,6 @@ windows."
(setq width (max (+ exwm--normal-hints-min-width margin) (setq width (max (+ exwm--normal-hints-min-width margin)
(+ width delta)))))) (+ width delta))))))
(when width (when width
(setq exwm--floating-edges nil) ;invalid from now on
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow
:window (frame-parameter exwm--floating-frame :window (frame-parameter exwm--floating-frame
@ -356,7 +350,6 @@ windows."
(setq height (max (+ exwm--normal-hints-min-height margin) (setq height (max (+ exwm--normal-hints-min-height margin)
(+ height delta)))))) (+ height delta))))))
(when height (when height
(setq exwm--floating-edges nil) ;invalid from now on
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow
:window (frame-parameter exwm--floating-frame :window (frame-parameter exwm--floating-frame

140
exwm-manage.el
View file

@ -120,7 +120,7 @@ corresponding buffer.")
(make-instance 'xcb:ReparentWindow (make-instance 'xcb:ReparentWindow
:window id :window id
:parent (frame-parameter exwm-workspace--current :parent (frame-parameter exwm-workspace--current
'exwm-window-id) 'exwm-workspace)
:x x :y y))) :x x :y y)))
;; Center window of type _NET_WM_WINDOW_TYPE_SPLASH ;; Center window of type _NET_WM_WINDOW_TYPE_SPLASH
(when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH exwm-window-type) (when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH exwm-window-type)
@ -145,10 +145,34 @@ corresponding buffer.")
(throw 'return 'ignored)) (throw 'return 'ignored))
;; Manage the window ;; Manage the window
(exwm--log "Manage #x%x" id) (exwm--log "Manage #x%x" id)
;; Create a new container as the parent of this X window
(setq exwm--container (xcb:generate-id exwm--connection))
(xcb:+request exwm--connection
(make-instance 'xcb:CreateWindow
:depth 0 :wid exwm--container
:parent (frame-parameter exwm-workspace--current
'exwm-workspace)
:x 0 :y 0 :width 1 :height 1 :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))
(exwm--debug
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window exwm--container
:data (format "EXWM container for 0x%x" id))))
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window id :parent exwm--container :x 0 :y 0))
(xcb:+request exwm--connection ;remove border (xcb:+request exwm--connection ;remove border
(make-instance 'xcb:ConfigureWindow (make-instance 'xcb:ConfigureWindow
:window id :value-mask xcb:ConfigWindow:BorderWidth :window id :value-mask xcb:ConfigWindow:BorderWidth
:border-width 0)) :border-width 0))
;; (xcb:+request exwm--connection ;map the window
;; (make-instance 'xcb:MapWindow :window id))
(dolist (button ;grab buttons to set focus / move / resize (dolist (button ;grab buttons to set focus / move / resize
(list xcb:ButtonIndex:1 xcb:ButtonIndex:2 xcb:ButtonIndex:3)) (list xcb:ButtonIndex:1 xcb:ButtonIndex:2 xcb:ButtonIndex:3))
(xcb:+request-checked+request-check exwm--connection (xcb:+request-checked+request-check exwm--connection
@ -190,9 +214,8 @@ corresponding buffer.")
(xcb:flush exwm--connection) (xcb:flush exwm--connection)
(when (buffer-live-p buffer) (when (buffer-live-p buffer)
(with-current-buffer buffer (with-current-buffer buffer
(when exwm--floating-frame (xcb:+request exwm--connection
(make-frame-invisible exwm--floating-frame) (make-instance 'xcb:UnmapWindow :window exwm--container))
(redisplay))
(setq exwm-workspace--switch-history-outdated t) (setq exwm-workspace--switch-history-outdated t)
;; ;;
(when withdraw-only (when withdraw-only
@ -207,9 +230,7 @@ corresponding buffer.")
(setq geometry-parent (setq geometry-parent
(xcb:+request-unchecked+reply exwm--connection (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry (make-instance 'xcb:GetGeometry
:drawable :drawable exwm--container))
(frame-parameter exwm--floating-frame
'exwm-outer-id)))
geometry (xcb:+request-unchecked+reply exwm--connection geometry (xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GetGeometry (make-instance 'xcb:GetGeometry
:drawable id))) :drawable id)))
@ -227,6 +248,13 @@ corresponding buffer.")
(make-instance 'xcb:DeleteProperty (make-instance 'xcb:DeleteProperty
:window id :property xcb:Atom:WM_STATE)) :window id :property xcb:Atom:WM_STATE))
(xcb:flush exwm--connection)) (xcb:flush exwm--connection))
;; Destroy the container (it seems it has to be delayed).
(run-with-idle-timer 0 nil
`(lambda ()
(xcb:+request exwm--connection
,(make-instance 'xcb:DestroyWindow
:window exwm--container))
(xcb:flush exwm--connection)))
(let ((kill-buffer-query-functions nil) (let ((kill-buffer-query-functions nil)
(floating exwm--floating-frame)) (floating exwm--floating-frame))
(kill-buffer) (kill-buffer)
@ -252,55 +280,62 @@ corresponding buffer.")
;;;###autoload ;;;###autoload
(defun exwm-manage--close-window (id &optional buffer) (defun exwm-manage--close-window (id &optional buffer)
"Close window ID in a proper way." "Close window ID in a proper way."
(catch 'return (let (container)
(unless (exwm--id->buffer id) (catch 'return
(throw 'return t)) (unless (exwm--id->buffer id)
(unless buffer (setq buffer (exwm--id->buffer id))) (throw 'return t))
;; Destroy the client window if it does not support WM_DELETE_WINDOW (unless buffer (setq buffer (exwm--id->buffer id)))
(unless (and (buffer-live-p buffer) (when (buffer-live-p buffer)
(with-current-buffer buffer (setq container exwm--container))
(memq xcb:Atom:WM_DELETE_WINDOW exwm--protocols))) ;; Destroy the client window if it does not support WM_DELETE_WINDOW
(xcb:+request exwm--connection (unless (and (buffer-live-p buffer)
(make-instance 'xcb:DestroyWindow :window id)) (with-current-buffer buffer
(xcb:flush exwm--connection) (memq xcb:Atom:WM_DELETE_WINDOW exwm--protocols)))
(throw 'return nil)) (xcb:+request exwm--connection
;; Try to close the window with WM_DELETE_WINDOW client message (make-instance 'xcb:DestroyWindow :window id))
(xcb:+request exwm--connection (xcb:flush exwm--connection)
(make-instance 'xcb:icccm:SendEvent
:destination id
:event (xcb:marshal
(make-instance 'xcb:icccm:WM_DELETE_WINDOW
:window id)
exwm--connection)))
(xcb:flush exwm--connection)
;; Try to determine if the client stop responding
(with-current-buffer buffer
(unless (memq xcb:Atom:_NET_WM_PING exwm--protocols)
;; Ensure it's dead
(run-with-timer exwm-manage-ping-timeout nil
`(lambda () (exwm-manage--kill-client ,id)))
(throw 'return nil)) (throw 'return nil))
(setq exwm-manage--ping-lock t) ;; Try to close the window with WM_DELETE_WINDOW client message
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:SendEvent (make-instance 'xcb:icccm:SendEvent
:propagate 0 :destination id :destination id
:event-mask xcb:EventMask:NoEvent
:event (xcb:marshal :event (xcb:marshal
(make-instance 'xcb:ewmh:_NET_WM_PING (make-instance 'xcb:icccm:WM_DELETE_WINDOW
:window id :timestamp 0 :window id)
:client-window id)
exwm--connection))) exwm--connection)))
(xcb:flush exwm--connection) (xcb:flush exwm--connection)
(with-timeout (exwm-manage-ping-timeout ;; Try to determine if the client stop responding
(if (yes-or-no-p (format "`%s' is not responding. \ (with-current-buffer buffer
(unless (memq xcb:Atom:_NET_WM_PING exwm--protocols)
;; Ensure it's dead
(run-with-timer exwm-manage-ping-timeout nil
`(lambda () (exwm-manage--kill-client ,id)))
(throw 'return nil))
(setq exwm-manage--ping-lock t)
(xcb:+request exwm--connection
(make-instance 'xcb:SendEvent
:propagate 0 :destination id
:event-mask xcb:EventMask:NoEvent
:event (xcb:marshal
(make-instance 'xcb:ewmh:_NET_WM_PING
:window id :timestamp 0
:client-window id)
exwm--connection)))
(xcb:flush exwm--connection)
(with-timeout (exwm-manage-ping-timeout
(if (yes-or-no-p (format "`%s' is not responding. \
Would you like to kill it? " Would you like to kill it? "
(buffer-name buffer))) (buffer-name buffer)))
(progn (exwm-manage--kill-client id) (progn (exwm-manage--kill-client id)
(throw 'return nil)) (throw 'return nil))
(throw 'return nil))) (throw 'return nil)))
(while (and exwm-manage--ping-lock (while (and exwm-manage--ping-lock
(exwm--id->buffer id)) ;may have been destroyed (exwm--id->buffer id)) ;may have been destroyed
(accept-process-output nil 0.1)))))) (accept-process-output nil 0.1)))))
;; Finally destroy the container
(xcb:+request exwm--connection
(make-instance 'xcb:DestroyWindow :window container))
(xcb:flush exwm--connection)))
(defun exwm-manage--kill-client (&optional id) (defun exwm-manage--kill-client (&optional id)
"Kill an X client." "Kill an X client."
@ -338,9 +373,8 @@ Would you like to kill it? "
(list 0 0 (list 0 0
(frame-pixel-width exwm-workspace--current) (frame-pixel-width exwm-workspace--current)
(frame-pixel-height exwm-workspace--current)) (frame-pixel-height exwm-workspace--current))
(or exwm--floating-edges (window-inside-absolute-pixel-edges
(window-inside-absolute-pixel-edges (get-buffer-window buffer t))))
(get-buffer-window buffer t)))))
(exwm--log "Reply with ConfigureNotify (edges): %s" edges) (exwm--log "Reply with ConfigureNotify (edges): %s" edges)
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:SendEvent (make-instance 'xcb:SendEvent

14
exwm-randr.el
View file

@ -48,6 +48,7 @@
(require 'xcb-randr) (require 'xcb-randr)
(require 'exwm-core) (require 'exwm-core)
(require 'exwm-layout)
(eval-when-compile (require 'exwm-workspace)) (eval-when-compile (require 'exwm-workspace))
(defvar exwm-randr-workspace-output-plist nil) (defvar exwm-randr-workspace-output-plist nil)
@ -93,15 +94,10 @@
(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)
(with-slots (x y width height) geometry (with-slots (x y width height) geometry
(xcb:+request exwm--connection (exwm-layout--resize-container (frame-parameter frame 'exwm-outer-id)
(make-instance 'xcb:ConfigureWindow (frame-parameter frame
:window (frame-parameter frame 'exwm-outer-id) 'exwm-workspace)
:value-mask (eval-when-compile x y width height)
(logior xcb:ConfigWindow:X
xcb:ConfigWindow:Y
xcb:ConfigWindow:Width
xcb:ConfigWindow:Height))
:x x :y y :width width :height height))
(setq workareas (nconc workareas (list x y width height)) (setq workareas (nconc workareas (list x y width height))
viewports (nconc viewports (list x y)))))) viewports (nconc viewports (list x y))))))
;; Update _NET_WORKAREA ;; Update _NET_WORKAREA

93
exwm-workspace.el
View file

@ -122,22 +122,16 @@ The optional FORCE option is for internal use only."
(unless (and (<= 0 index) (< index exwm-workspace-number)) (unless (and (<= 0 index) (< index exwm-workspace-number))
(user-error "[EXWM] Workspace index out of range: %d" index)) (user-error "[EXWM] Workspace index out of range: %d" index))
(when (or force (/= exwm-workspace-current-index index)) (when (or force (/= exwm-workspace-current-index index))
(let ((frame (elt exwm-workspace--list index))) (let* ((frame (elt exwm-workspace--list index))
(workspace (frame-parameter frame 'exwm-workspace)))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window workspace
:value-mask xcb:ConfigWindow:StackMode
:stack-mode xcb:StackMode:Above))
(setq exwm-workspace--current frame (setq exwm-workspace--current frame
exwm-workspace-current-index index) exwm-workspace-current-index index)
(select-frame-set-input-focus frame) (select-window (frame-selected-window frame))
;; Move mouse when necessary
(let ((position (mouse-pixel-position))
x y w h)
(unless (eq frame (car position))
(setq x (cadr position)
y (cddr position)
w (frame-pixel-width frame)
h (frame-pixel-height frame))
(when (or (> x w) (> y h))
(setq x (/ w 2)
y (/ h 2)))
(set-mouse-pixel-position frame x y)))
;; Close the (possible) active minibuffer ;; Close the (possible) active minibuffer
(when (active-minibuffer-window) (when (active-minibuffer-window)
(run-with-idle-timer 0 nil (lambda () (abort-recursive-edit)))) (run-with-idle-timer 0 nil (lambda () (abort-recursive-edit))))
@ -161,16 +155,6 @@ The optional FORCE option is for internal use only."
:window exwm--root :data index)) :window exwm--root :data index))
(xcb:flush exwm--connection))))) (xcb:flush exwm--connection)))))
(defun exwm-workspace--on-focus-in ()
"Fix 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)))))
;;;###autoload ;;;###autoload
(defun exwm-workspace-move-window (index &optional id) (defun exwm-workspace-move-window (index &optional id)
"Move window ID to workspace INDEX." "Move window ID to workspace INDEX."
@ -204,10 +188,9 @@ The optional FORCE option is for internal use only."
(progn (progn
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow (make-instance 'xcb:ReparentWindow
:window (frame-parameter exwm--floating-frame :window exwm--container
'exwm-outer-id) :parent
:parent (frame-parameter frame (frame-parameter frame 'exwm-workspace)
'exwm-window-id)
:x 0 :y 0)) :x 0 :y 0))
(xcb:flush exwm--connection)) (xcb:flush exwm--connection))
;; Move the window itself ;; Move the window itself
@ -222,8 +205,10 @@ The optional FORCE option is for internal use only."
(exwm-layout--hide id) (exwm-layout--hide id)
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow (make-instance 'xcb:ReparentWindow
:window id ;; (current-buffer) is changed.
:parent (frame-parameter frame 'exwm-window-id) :window (with-current-buffer (exwm--id->buffer id)
exwm--container)
:parent (frame-parameter frame 'exwm-workspace)
:x 0 :y 0)) :x 0 :y 0))
(xcb:flush exwm--connection) (xcb:flush exwm--connection)
(set-window-buffer (frame-selected-window frame) (set-window-buffer (frame-selected-window frame)
@ -303,50 +288,58 @@ The optional FORCE option is for internal use only."
(set-frame-parameter (car exwm-workspace--list) 'client nil)) (set-frame-parameter (car exwm-workspace--list) 'client nil))
;; Create remaining frames ;; Create remaining frames
(dotimes (_ (1- exwm-workspace-number)) (dotimes (_ (1- exwm-workspace-number))
(nconc exwm-workspace--list (nconc exwm-workspace--list (list (make-frame '((window-system . x))))))
(list (make-frame '((window-system . x)
(visibility . nil))))))
;; Configure workspaces ;; Configure workspaces
(dolist (i exwm-workspace--list) (dolist (i exwm-workspace--list)
(let ((window-id (string-to-number (frame-parameter i 'window-id))) (let ((outer-id (string-to-number (frame-parameter i 'outer-window-id)))
(outer-id (string-to-number (frame-parameter i 'outer-window-id)))) (workspace (xcb:generate-id exwm--connection)))
;; Save window IDs ;; Save window IDs
(set-frame-parameter i 'exwm-window-id window-id)
(set-frame-parameter i 'exwm-outer-id outer-id) (set-frame-parameter i 'exwm-outer-id outer-id)
(set-frame-parameter i 'exwm-workspace workspace)
;; Set OverrideRedirect on all frames ;; Set OverrideRedirect on all frames
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes (make-instance 'xcb:ChangeWindowAttributes
:window outer-id :value-mask xcb:CW:OverrideRedirect :window outer-id :value-mask xcb:CW:OverrideRedirect
:override-redirect 1)) :override-redirect 1))
;; Select events on all virtual roots
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes (make-instance 'xcb:CreateWindow
:window window-id :value-mask xcb:CW:EventMask :depth 0 :wid workspace :parent exwm--root
:event-mask xcb:EventMask:SubstructureRedirect)))) :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))
(exwm--debug
(xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window workspace
:data
(format "EXWM workspace %d"
(cl-position i exwm-workspace--list)))))
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window outer-id :parent workspace :x 0 :y 0))
(xcb:+request exwm--connection
(make-instance 'xcb:MapWindow :window workspace))))
(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)
;; We have to delay making the frame visible until the
;; override-redirect flag has been set.
(select-frame-set-input-focus (car exwm-workspace--list))
(dolist (i exwm-workspace--list)
(set-frame-parameter i 'visibility t)
(lower-frame i))
;; Delay making the workspaces fullscreen until Emacs becomes idle ;; Delay making the workspaces fullscreen until Emacs becomes idle
(run-with-idle-timer 0 nil (run-with-idle-timer 0 nil
(lambda () (lambda ()
(dolist (i exwm-workspace--list) (dolist (i exwm-workspace--list)
(set-frame-parameter i 'fullscreen 'fullboth)))) (set-frame-parameter i 'fullscreen 'fullboth))))
(raise-frame (car exwm-workspace--list))
;; Handle unexpected frame switch
(add-hook 'focus-in-hook #'exwm-workspace--on-focus-in)
;; 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
:window exwm--root :window exwm--root
:data (vconcat (mapcar :data (vconcat (mapcar
(lambda (i) (lambda (i)
(frame-parameter i 'exwm-window-id)) (frame-parameter i 'exwm-workspace))
exwm-workspace--list)))) exwm-workspace--list))))
;; Switch to the first workspace ;; Switch to the first workspace
(exwm-workspace-switch 0 t)) (exwm-workspace-switch 0 t))

5
exwm.el
View file

@ -501,8 +501,7 @@
(setq exwm--connection nil) (setq exwm--connection nil)
(exwm--log "Other window manager detected")) (exwm--log "Other window manager detected"))
;; Disable some features not working well with EXWM ;; Disable some features not working well with EXWM
(setq use-dialog-box nil (setq use-dialog-box nil)
display-hourglass nil)
;; Initialize ICCCM/EWMH support ;; Initialize ICCCM/EWMH support
;; (xcb:icccm:init exwm--connection) ;; (xcb:icccm:init exwm--connection)
(xcb:ewmh:init exwm--connection) (xcb:ewmh:init exwm--connection)
@ -511,9 +510,9 @@
(exwm-layout--init) (exwm-layout--init)
(exwm-floating--init) (exwm-floating--init)
(exwm-manage--init) (exwm-manage--init)
(exwm-workspace--init)
(exwm-input--init) (exwm-input--init)
(exwm--unlock) (exwm--unlock)
(exwm-workspace--init)
;; Manage existing windows ;; Manage existing windows
(exwm-manage--scan) (exwm-manage--scan)
(run-hooks 'exwm-init-hook))))) (run-hooks 'exwm-init-hook)))))