diff options
| author | Chris Feng <chris.w.feng@gmail.com> | 2018-02-17T17·04+0800 |
|---|---|---|
| committer | Chris Feng <chris.w.feng@gmail.com> | 2018-02-17T17·04+0800 |
| commit | 7823eb988c22f5dc804ef862d91a0fcf474ca718 (patch) | |
| tree | c7a5428f6e195f5205750c9ad922b5f05bc6c407 | |
| parent | 83c0a2db3448091e44cded075104a0b7df636431 (diff) | |
Make X windows container-less
; This is an attempt to make (managed) X windows container-less, i.e. direct children of the root window. This is mainly to make EXWM compatible with third-party compositors. Other issues like wrong absolute position should also get resolved by the way. The workspace containers ("virtual roots") are also removed. However Emacs frames are still wrapped in containers to avoid unexpected stack reordering.
* exwm-cm.el: Make this module obsolete as EXWM supports third-party compositors now.
* exwm-core.el (exwm--container):
* exwm-floating.el (exwm-floating--set-floating)
(exwm-floating--unset-floating, exwm-floating-hide)
(exwm-floating--start-moveresize, exwm-floating--stop-moveresize)
(exwm-floating--do-moveresize, exwm-floating-move):
* exwm-input.el (exwm-input--update-focus):
* exwm-layout.el (exwm-layout--show, exwm-layout--hide)
(exwm-layout-set-fullscreen, exwm-layout-unset-fullscreen):
* exwm-manage.el (exwm-manage--manage-window, exwm-manage--unmanage-window)
(exwm-manage--kill-buffer-query-function, exwm-manage--kill-client):
* exwm-workspace.el (exwm-workspace--set-fullscreen, exwm-workspace-switch)
(exwm-workspace-move-window, exwm-workspace--add-frame-as-workspace)
(exwm-workspace--remove-frame-as-workspace): Make adaptions for container-less X windows.
* exwm-workspace.el (exwm-workspace--update-ewmh-props):
* exwm.el (exwm--init-icccm-ewmh, exwm--exit-icccm-ewmh): No longer use virtual roots.
* exwm-input.el (exwm-input--on-workspace-list-change)
(exwm-input--update-global-prefix-keys, exwm-input--init, exwm-input--exit): From now on global key bindings are grabbed on the root window so it's no long required to re-grab them each time the workspace list changes. As a result `exwm-input--on-workspace-list-change' and its corresponding references are discarded. It remains to be seen if this change will raise input focus issues.
* exwm-manage.el (exwm-manage--manage-window): Explicitly set the workspace for newly managed X windows.
* exwm-floating.el (exwm-floating--set-floating): Avoid implicit reference to the current workspace.
* exwm-core.el (exwm--set-geometry): New function for setting the geometry of an X window.
* exwm-layout.el (exwm-layout--resize-container): Replaced by `exwm-layout--resize-container'.
* exwm-core.el (exwm--guide-window): New global variable recording the guide X window.
* exwm.el (exwm--init-icccm-ewmh): Set it.
* exwm-input.el (exwm-input--post-init): New function containing staffs for initialization but should better get called after the event loop starts.
* exwm.el (exwm-init): Use it.
| -rw-r--r-- | README.md | 1 | ||||
| -rw-r--r-- | exwm-cm.el | 1756 | ||||
| -rw-r--r-- | exwm-core.el | 20 | ||||
| -rw-r--r-- | exwm-floating.el | 258 | ||||
| -rw-r--r-- | exwm-input.el | 112 | ||||
| -rw-r--r-- | exwm-layout.el | 178 | ||||
| -rw-r--r-- | exwm-manage.el | 145 | ||||
| -rw-r--r-- | exwm-randr.el | 2 | ||||
| -rw-r--r-- | exwm-workspace.el | 320 | ||||
| -rw-r--r-- | exwm.el | 10 |
10 files changed, 360 insertions, 2442 deletions
diff --git a/README.md b/README.md index 1b65486c69e3..103948c63379 100644 --- a/README.md +++ b/README.md @@ -8,7 +8,6 @@ It features: + Dynamic workspace support + ICCCM/EWMH compliance + (Optional) RandR (multi-monitor) support -+ (Optional) Built-in compositing manager + (Optional) Built-in system tray Please check out the diff --git a/exwm-cm.el b/exwm-cm.el index 060dce780bf3..77dd2774a11d 100644 --- a/exwm-cm.el +++ b/exwm-cm.el @@ -21,1765 +21,27 @@ ;;; Commentary: -;; This module provides a compositing manager (CM) for EXWM, mainly to -;; enable transparency support. - -;; Usage: -;; Add following lines to .emacs and modify accordingly: -;; -;; (require 'exwm-cm) -;; ;; Make all Emacs frames opaque. -;; (setq window-system-default-frame-alist '((x . ((alpha . 100))))) -;; ;; Assign everything else a 80% opacity. -;; (setq exwm-cm-opacity 80) -;; (exwm-cm-enable) -;; -;; With the last line this CM would be started with EXWM. You can also -;; start and stop this CM with `exwm-cm-start' and `exwm-cm-stop' at any -;; time. - -;; Theory: -;; Due to its unique way of managing X windows, EXWM can not work with -;; any existing CMs. And this CM, designed specifically for EXWM, -;; probably won't work well with other WMs, too. The theories behind -;; all CMs are basically the same, some peculiarities of this CM are -;; summarized as the following sections. - -;; + Data structures: -;; This CM organizes all X windows concerned with compositing in a -;; tree hierarchy. Below is a stripped-down version of such tree with -;; each node representing an X window (except the root placeholder), -;; -;; (nil -;; (root-xwin -;; (unmanaged-xwin) -;; (workspace-container -;; (unmanaged-xwin) -;; (xwin-container -;; (xwin) -;; (floating-frame-container -;; (floating-frame))) -;; (xwin-container -;; (xwin)) -;; (workspace-frame-container -;; (workspace-frame))) -;; (minibuffer-frame-container -;; (minibuffer-frame)))) -;; -;; where -;; - nodes with non-nil CDRs are containers, -;; - siblings are arranged in stacking order (top to bottom), -;; - and "managed" and "unmanaged" are in WM's sense. -;; -;; During a painting process, the tree is traversed starting from the -;; root node, with each leaf visited and painted. The attributes of -;; each X window (position, size, etc) are recorded as an instance of -;; class `exwm-cm--attr'. Such instance is associated with the -;; corresponding X window ID through a hash table. The instance also -;; contains a slot pointing to a subtree of the aforementioned tree, -;; with the root node being the parent of the X window. This makes it -;; convenient to carry out operations such as insertion, deletion, -;; restacking and reparenting. - -;; + Compositing strategies: -;; - Only leaves are painted, since branches (containers) are always -;; invisible. -;; - The root X window is painted separately. -;; - Siblings below a workspace frame container are not painted; they -;; are considered hidden. -;; - Only the top workspace in one (RandR) output is painted. -;; - Workspace frames and floating frames are always clipped by its -;; Emacs windows displaying `exwm-mode' buffers, therefore they -;; don't block X windows. - -;; Reference: -;; + xcompmgr (http://cgit.freedesktop.org/xorg/app/xcompmgr/) +;; This module is obsolete since EXWM now supports third-porty compositors. ;;; Code: -(require 'xcb-composite) -(require 'xcb-damage) -(require 'xcb-ewmh) -(require 'xcb-icccm) -(require 'xcb-renderutil) -(require 'xcb-shape) - -(require 'exwm-core) -(require 'exwm-workspace) -(require 'exwm-manage) - -(defconst exwm-cm--OPAQUE (float #xFFFFFFFF) - "The opacity value of the _NET_WM_WINDOW_OPACITY property.") -(defvar exwm-cm--_NET_WM_WINDOW_OPACITY nil "The _NET_WM_WINDOW_OPACITY atom.") -(defvar exwm-cm-opacity nil - "The default value of opacity when it's not explicitly specified. - -The value should be a floating number between 0 (transparent) and 100 -\(opaque). A value of nil also means opaque.") - -(defvar exwm-cm--hash nil - "The hash table associating X window IDs to their attributes.") - -(defvar exwm-cm--conn nil "The X connection used by the CM.") -(defvar exwm-cm--buffer nil "The rendering buffer.") -(defvar exwm-cm--depth nil "Default depth.") -(defvar exwm-cm--clip-changed t "Whether clip has changed.") -(defvar exwm-cm--damages nil "All damaged regions.") -(defvar exwm-cm--expose-rectangles nil - "Used by Expose event handler to collect exposed regions.") - -(defvar exwm-cm--background nil "The background (render) picture.") -(defvar exwm-cm--background-atom-names '("_XROOTPMAP_ID" "_XSETROOT_ID") - "Property names for background pixmap.") -(defvar exwm-cm--background-atoms nil "Interned atoms of the property names.") - -(defun exwm-cm--get-opacity (xwin) - "Get the opacity of X window XWIN. - -The value is between 0 (fully transparent) to #xFFFFFFFF (opaque)." - (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:icccm:-GetProperty-single - :window xwin - :property exwm-cm--_NET_WM_WINDOW_OPACITY - :type xcb:Atom:CARDINAL)))) - ;; The X window might have already been destroyed. - (when reply - (slot-value reply 'value)))) - -;;;###autoload -(defun exwm-cm-set-opacity (xwin opacity) - "Set the opacity of X window XWIN to OPACITY. - -The value is between 0 (fully transparent) to 100 (opaque). - -If called interactively, XWIN would be the selected X window." - (interactive - (list (exwm--buffer->id (window-buffer)) - (read-number "Opacity (0 ~ 100): " 100))) - (when (and xwin - (<= 0 opacity 100)) - (setq opacity (round (* exwm-cm--OPAQUE (/ opacity 100.0)))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:icccm:-ChangeProperty-single - :window xwin - :property exwm-cm--_NET_WM_WINDOW_OPACITY - :type xcb:Atom:CARDINAL - :data opacity)) - (xcb:flush exwm-cm--conn))) - -(defclass exwm-cm--attr () - ( - ;; The entity associated with this X window; can be a frame, a buffer - ;; or nil. - (entity :initform nil) - ;; The subtree of which the root node is the parent of this X window. - (tree :initarg :tree) - ;; Geometry. - (x :initarg :x) - (y :initarg :y) - (width :initarg :width) - (height :initarg :height) - ;; X window attributes. - (visual :initarg :visual) - (class :initarg :class) - ;; The opacity of this X window; can be 0 ~ #xFFFE or nil. - (opacity :initform nil) - ;; Determine whether this X window should be treated as opaque or - ;; transparent; can be nil (opaque), 'argb or 'transparent (both - ;; should be treated as transparent). - (mode :initform nil) - ;; The (render) picture of this X window. - (picture :initform nil) - ;; The 1x1 (render) picture with only alpha channel. - (alpha-picture :initform nil) - ;; Whether this X window is ever damaged. - (damaged :initform nil) - ;; The damage object monitoring this X window. - (damage :initarg :damage) - ;; The bounding region of this X window (can be irregular). - (border-size :initform nil) - ;; The rectangular bounding region of this X window. - (extents :initform nil) - ;; The region require repainting (used for transparent X windows). - (border-clip :initform nil) - ;; Shape-related parameters. - (shaped :initform nil) - (shape-x :initarg :shape-x) - (shape-y :initarg :shape-y) - (shape-width :initarg :shape-width) - (shape-height :initarg :shape-height)) - :documentation "Attributes of an X window.") - -(defsubst exwm-cm--xwin->attr (xwin) - "Get the attributes of X window XWIN." - (gethash xwin exwm-cm--hash)) - -(defsubst exwm-cm--get-tree (xwin) - "Get the subtree of the parent of X window XWIN." - (slot-value (exwm-cm--xwin->attr xwin) 'tree)) - -(defsubst exwm-cm--set-tree (xwin tree) - "Reparent X window XWIN to another tree TREE." - (setf (slot-value (exwm-cm--xwin->attr xwin) 'tree) tree)) - -(defsubst exwm-cm--get-parent (xwin) - "Get the parent of X window XWIN." - (car (exwm-cm--get-tree xwin))) - -(defsubst exwm-cm--get-siblings (xwin) - "Get a list of subtrees of the siblings of X window XWIN." - (cdr (exwm-cm--get-tree xwin))) - -(defsubst exwm-cm--get-subtree (xwin) - "Get the subtree of which the X window XWIN is the root node." - (assq xwin (exwm-cm--get-siblings xwin))) - -(defun exwm-cm--create-attr (xwin tree x y width height) - "Create attributes for X window XWIN. - -TREE is the subtree and the parent of this X window is the tree's root. -X and Y specify the position with regard to the root X window. WIDTH -and HEIGHT specify the size of the X window." - (let (visual class map-state damage attr) - (cond - ((= xwin exwm--root) - ;; Redirect all subwindows to off-screen storage. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:composite:RedirectSubwindows - :window exwm--root - :update xcb:composite:Redirect:Manual)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:ChangeWindowAttributes - :window xwin - :value-mask xcb:CW:EventMask - :event-mask (logior xcb:EventMask:StructureNotify - xcb:EventMask:PropertyChange - xcb:EventMask:SubstructureNotify - xcb:EventMask:Exposure))) - (setq visual (slot-value (car (slot-value (xcb:get-setup exwm-cm--conn) - 'roots)) - 'root-visual) - class xcb:WindowClass:InputOutput)) - ((eq xwin exwm-manage--desktop) - ;; Ignore any desktop; paint the background ourselves. - (setq visual 0 - class xcb:WindowClass:InputOnly - map-state xcb:MapState:Unmapped)) - (t - ;; Redirect this window to off-screen storage, or the content - ;; would be mirrored to its parent. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:composite:RedirectWindow - :window xwin - :update xcb:composite:Redirect:Manual)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:ChangeWindowAttributes - :window xwin - :value-mask xcb:CW:EventMask - :event-mask (logior xcb:EventMask:StructureNotify - xcb:EventMask:PropertyChange))) - (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:GetWindowAttributes - :window xwin)))) - (if reply - (with-slots ((visual* visual) - (class* class) - (map-state* map-state)) - reply - (setq visual visual* - class class* - map-state map-state*)) - ;; The X window has been destroyed actually. It'll get - ;; removed by a DestroyNotify event. - (setq visual 0 - class xcb:WindowClass:InputOnly - map-state xcb:MapState:Unmapped))) - (when (/= class xcb:WindowClass:InputOnly) - (setq damage (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:damage:Create - :damage damage - :drawable xwin - :level xcb:damage:ReportLevel:NonEmpty)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:shape:SelectInput - :destination-window xwin - :enable 1))))) - (setq attr (make-instance 'exwm-cm--attr - :tree tree - :x x - :y y - :width width - :height height - :visual visual - :class class - :damage damage - :shape-x x - :shape-y y - :shape-width width - :shape-height height)) - (puthash xwin attr exwm-cm--hash) - (unless (or (= xwin exwm--root) - (= class xcb:WindowClass:InputOnly)) - (exwm-cm--update-opacity xwin) - (when (= map-state xcb:MapState:Viewable) - (exwm-cm--map-xwin xwin t))))) - -(defun exwm-cm--update-geometry (xwin x y width height &optional above-sibling) - "Update the geometry of X window XWIN. - -X, Y, WIDTH and HEIGHT have the same meaning with the arguments used in -`exwm-cm--create-attr'. If ABOVE-SIBLING is non-nil, restack XWIN with -`exwm-cm--restack.'" - (with-slots ((x* x) - (y* y) - (width* width) - (height* height) - extents shaped shape-x shape-y shape-width shape-height) - (exwm-cm--xwin->attr xwin) - (let ((stack-changed (and above-sibling - (exwm-cm--restack xwin above-sibling))) - (position-changed (or (and x (/= x x*)) - (and y (/= y y*)))) - (size-changed (or (and width (/= width width*)) - (and height (/= height height*)))) - subtree dx dy damage new-extents) - (when position-changed - (setq subtree (exwm-cm--get-subtree xwin) - dx (- x x*) - dy (- y y*)) - (dolist (node (cdr subtree)) - (with-slots (x y) (exwm-cm--xwin->attr (car node)) - (exwm--log "(CM) #x%X(*): @%+d%+d => @%+d%+d" - (car node) x y (+ x dx) (+ y dy)) - (exwm-cm--update-geometry (car node) (+ x dx) (+ y dy) nil nil))) - (exwm--log "(CM) #x%X: @%+d%+d => @%+d%+d" xwin x* y* x y) - (setf x* x - y* y) - (cl-incf shape-x dx) - (cl-incf shape-y dy)) - (when size-changed - (setf width* width - height* height) - (unless shaped - (setf shape-width width - shape-height height))) - (when (or stack-changed position-changed size-changed) - (setq damage (xcb:generate-id exwm-cm--conn) - new-extents (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region damage - :rectangles nil)) - (when extents - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CopyRegion - :source extents - :destination damage))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region new-extents - :rectangles (list (make-instance 'xcb:RECTANGLE - :x x* - :y y* - :width width* - :height height*)))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:UnionRegion - :source1 damage - :source2 new-extents - :destination damage)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region new-extents)) - (exwm-cm--add-damage damage))))) - -(defun exwm-cm--update-opacity (xwin) - "Update the opacity of X window XWIN." - (with-slots (visual opacity mode alpha-picture extents) - (exwm-cm--xwin->attr xwin) - (let (format forminfo) - ;; Get the opacity. - (setf opacity (exwm-cm--get-opacity xwin)) - (if opacity - (setf opacity (round (* #xFFFF (/ opacity exwm-cm--OPAQUE)))) - (when (numberp exwm-cm-opacity) - (setf opacity (round (* #xFFFF (/ exwm-cm-opacity 100.0)))))) - (when (and opacity - (>= opacity #xFFFF)) - (setf opacity nil)) - ;; Determine the mode of the X window. - (setq format (xcb:renderutil:find-visual-format - (xcb:renderutil:query-formats exwm-cm--conn) visual)) - (when format - (catch 'break - (dolist (f (slot-value (xcb:renderutil:query-formats exwm-cm--conn) - 'formats)) - (when (eq format (slot-value f 'id)) - (setq forminfo f) - (throw 'break nil))))) - (if (and forminfo - (eq xcb:render:PictType:Direct (slot-value forminfo 'type)) - (/= 0 (slot-value (slot-value forminfo 'direct) 'alpha-mask))) - (setf mode 'argb) - (if opacity - (setf mode 'transparent) - (setf mode nil))) - ;; Clear resources. - (when alpha-picture - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:FreePicture - :picture alpha-picture)) - (setf alpha-picture nil)) - (when extents - (let ((damage (xcb:generate-id exwm-cm--conn))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region damage - :rectangles nil)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CopyRegion - :source extents - :destination damage)) - (exwm-cm--add-damage damage)))))) - -(defsubst exwm-cm--push (newelt place) - "Similar to `push' but preserve the reference." - (let ((oldelt (car place))) - (setf (car place) newelt - (cdr place) (cons oldelt (cdr place))))) - -(defsubst exwm-cm--delq (elt list) - "Similar to `delq' but preserve the reference." - (if (eq elt (car list)) - (setf (car list) (cadr list) - (cdr list) (cddr list)) - (delq elt list))) - -(defsubst exwm-cm--assq-delete-all (key alist) - "Similar to `assq-delete-all' but preserve the reference." - (when (eq key (caar alist)) - (setf (car alist) (cadr alist) - (cdr alist) (cddr alist))) - (assq-delete-all key alist)) - -(defun exwm-cm--create-tree (&optional xwin) - "Create a tree with XWIN being the root node." - (let (tree0 x0 y0 children containers) - ;; Get the position of this branch. - (if xwin - (with-slots (tree x y) (exwm-cm--xwin->attr xwin) - (setq tree0 (assq xwin (cdr tree)) - x0 x - y0 y)) - (setq tree0 (list nil) - x0 0 - y0 0)) - ;; Get children nodes. - (if (null xwin) - (setq children (list exwm--root)) - (setq children - (reverse (slot-value (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:QueryTree - :window xwin)) - 'children)))) - ;; Get container nodes. - ;; Floating frame containers are determined dynamically. - (cond - ((null xwin) - (setq containers `((,exwm--root)))) - ((= xwin exwm--root) - ;; Workspace containers and the minibuffer frame container. - (setq containers (mapcar (lambda (f) - (cons (frame-parameter f 'exwm-workspace) f)) - exwm-workspace--list)) - (when (exwm-workspace--minibuffer-own-frame-p) - (push (cons - (frame-parameter exwm-workspace--minibuffer 'exwm-container) - exwm-workspace--minibuffer) - containers))) - ;; No containers in the minibuffer container. - ((and (exwm-workspace--minibuffer-own-frame-p) - (= xwin - (frame-parameter exwm-workspace--minibuffer 'exwm-container)))) - ((= exwm--root - (slot-value (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:QueryTree - :window xwin)) - 'parent)) - ;; Managed X window containers and the workspace frame container. - (let (frame) - (catch 'break - (dolist (f exwm-workspace--list) - (when (= xwin (frame-parameter f 'exwm-workspace)) - (setq frame f) - (throw 'break nil)))) - (cl-assert frame) - (dolist (pair exwm--id-buffer-alist) - (with-current-buffer (cdr pair) - (when (eq frame exwm--frame) - (push (cons exwm--container (cdr pair)) containers)))) - (push (cons (frame-parameter frame 'exwm-container) frame) - containers)))) - ;; Create subnodes. - (dolist (xwin children) - ;; Create attributes. - (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:GetGeometry - :drawable xwin)))) - ;; It's possible the X window has been destroyed. - (if (null reply) - (setq xwin nil) - (when reply - (with-slots (x y width height) reply - (exwm-cm--create-attr xwin tree0 - (+ x x0) (+ y y0) width height)) - ;; Insert the node. - (setcdr (or (last (cdr tree0)) tree0) `((,xwin)))))) - (cond - ((null xwin)) - ((assq xwin containers) - ;; A branch. Repeat the process. - (exwm-cm--create-tree xwin) - (let ((entity (cdr (assq xwin containers))) - entity-xwin) - (when entity - (setq entity-xwin (if (framep entity) - (frame-parameter entity 'exwm-outer-id) - (buffer-local-value 'exwm--id entity))) - (setf (slot-value (exwm-cm--xwin->attr entity-xwin) 'entity) entity - (slot-value (exwm-cm--xwin->attr xwin) 'entity) entity) - (let ((tmp (exwm-cm--get-parent entity-xwin))) - (when (/= xwin tmp) - ;; Workspace frame container. - (setf (slot-value (exwm-cm--xwin->attr tmp) 'entity) - entity)))))) - ((and (null containers) - (exwm--id->buffer xwin)) - ;; A leaf but a floating frame container might follow. - (with-current-buffer (exwm--id->buffer xwin) - (when exwm--floating-frame - (push (cons (frame-parameter exwm--floating-frame 'exwm-container) - exwm--floating-frame) - containers)))))))) - -(defun exwm-cm--restack (xwin above-sibling) - "Restack X window XWIN so as to it's exactly on top of ABOVE-SIBLING." - (let ((siblings (exwm-cm--get-siblings xwin)) - node tmp) - (unless (= 1 (length siblings)) - (setq node (assq xwin siblings)) - (if (= above-sibling xcb:Window:None) - ;; Put at bottom. - (unless (eq node (cdr (last siblings))) - (exwm-cm--delq node siblings) - (setcdr (last siblings) (list node)) - ;; Set the return value. - t) - ;; Insert before the sibling. - (setq tmp siblings) - (while (and tmp - (/= above-sibling (caar tmp))) - (setq tmp (cdr tmp))) - (cl-assert tmp) - ;; Check if it's already at the requested position. - (unless (eq tmp (cdr siblings)) - (exwm-cm--delq node siblings) - (exwm-cm--push node tmp) - ;; Set the return value. - t))))) - -(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) - -(defun exwm-cm--paint-tree (tree region &optional force-opaque frame-clip) - "Paint the tree TREE, with REGION specifying the clipping region. - -If FORCE-OPAQUE is non-nil, all X windows painted in this tree is -assumed opaque. FRAME-CLIP specifies the region should be clipped when -painting a frame." - (unless tree - (setq tree (exwm-cm--get-tree exwm--root))) - (let ((root (car tree)) - xwin attr entity current output outputs queue rectangles) - ;; Paint subtrees. - (catch 'break - (dolist (subtree (cdr tree)) - (setq xwin (car subtree) - attr (exwm-cm--xwin->attr xwin)) - (cond - ;; Skip destroyed X windows. - ((null attr)) - ;; Skip InputOnly X windows. - ((= xcb:WindowClass:InputOnly - (slot-value attr 'class))) - ((and (eq root exwm--root) - (frame-live-p (setq entity (slot-value attr 'entity))) - (if (eq entity exwm-workspace--minibuffer) - ;; Skip the minibuffer if the current workspace is - ;; already painted. - (unless (exwm-workspace--minibuffer-attached-p) - current) - ;; Skip lower workspaces on visited RandR output. - ;; If RandR is not enabled, it'll just paint the first. - (memq (setq output (frame-parameter entity - 'exwm-randr-output)) - outputs)))) - ((cdr subtree) - ;; Paint the subtree. - (setq entity (slot-value attr 'entity)) - (let (fullscreen clip) - (cond - ((buffer-live-p entity) - (with-current-buffer entity - ;; Collect frame clip but exclude fullscreen and - ;; floating X windows. - (setq fullscreen (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN - exwm--ewmh-state)) - (when (and (null fullscreen) - ;; In case it's hidden. - (null (exwm-layout--iconic-state-p)) - ;; The buffer of a floating X windows is not - ;; displayed on a workspace frame. - (null exwm--floating-frame) - ;; Opaque regions are always clipped. - (slot-value (exwm-cm--xwin->attr xwin) 'mode)) - ;; Prepare rectangles to clip the workspace frame. - (with-slots (x y width height) (exwm-cm--xwin->attr xwin) - (push (make-instance 'xcb:RECTANGLE - :x x - :y y - :width width - :height height) - rectangles))))) - ((and rectangles - (frame-live-p entity)) - ;; Prepare region to clip the frame. - (setq clip (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region clip - :rectangles rectangles)))) - (setq queue - (nconc (exwm-cm--paint-tree subtree region fullscreen clip) - queue)) - (when clip - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region clip))) - (when fullscreen - ;; Fullscreen X windows are always opaque thus occludes - ;; anything in this workspace. - (throw 'break 'fullscreen))) - (if (not (eq root exwm--root)) - ;; Avoid painting any siblings below the workspace frame - ;; container. - (when (exwm-workspace--workspace-p (slot-value attr 'entity)) - (throw 'break nil)) - ;; Save some status. - (when (and (frame-live-p entity) - (not (eq entity exwm-workspace--minibuffer))) - (push output outputs) - (when (eq entity exwm-workspace--current) - (setq current t))))) - ((and force-opaque - (slot-value attr 'damaged)) - (exwm-cm--paint-opaque xwin region t)) - ((slot-value attr 'damaged) - ;; Paint damaged leaf. - (setq entity (slot-value attr 'entity)) - (when (slot-value attr 'mode) - (push xwin queue)) - (cond - ((buffer-live-p entity) - (with-current-buffer entity - (cl-assert (= xwin exwm--id)) - (when (and exwm--floating-frame - ;; Opaque regions are always clipped. - (slot-value (exwm-cm--xwin->attr xwin) 'mode)) - ;; Prepare rectangles to clip the floating frame. - (with-slots (x y width height) (exwm-cm--xwin->attr xwin) - (push (make-instance 'xcb:RECTANGLE - :x x - :y y - :width width - :height height) - rectangles))))) - ((and frame-clip - (frame-live-p entity)) - ;; Apply frame clip. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:IntersectRegion - :source1 region - :source2 frame-clip - :destination frame-clip)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:SubtractRegion - :source1 region - :source2 frame-clip - :destination region)))) - (exwm-cm--paint-opaque xwin region) - (when (and frame-clip - (frame-live-p entity)) - ;; Restore frame clip. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:UnionRegion - :source1 region - :source2 frame-clip - :destination region))))))) - ;; Return the queue. - queue)) - -(defun exwm-cm--paint-opaque (xwin region &optional force-opaque) - "Paint an X window XWIN clipped by region REGION if XWIN is opaque. - -Also update the attributes of XWIN and clip the region." - (with-slots (x y width height visual mode picture - border-size extents border-clip) - (exwm-cm--xwin->attr xwin) - ;; Prepare the X window picture. - (unless picture - (setf picture (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:CreatePicture - :pid picture - :drawable xwin - :format (xcb:renderutil:find-visual-format - (xcb:renderutil:query-formats exwm-cm--conn) - visual) - :value-mask 0))) - ;; Clear cached resources if clip changed. - (when exwm-cm--clip-changed - (when border-size - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region border-size)) - (setf border-size nil)) - (when extents - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region extents)) - (setf extents nil)) - (when border-clip - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region border-clip)) - (setf border-clip nil))) - ;; Retrieve the border. - (unless border-size - (setf border-size (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegionFromWindow - :region border-size - :window xwin - :kind xcb:shape:SK:Bounding)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:TranslateRegion - :region border-size - :dx x - :dy y))) - ;; Retrieve the extents. - (unless extents - (setf extents (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region extents - :rectangles (list (make-instance 'xcb:RECTANGLE - :x x - :y y - :width width - :height height))))) - (cond - ((and mode - (null force-opaque)) - ;; Calculate clipped border for the transparent X window. - (unless border-clip - (setf border-clip (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region border-clip - :rectangles nil)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CopyRegion - :source region - :destination border-clip)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:IntersectRegion - :source1 border-clip - :source2 border-size - :destination border-clip)))) - (t - ;; Clip & render for the opaque X window. - ;; Set the clip region for the rendering buffer. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:SetPictureClipRegion - :picture exwm-cm--buffer - :region region - :x-origin 0 - :y-origin 0)) - ;; Clip the region with border. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:SubtractRegion - :source1 region - :source2 border-size - :destination region)) - ;; Render the picture to the buffer. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:Composite - :op xcb:render:PictOp:Src - :src picture - :mask xcb:render:Picture:None - :dst exwm-cm--buffer - :src-x 0 - :src-y 0 - :mask-x 0 - :mask-y 0 - :dst-x x - :dst-y y - :width width - :height height)))))) - -(defun exwm-cm--paint-transparent (xwin) - "Paint a transparent X window XWIN." - (with-slots (x y width height opacity picture alpha-picture border-clip) - (exwm-cm--xwin->attr xwin) - ;; Prepare the alpha picture for transparent X windows. - (when (and opacity (null alpha-picture)) - (setf alpha-picture (xcb:generate-id exwm-cm--conn)) - (let ((pixmap (xcb:generate-id exwm-cm--conn))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:CreatePixmap - :depth 8 - :pid pixmap - :drawable exwm--root - :width 1 - :height 1)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:CreatePicture - :pid alpha-picture - :drawable pixmap - :format (xcb:renderutil:find-standard - (xcb:renderutil:query-formats - exwm-cm--conn) - xcb:renderutil:PICT_STANDARD:A_8) - :value-mask xcb:render:CP:Repeat - :repeat 1)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:FreePixmap - :pixmap pixmap)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:FillRectangles - :op xcb:render:PictOp:Src - :dst alpha-picture - :color (make-instance 'xcb:render:COLOR - :red 0 - :green 0 - :blue 0 - :alpha opacity) - :rects (list (make-instance 'xcb:RECTANGLE - :x 0 - :y 0 - :width 1 - :height 1)))))) - ;; Set the clip region for the rendering buffer. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:SetPictureClipRegion - :picture exwm-cm--buffer - :region border-clip - :x-origin 0 - :y-origin 0)) - ;; Render the picture to the buffer. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:Composite - :op xcb:render:PictOp:Over - :src picture - :mask (or alpha-picture xcb:render:Picture:None) - :dst exwm-cm--buffer - :src-x 0 - :src-y 0 - :mask-x 0 - :mask-y 0 - :dst-x x - :dst-y y - :width width - :height height)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region border-clip)) - (setf border-clip nil))) - -(defun exwm-cm--paint (&optional region) - "Paint the whole tree within clipping region REGION. - -If REGION is omitted, `exwm-cm--damages' is assumed. If it's t, paint -the whole screen." - ;; Prepare the clipping region. - (cond - ((null region) - (when exwm-cm--damages - (setq region exwm-cm--damages))) - ((eq region t) - (with-slots (width height) (exwm-cm--xwin->attr exwm--root) - (let ((rect (make-instance 'xcb:RECTANGLE - :x 0 - :y 0 - :width width - :height height))) - (setq region (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region region - :rectangles (list rect))))))) - (when region - ;; Prepare the rendering buffer. - (unless exwm-cm--buffer - (let ((pixmap (xcb:generate-id exwm-cm--conn)) - (picture (xcb:generate-id exwm-cm--conn))) - (setq exwm-cm--buffer picture) - (with-slots (width height visual) (exwm-cm--xwin->attr exwm--root) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:CreatePixmap - :depth exwm-cm--depth - :pid pixmap - :drawable exwm--root - :width width - :height height)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:CreatePicture - :pid picture - :drawable pixmap - :format (xcb:renderutil:find-visual-format - (xcb:renderutil:query-formats - exwm-cm--conn) - visual) - :value-mask 0))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:FreePixmap - :pixmap pixmap)))) - (let (queue) - ;; Paint opaque X windows and update clipping region. - (setq queue (exwm-cm--paint-tree nil region)) - ;; Paint the background. - (exwm-cm--paint-background region) - ;; Paint transparent X windows. - (while queue - (exwm-cm--paint-transparent (pop queue)))) - ;; Submit changes. - (with-slots (width height picture) (exwm-cm--xwin->attr exwm--root) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:SetPictureClipRegion - :picture exwm-cm--buffer - :region xcb:xfixes:Region:None - :x-origin 0 - :y-origin 0)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:Composite - :op xcb:render:PictOp:Src - :src exwm-cm--buffer - :mask xcb:render:Picture:None - :dst picture - :src-x 0 - :src-y 0 - :mask-x 0 - :mask-y 0 - :dst-x 0 - :dst-y 0 - :width width - :height height))) - ;; Cleanup. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region region)) - (when (eq region exwm-cm--damages) - (setq exwm-cm--damages nil)) - (setq exwm-cm--clip-changed nil) - (xcb:flush exwm-cm--conn))) - -(defun exwm-cm--paint-background (region) - "Paint the background." - (unless exwm-cm--background - (setq exwm-cm--background (xcb:generate-id exwm-cm--conn)) - (let (pixmap exist) - (catch 'break - (dolist (atom exwm-cm--background-atoms) - (with-slots (~lsb format value-len value) - (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:GetProperty - :delete 0 - :window exwm--root - :property atom - :type xcb:Atom:PIXMAP - :long-offset 0 - :long-length 4)) - (when (and (= format 32) - (= 1 value-len)) - (setq pixmap (if ~lsb - (xcb:-unpack-u4-lsb value 0) - (xcb:-unpack-u4 value 0))) - (setq exist t) - (throw 'break nil))))) - (unless pixmap - (setq pixmap (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:CreatePixmap - :depth exwm-cm--depth - :pid pixmap - :drawable exwm--root - :width 1 - :height 1))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:CreatePicture - :pid exwm-cm--background - :drawable pixmap - :format (xcb:renderutil:find-visual-format - (xcb:renderutil:query-formats exwm-cm--conn) - (slot-value (exwm-cm--xwin->attr exwm--root) - 'visual)) - :value-mask xcb:render:CP:Repeat - :repeat 1)) - (unless exist - (xcb:+request exwm-cm--conn - (make-instance 'xcb:FreePixmap - :pixmap pixmap)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:FillRectangles - :op xcb:render:PictOp:Src - :dst exwm-cm--background - :color (make-instance 'xcb:render:COLOR - :red #x8080 - :green #x8080 - :blue #x8080 - :alpha #xFFFF) - :rects (list (make-instance 'xcb:RECTANGLE - :x 0 - :y 0 - :width 1 - :height 1))))))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:SetPictureClipRegion - :picture exwm-cm--buffer - :region region - :x-origin 0 - :y-origin 0)) - (with-slots (width height) (exwm-cm--xwin->attr exwm--root) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:Composite - :op xcb:render:PictOp:Src - :src exwm-cm--background - :mask xcb:render:Picture:None - :dst exwm-cm--buffer - :src-x 0 - :src-y 0 - :mask-x 0 - :mask-y 0 - :dst-x 0 - :dst-y 0 - :width width - :height height)))) - -(defun exwm-cm--map-xwin (xwin &optional silent) - "Prepare to map X window XWIN." - (let ((attr (exwm-cm--xwin->attr xwin))) - (setf (slot-value attr 'damaged) nil) - ;; Add to damage. - (when (slot-value attr 'extents) - (let ((damage (xcb:generate-id exwm-cm--conn))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region damage - :rectangles nil)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CopyRegion - :source (slot-value attr 'extents) - :destination damage)) - (exwm-cm--add-damage damage)) - (unless silent - (exwm-cm--paint))))) - -(defun exwm-cm--on-MapNotify (data _synthetic) - "Handle MapNotify events." - (let ((obj (make-instance 'xcb:MapNotify)) - attr) - (xcb:unmarshal obj data) - (with-slots (event window) obj - (exwm--log "(CM) MapNotify: Try to map #x%X" window) - (setq attr (exwm-cm--xwin->attr window)) - (when (and attr - (/= (slot-value attr 'class) xcb:WindowClass:InputOnly) - (or (= event exwm--root) - ;; Filter out duplicated events. - (/= exwm--root (exwm-cm--get-parent window)))) - (exwm--log "(CM) MapNotify: Map") - (exwm-cm--map-xwin window))))) - -(defun exwm-cm--on-UnmapNotify (data _synthetic) - "Handle UnmapNotify events." - (let ((obj (make-instance 'xcb:UnmapNotify)) - attr) - (xcb:unmarshal obj data) - (with-slots (event window) obj - (exwm--log "(CM) UnmapNotify: Try to unmap #x%X" window) - (setq attr (exwm-cm--xwin->attr window)) - (when (and attr - (or (= event exwm--root) - ;; Filter out duplicated events. - (/= exwm--root (exwm-cm--get-parent window)))) - (exwm--log "(CM) UnmapNotify: Unmap") - (with-slots (picture damaged border-size extents border-clip) attr - (setf damaged nil) - (when picture - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:FreePicture - :picture picture)) - (setf picture nil)) - (when border-size - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region border-size)) - (setf border-size nil)) - (when extents - (exwm-cm--add-damage extents) - (setf extents nil)) - (when border-clip - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region border-clip)) - (setf border-clip nil))) - (setq exwm-cm--clip-changed t) - (exwm-cm--paint))))) - -(defun exwm-cm--on-CreateNotify (data _synthetic) - "Handle CreateNotify events." - (let ((obj (make-instance 'xcb:CreateNotify)) - tree0) - (xcb:unmarshal obj data) - (with-slots (window parent x y width height) obj - (exwm--log "(CM) CreateNotify: Create #x%X on #x%X @%sx%s%+d%+d" - window parent width height x y) - (cl-assert (= parent exwm--root)) - (cl-assert (null (exwm-cm--xwin->attr window))) - (setq tree0 (exwm-cm--get-subtree parent)) - (exwm-cm--create-attr window tree0 x y width height) - (if (cdr tree0) - (exwm-cm--push (list window) (cdr tree0)) - (setcdr tree0 `((,window))))))) - -(defun exwm-cm--on-ConfigureNotify (data synthetic) - "Handle ConfigureNotify events." - ;; Ignore synthetic ConfigureNotify events sent by the WM. - (unless synthetic - (let ((obj (make-instance 'xcb:ConfigureNotify))) - (xcb:unmarshal obj data) - (with-slots (event window above-sibling x y width height) obj - (exwm--log - "(CM) ConfigureNotify: Try to configure #x%X @%sx%s%+d%+d, above #x%X" - window width height x y above-sibling) - (cond - ((= window exwm--root) - (exwm--log "(CM) ConfigureNotify: Configure the root X window") - (when exwm-cm--buffer - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:FreePicture - :picture exwm-cm--buffer)) - (setq exwm-cm--buffer nil)) - (with-slots ((x* x) - (y* y) - (width* width) - (height* height)) - (exwm-cm--xwin->attr exwm--root) - (setf x* x - y* y - width* width - height* height)) - (exwm-cm--paint)) - ((null (exwm-cm--xwin->attr window))) - ((or (= event exwm--root) - ;; Filter out duplicated events. - (/= exwm--root (exwm-cm--get-parent window))) - (exwm--log "(CM) ConfigureNotify: Configure") - (with-slots ((x0 x) - (y0 y)) - (exwm-cm--xwin->attr (exwm-cm--get-parent window)) - (exwm-cm--update-geometry window (+ x x0) (+ y y0) width height - above-sibling)) - (setq exwm-cm--clip-changed t) - (exwm-cm--paint)) - (t - (exwm--log "(CM) ConfigureNotify: Skip event from #x%X" event))))))) - -(defun exwm-cm--destroy (xwin) - "Prepare to destroy X window XWIN." - (with-slots (tree picture alpha-picture damage - border-size extents border-clip) - (exwm-cm--xwin->attr xwin) - (cl-assert (assq xwin (cdr tree))) - (if (= 1 (length (cdr tree))) - (setcdr tree nil) - (exwm-cm--assq-delete-all xwin (cdr tree))) - (remhash xwin exwm-cm--hash) - ;; Release resources. - (when picture - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:FreePicture - :picture picture)) - (setf picture nil)) - (when alpha-picture - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:FreePicture - :picture alpha-picture)) - (setf alpha-picture nil)) - (when damage - (xcb:+request exwm-cm--conn - (make-instance 'xcb:damage:Destroy - :damage damage)) - (setf damage nil)) - (when border-size - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region border-size)) - (setf border-size nil)) - (when extents - (exwm-cm--add-damage extents) - (setf extents nil)) - (when border-clip - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region border-clip)) - (setf border-clip nil)))) - -(defun exwm-cm--on-DestroyNotify (data _synthetic) - "Handle DestroyNotify events." - (let ((obj (make-instance 'xcb:DestroyNotify)) - xwin) - (xcb:unmarshal obj data) - (setq xwin (slot-value obj 'window)) - (exwm--log "(CM) DestroyNotify: Try to destroy #x%X" xwin) - (when (exwm-cm--xwin->attr xwin) - (exwm--log "(CM) DestroyNotify: Destroy") - (exwm-cm--destroy xwin)))) - -(defun exwm-cm--on-CirculateNotify (data _synthetic) - "Handle CirculateNotify events." - (let ((obj (make-instance 'xcb:CirculateNotify)) - attr) - (xcb:unmarshal obj data) - (with-slots (event window place) obj - (setq attr (exwm-cm--xwin->attr window)) - (exwm--log "(CM) CirculateNotify: Try to circulate #x%X to %s" - window place) - (when (and attr - (or (= event exwm--root) - ;; Filter out duplicated events. - (/= exwm--root (exwm-cm--get-parent window)))) - (exwm--log "(CM) CirculateNotify: Circulate") - (exwm-cm--update-geometry window nil nil nil nil - (if (= place xcb:Circulate:LowerHighest) - xcb:Window:None - (caar (exwm-cm--get-siblings window)))) - (setq exwm-cm--clip-changed t) - (exwm-cm--paint))))) - -(defun exwm-cm--on-Expose (data _synthetic) - "Handle Expose events." - (let ((obj (make-instance 'xcb:Expose))) - (xcb:unmarshal obj data) - (with-slots (window x y width height count) obj - (when (eq window exwm--root) - (push (make-instance 'xcb:RECTANGLE - :x x - :y y - :width width - :height height) - exwm-cm--expose-rectangles)) - (when (= count 0) - (let ((region (xcb:generate-id exwm-cm--conn))) - (xcb:+request exwm-cm--conn - (xcb:xfixes:CreateRegion - :region region - :rectangles exwm-cm--expose-rectangles)) - (exwm-cm--add-damage region)) - (setq exwm-cm--expose-rectangles nil) - (exwm-cm--paint))))) - -(defun exwm-cm--on-PropertyNotify (data _synthetic) - "Handle PropertyNotify events." - (let ((obj (make-instance 'xcb:PropertyNotify))) - (xcb:unmarshal obj data) - (with-slots (window atom) obj - (cond - ((and (= window exwm--root) - (memq atom exwm-cm--background-atoms)) - (exwm--log "(CM) PropertyNotify: Update background") - (when exwm-cm--background - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:FreePicture - :picture exwm-cm--background)) - (setq exwm-cm--background nil) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:ClearArea - :exposures 1 - :window exwm--root - :x 0 - :y 0 - :width 0 - :height 0)) - (xcb:flush exwm-cm--conn))) - ((and (= atom exwm-cm--_NET_WM_WINDOW_OPACITY) - ;; Some applications also set this property on their parents. - (null (cdr (exwm-cm--get-subtree window)))) - (when (exwm-cm--xwin->attr window) - (exwm--log "(CM) PropertyNotify: Update opacity for #x%X" window) - (exwm-cm--update-opacity window) - (exwm-cm--paint))))))) - -(defun exwm-cm--prepare-container (xwin) - "Make X window XWIN a container by deselecting unnecessary events." - (with-slots (damage) (exwm-cm--xwin->attr xwin) - (when damage - (xcb:+request exwm-cm--conn - (make-instance 'xcb:damage:Destroy - :damage damage))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:shape:SelectInput - :destination-window xwin - :enable 0)))) - -(defun exwm-cm--on-ReparentNotify (data _synthetic) - "Handle ReparentNotify events." - (let ((obj (make-instance 'xcb:ReparentNotify)) - tree tree0 grandparent great-grandparent entity) - (xcb:unmarshal obj data) - (with-slots (window parent x y) obj - (exwm--log "(CM) ReparentNotify: Try to reparent #x%X to #x%X @%+d%+d" - window parent x y) - (cond - ((null (exwm-cm--xwin->attr window)) - (when (eq parent exwm--root) - (exwm--log "(CM) ReparentNotify: Create on the root X window") - (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:GetGeometry - :drawable window)))) - (when reply - (with-slots (width height) reply - (setq tree0 (exwm-cm--get-subtree exwm--root)) - (exwm-cm--create-attr window tree0 x y width height) - (if (cdr tree0) - (exwm-cm--push (list window) (cdr tree0)) - (setcdr tree0 `((,window))))) - (exwm-cm--paint))))) - ((= parent (exwm-cm--get-parent window))) - (t - (unless (exwm-cm--xwin->attr parent) - ;; Only allow workspace frame here. - (setq grandparent - (slot-value (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:QueryTree - :window parent)) - 'parent)) - (cond - ((null (exwm-cm--xwin->attr grandparent)) - (exwm--log "(CM) ReparentNotify: Destroy (too deep)")) - ((and (= exwm--root - (setq great-grandparent (exwm-cm--get-parent grandparent))) - (setq tree0 (exwm-cm--get-subtree grandparent)) - (or (setq entity (exwm--id->buffer window)) - (null (cdr tree0)))) - ;; Reparent a workspace frame or an X window into its - ;; container. - (exwm--debug - (if entity - (exwm--log "(CM) ReparentNotify: \ -Create implicit X window container") - (exwm--log "(CM) ReparentNotify: \ -Create implicit workspace frame container"))) - (unless entity - (setq entity 'workspace-frame)) - (with-slots ((x0 x) - (y0 y)) - (exwm-cm--xwin->attr grandparent) - (with-slots (x y width height) - (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:GetGeometry - :drawable parent)) - (exwm-cm--create-attr parent tree0 - (+ x x0) (+ y y0) width height))) - (if (null (cdr tree0)) - (setcdr tree0 `((,parent))) - ;; The stacking order of the parent is unknown. - (let* ((siblings - (slot-value (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:QueryTree - :window grandparent)) - 'children))) - (cl-assert (memq parent siblings)) - (if (= parent (car siblings)) - ;; At the bottom. - (setcdr (last (cdr tree0)) `((,parent))) - ;; Insert it. - (exwm-cm--push (list parent) - ;; The stacking order is reversed. - (nthcdr (- (length siblings) 1 - (cl-position parent siblings)) - (cdr tree0))))))) - ((and (= exwm--root - (exwm-cm--get-parent great-grandparent)) - (setq tree0 (exwm-cm--get-subtree grandparent)) - (= 1 (length (cdr tree0))) - (exwm--id->buffer (caar (cdr tree0)))) - ;; Reparent a floating frame into its container. - (exwm--log "(CM) ReparentNotify: Create floating frame container") - (setq entity 'floating-frame) - (with-slots ((x0 x) - (y0 y)) - (exwm-cm--xwin->attr grandparent) - (with-slots (x y width height) - (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:GetGeometry - :drawable parent)) - (exwm-cm--create-attr parent tree0 - (+ x x0) (+ y y0) width height))) - (nconc (cdr tree0) `((,parent)))) - (t - (exwm--log "(CM) ReparentNotify: Destroy") - (exwm-cm--destroy window)))) - ;; Ensure there's a valid parent. - (when (exwm-cm--xwin->attr parent) - (exwm--log "(CM) ReparentNotify: Reparent") - (when (null (cdr (exwm-cm--get-subtree parent))) - ;; The parent is a new container. - (exwm-cm--prepare-container parent)) - (setq tree (exwm-cm--get-subtree window)) - (let ((tree (exwm-cm--get-tree window))) - (if (= 1 (length (cdr tree))) - (setcdr tree nil) - (exwm-cm--assq-delete-all window (cdr tree)))) - (setq tree0 (exwm-cm--get-subtree parent)) - (exwm-cm--set-tree window tree0) - ;; The size might have already changed (e.g. when reparenting - ;; a workspace frame). - (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:GetGeometry - :drawable window)))) - ;; The X window might have already been destroyed. - (when reply - (with-slots (width height) reply - (with-slots ((x0 x) - (y0 y)) - (exwm-cm--xwin->attr parent) - (exwm-cm--update-geometry window (+ x x0) (+ y y0) - width height))))) - (when entity - ;; Decide frame entity. - (when (symbolp entity) - (catch 'break - (dolist (f (if (eq entity 'workspace-frame) - exwm-workspace--list - (frame-list))) - (when (eq window (frame-parameter f 'exwm-outer-id)) - (setq entity f) - (throw 'break nil)))) - (when (exwm-workspace--workspace-p entity) - ;; The grandparent is a new workspace container. - (exwm-cm--prepare-container grandparent) - (setf (slot-value (exwm-cm--xwin->attr grandparent) 'entity) - entity))) - (setf (slot-value (exwm-cm--xwin->attr parent) 'entity) entity) - (setf (slot-value (exwm-cm--xwin->attr window) 'entity) entity)) - (if (cdr tree0) - (exwm-cm--push tree (cdr tree0)) - (setcdr tree0 `(,tree))) - (exwm-cm--paint))))))) - -(defun exwm-cm--add-damage (damage) - "Add region DAMAGE to `exwm-cm--damages'." - (if (not exwm-cm--damages) - (setq exwm-cm--damages damage) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:UnionRegion - :source1 exwm-cm--damages - :source2 damage - :destination exwm-cm--damages)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region damage)))) - -(defun exwm-cm--on-DamageNotify (data _synthetic) - "Handle DamageNotify events." - (let ((obj (make-instance 'xcb:damage:Notify)) - parts) - (xcb:unmarshal obj data) - (cl-assert (exwm-cm--xwin->attr (slot-value obj 'drawable))) - (with-slots (x y width height damaged damage) - (exwm-cm--xwin->attr (slot-value obj 'drawable)) - (setq parts (xcb:generate-id exwm-cm--conn)) - (cond - (damaged - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region parts - :rectangles nil)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:damage:Subtract - :damage damage - :repair xcb:xfixes:Region:None - :parts parts)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:TranslateRegion - :region parts - :dx x - :dy y))) - (t - (setf damaged t) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region parts - :rectangles (list (make-instance 'xcb:RECTANGLE - :width width - :height height - :x x - :y y)))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:damage:Subtract - :damage damage - :repair xcb:xfixes:Region:None - :parts xcb:xfixes:Region:None)))) - (exwm-cm--add-damage parts)) - ;; Check if there are more damages immediately followed. - (unless (/= 0 (logand #x80 (slot-value obj 'level))) - (exwm-cm--paint)))) - -(defun exwm-cm--on-ShapeNotify (data _synthetic) - "Handle ShapeNotify events." - (let ((obj (make-instance 'xcb:shape:Notify)) - attr region1 region2) - (xcb:unmarshal obj data) - (with-slots (shape-kind affected-window shaped - extents-x extents-y extents-width extents-height) - obj - (exwm--log "(CM) ShapeNotify: #x%X" affected-window) - (when (and (or (eq shape-kind xcb:shape:SK:Clip) - (eq shape-kind xcb:shape:SK:Bounding)) - (setq attr (exwm-cm--xwin->attr affected-window))) - (with-slots ((shaped* shaped) - x y width height - shape-x shape-y shape-width shape-height) - attr - (setq region1 (xcb:generate-id exwm-cm--conn) - region2 (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region region1 - :rectangles `(,(make-instance 'xcb:RECTANGLE - :width shape-width - :height shape-height - :x shape-x - :y shape-y)))) - (if shaped - (setf shaped* t - shape-x (+ x extents-x) - shape-y (+ y extents-y) - shape-width (+ width extents-width) - shape-height (+ height extents-height)) - (setf shaped* nil - shape-x x - shape-y y - shape-width width - shape-height height)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:CreateRegion - :region region2 - :rectangles `(,(make-instance 'xcb:RECTANGLE - :width shape-width - :height shape-height - :x shape-x - :y shape-y)))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:UnionRegion - :source1 region1 - :source2 region2 - :destination region1)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:xfixes:DestroyRegion - :region region2)) - (setq exwm-cm--clip-changed t) - (exwm-cm--paint region1)))))) - -(defun exwm-cm--init () - "Initialize EXWM compositing manager." - ;; Create a new connection. - (setq exwm-cm--conn (xcb:connect)) - (set-process-query-on-exit-flag (slot-value exwm-cm--conn 'process) nil) - ;; Initialize ICCCM/EWMH support. - (xcb:icccm:init exwm-cm--conn) - (xcb:ewmh:init exwm-cm--conn) - ;; Check for Render extension. - (let ((version (xcb:renderutil:query-version exwm-cm--conn))) - (unless (and version - (= 0 (slot-value version 'major-version)) - (<= 2 (slot-value version 'minor-version))) - (error "[EXWM] The server does not support Render extension"))) - ;; Check for Composite extension. - (when (or (= 0 - (slot-value (xcb:get-extension-data exwm-cm--conn - 'xcb:composite) - 'present)) - (with-slots (major-version minor-version) - (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:composite:QueryVersion - :client-major-version 0 - :client-minor-version 1)) - (or (/= major-version 0) (< minor-version 1)))) - (error "[EXWM] The server does not support Composite extension")) - ;; Check for Damage extension. - (when (or (= 0 (slot-value (xcb:get-extension-data exwm-cm--conn 'xcb:damage) - 'present)) - (with-slots (major-version minor-version) - (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:damage:QueryVersion - :client-major-version 1 - :client-minor-version 1)) - (or (/= major-version 1) (< minor-version 1)))) - (error "[EXWM] The server does not support Damage extension")) - ;; Check for XFixes extension. - (when (or (= 0 (slot-value (xcb:get-extension-data exwm-cm--conn 'xcb:xfixes) - 'present)) - (with-slots (major-version minor-version) - (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:xfixes:QueryVersion - :client-major-version 2 - :client-minor-version 0)) - (or (/= major-version 2) (/= minor-version 0)))) - (error "[EXWM] The server does not support XFixes extension")) - ;; Check for Shape extension. - (when (or (= 0 (slot-value (xcb:get-extension-data exwm-cm--conn 'xcb:shape) - 'present)) - (with-slots (major-version minor-version) - (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:shape:QueryVersion)) - (or (/= major-version 1) (< minor-version 1)))) - (error "[EXWM] The server does not support Shape extension")) - ;; Intern atoms. - (let ((atom-name "_NET_WM_WINDOW_OPACITY")) - (setq exwm-cm--_NET_WM_WINDOW_OPACITY - (slot-value (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:InternAtom - :only-if-exists 0 - :name-len (length atom-name) - :name atom-name)) - 'atom))) - (setq exwm-cm--background-atoms - (mapcar (lambda (atom-name) - (slot-value (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:InternAtom - :only-if-exists 0 - :name-len (length atom-name) - :name atom-name)) - 'atom)) - exwm-cm--background-atom-names)) - ;; Register CM. - (with-slots (owner) - (xcb:+request-unchecked+reply exwm-cm--conn - (make-instance 'xcb:GetSelectionOwner - :selection xcb:Atom:_NET_WM_CM_S0)) - (when (/= owner xcb:Window:None) - (error "[EXWM] Other compositing manager detected"))) - (let ((id (xcb:generate-id exwm-cm--conn))) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:CreateWindow - :depth 0 - :wid id - :parent exwm--root - :x 0 - :y 0 - :width 1 - :height 1 - :border-width 0 - :class xcb:WindowClass:InputOnly - :visual 0 - :value-mask xcb:CW:OverrideRedirect - :override-redirect 1)) - ;; Set _NET_WM_NAME. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:ewmh:set-_NET_WM_NAME - :window id - :data "EXWM-CM")) - ;; Get the selection ownership. - (xcb:+request exwm-cm--conn - (make-instance 'xcb:SetSelectionOwner - :owner id - :selection xcb:Atom:_NET_WM_CM_S0 - :time xcb:Time:CurrentTime))) - ;; Attach event listeners. - (xcb:+event exwm-cm--conn 'xcb:MapNotify #'exwm-cm--on-MapNotify) - (xcb:+event exwm-cm--conn 'xcb:UnmapNotify #'exwm-cm--on-UnmapNotify) - (xcb:+event exwm-cm--conn 'xcb:CreateNotify #'exwm-cm--on-CreateNotify) - (xcb:+event exwm-cm--conn 'xcb:ConfigureNotify #'exwm-cm--on-ConfigureNotify) - (xcb:+event exwm-cm--conn 'xcb:DestroyNotify #'exwm-cm--on-DestroyNotify) - (xcb:+event exwm-cm--conn 'xcb:ReparentNotify #'exwm-cm--on-ReparentNotify) - (xcb:+event exwm-cm--conn 'xcb:CirculateNotify #'exwm-cm--on-CirculateNotify) - (xcb:+event exwm-cm--conn 'xcb:Expose #'exwm-cm--on-Expose) - (xcb:+event exwm-cm--conn 'xcb:PropertyNotify #'exwm-cm--on-PropertyNotify) - (xcb:+event exwm-cm--conn 'xcb:damage:Notify #'exwm-cm--on-DamageNotify) - (xcb:+event exwm-cm--conn 'xcb:shape:Notify #'exwm-cm--on-ShapeNotify) - ;; Scan the window tree. - (setq exwm-cm--hash (make-hash-table)) - (exwm-cm--create-tree) - ;; Set up the root X window. - (setq exwm-cm--depth - (slot-value (car (slot-value (xcb:get-setup exwm-cm--conn) 'roots)) - 'root-depth)) - (with-slots (visual picture) (exwm-cm--xwin->attr exwm--root) - (setf picture (xcb:generate-id exwm-cm--conn)) - (xcb:+request exwm-cm--conn - (make-instance 'xcb:render:CreatePicture - :pid picture - :drawable exwm--root - :format (xcb:renderutil:find-visual-format - (xcb:renderutil:query-formats exwm-cm--conn) - visual) - :value-mask xcb:render:CP:SubwindowMode - :subwindowmode xcb:SubwindowMode:IncludeInferiors))) - (xcb:flush exwm-cm--conn) - ;; Paint once. - (exwm-cm--paint t)) +(make-obsolete-variable 'exwm-cm-opacity + "This variable should no longer be used." "26") -(defun exwm-cm--exit () - "Exit EXWM compositing manager." - (when exwm-cm--conn - (xcb:disconnect exwm-cm--conn) - (clrhash exwm-cm--hash) - (setq exwm-cm--hash nil - exwm-cm--conn nil - exwm-cm--buffer nil - exwm-cm--clip-changed t - exwm-cm--damages nil - exwm-cm--expose-rectangles nil - exwm-cm--background nil))) +(defun exwm-cm-set-opacity (&rest _args) + (declare (obsolete nil "26"))) (defun exwm-cm-enable () - "Enable compositing support for EXWM." - (add-hook 'exwm-init-hook #'exwm-cm--init t) - (add-hook 'exwm-exit-hook #'exwm-cm--exit t)) + (declare (obsolete nil "26"))) -;;;###autoload (defun exwm-cm-start () - "Start EXWM compositing manager." - (interactive) - (unless exwm-cm--conn - (exwm-cm--init))) + (declare (obsolete nil "26"))) -;;;###autoload (defun exwm-cm-stop () - "Stop EXWM compositing manager." - (interactive) - (exwm-cm--exit)) + (declare (obsolete nil "26"))) -;;;###autoload (defun exwm-cm-toggle () - "Toggle the running state of EXWM compositing manager." - (interactive) - (if exwm-cm--conn - (exwm-cm-stop) - (exwm-cm-start))) + (declare (obsolete nil "26"))) diff --git a/exwm-core.el b/exwm-core.el index ec3efc6e5760..4e9a3899e4df 100644 --- a/exwm-core.el +++ b/exwm-core.el @@ -46,6 +46,8 @@ (defvar exwm--connection nil "X connection.") (defvar exwm--root nil "Root window.") (defvar exwm--id-buffer-alist nil "Alist of (<X window ID> . <Emacs buffer>).") +(defvar exwm--guide-window nil + "An X window separating workspaces and X windows.") (defsubst exwm--id->buffer (id) "X window ID => Emacs buffer." @@ -75,6 +77,20 @@ xcb:EventMask:StructureNotify)))) (xcb:flush exwm--connection)) +(defun exwm--set-geometry (xwin x y width height) + "Set the geometry of X window XWIN to WIDTHxHEIGHT+X+Y. + +Nil can be passed as placeholder." + (exwm--log "Setting #x%x to %sx%s+%s+%s" xwin width height x y) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window xwin + :value-mask (logior (if x xcb:ConfigWindow:X 0) + (if y xcb:ConfigWindow:Y 0) + (if width xcb:ConfigWindow:Width 0) + (if height xcb:ConfigWindow:Height 0)) + :x x :y y :width width :height height))) + (defmacro exwm--defer (secs function &rest args) "Defer the execution of FUNCTION. @@ -103,11 +119,10 @@ least SECS seconds later." ;; Internal variables (defvar-local exwm--id nil) ;window ID -(defvar-local exwm--container nil) ;container (defvar-local exwm--frame nil) ;workspace frame (defvar-local exwm--floating-frame nil) ;floating frame (defvar-local exwm--mode-line-format nil) ;save mode-line-format -(defvar-local exwm--floating-frame-position nil) ;used in fullscreen +(defvar-local exwm--floating-frame-position nil) ;set when hidden. (defvar-local exwm--fixed-size nil) ;fixed size (defvar-local exwm--keyboard-grabbed nil) ;Keyboard grabbed. (defvar-local exwm--on-KeyPress ;KeyPress event handler @@ -271,6 +286,7 @@ least SECS seconds later." (push `(executing-kbd-macro . ,exwm--kmacro-map) minor-mode-overriding-map-alist) (setq buffer-read-only t + cursor-type nil left-margin-width nil right-margin-width nil left-fringe-width 0 diff --git a/exwm-floating.el b/exwm-floating.el index a695346cb2c6..b0afc1dad373 100644 --- a/exwm-floating.el +++ b/exwm-floating.el @@ -75,12 +75,11 @@ context of the corresponding buffer.") xcb:Atom:_NET_WM_ACTION_CLOSE))))) (defvar exwm-workspace--current) -(defvar exwm-workspace--struts) (defvar exwm-workspace--workareas) -(defvar exwm-workspace-current-index) (declare-function exwm-layout--refresh "exwm-layout.el" ()) (declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) +(declare-function exwm-layout--hide "exwm-layout.el" (id)) (declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) (declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el") (declare-function exwm-workspace--position "exwm-workspace.el" (frame)) @@ -91,7 +90,8 @@ context of the corresponding buffer.") (when window ;; Hide the non-floating X window first. (set-window-buffer window (other-buffer nil t)))) - (let* ((original-frame exwm-workspace--current) + (let* ((original-frame (buffer-local-value 'exwm--frame + (exwm--id->buffer id))) ;; Create new frame (frame (with-current-buffer (or (get-buffer "*scratch*") @@ -100,16 +100,14 @@ context of the corresponding buffer.") (get-buffer-create "*scratch*")) (get-buffer "*scratch*"))) (make-frame - `((minibuffer . nil) ;use the default minibuffer. - (left . 10000) - (top . 10000) + `((minibuffer . ,(minibuffer-window exwm--frame)) + (left . ,(* window-min-width -100)) + (top . ,(* window-min-height -100)) (width . ,window-min-width) (height . ,window-min-height) (unsplittable . t))))) ;and fix the size later (outer-id (string-to-number (frame-parameter frame 'outer-window-id))) (window-id (string-to-number (frame-parameter frame 'window-id))) - (container (buffer-local-value 'exwm--container - (exwm--id->buffer id))) (frame-container (xcb:generate-id exwm--connection)) (window (frame-first-window frame)) ;and it's the only window (x (slot-value exwm--geometry 'x)) @@ -176,6 +174,8 @@ context of the corresponding buffer.") ;; Put at the center of screen (setq x (/ (- display-width width) 2) y (/ (- display-height height) 2)))))) + (exwm--set-geometry id x y nil nil) + (xcb:flush exwm--connection) (exwm--log "Floating geometry (corrected): %dx%d%+d%+d" width height x y) ;; Fit frame to client ;; It seems we have to make the frame invisible in order to resize it @@ -194,61 +194,55 @@ context of the corresponding buffer.") exwm--mode-line-format mode-line-format mode-line-format nil)) (set-frame-size frame frame-width frame-height t) - ;; Create the frame container as the parent of the frame and - ;; a child of the X window container. + ;; Create the frame container as the parent of the frame. (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 :wid frame-container - :parent container - :x 0 - :y 0 + :parent exwm--root + :x (- x (elt edges 0)) + :y (- y (elt edges 1)) :width width :height height - :border-width 0 + :border-width exwm-floating-border-width :class xcb:WindowClass:InputOutput :visual 0 :value-mask (logior xcb:CW:BackPixmap - xcb:CW:OverrideRedirect) + (if exwm-floating--border-pixel + xcb:CW:BorderPixel 0) + xcb:CW:OverrideRedirect + (if exwm-floating--border-colormap + xcb:CW:Colormap 0)) :background-pixmap xcb:BackPixmap:ParentRelative - :override-redirect 1)) - ;; Put it at bottom. - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window frame-container - :value-mask xcb:ConfigWindow:StackMode - :stack-mode xcb:StackMode:Below)) - ;; Map it. - (xcb:+request exwm--connection - (make-instance 'xcb:MapWindow :window frame-container)) + :border-pixel exwm-floating--border-pixel + :override-redirect 1 + :colormap exwm-floating--border-colormap)) (exwm--debug (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window frame-container :data - (format "floating frame container for 0x%x" id))))) + (format "floating frame container for 0x%x" id)))) + ;; Map it. + (xcb:+request exwm--connection + (make-instance 'xcb:MapWindow :window frame-container)) + ;; Put the X window right above this frame container. + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window id + :value-mask (logior xcb:ConfigWindow:Sibling + xcb:ConfigWindow:StackMode) + :sibling frame-container + :stack-mode xcb:StackMode:Above))) ;; Reparent this frame to its container. (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window outer-id :parent frame-container :x 0 :y 0)) - ;; Place the X window container. - ;; Also show the floating border. - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window container - :value-mask (eval-when-compile - (logior xcb:ConfigWindow:X - xcb:ConfigWindow:Y - xcb:ConfigWindow:BorderWidth)) - :x x - :y y - :border-width 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) (setq window-size-fixed exwm--fixed-size - exwm--frame original-frame exwm--floating-frame frame) ;; Do the refresh manually. (remove-hook 'window-configuration-change-hook #'exwm-layout--refresh) @@ -256,24 +250,19 @@ context of the corresponding buffer.") (add-hook 'window-configuration-change-hook #'exwm-layout--refresh) (set-window-dedicated-p window t) (exwm-layout--show id window)) - (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)) + (with-current-buffer (exwm--id->buffer id) + (if (exwm-layout--iconic-state-p id) + ;; Hide iconic floating X windows. + (exwm-floating-hide) + (with-selected-frame exwm--frame + (exwm-layout--refresh))) (select-frame-set-input-focus frame)) ;; FIXME: Strangely, the Emacs frame can move itself at this point ;; when there are left/top struts set. Force resetting its ;; position seems working, but it'd better to figure out why. ;; FIXME: This also happens in another case (#220) where the cause is ;; still unclear. - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window outer-id - :value-mask (logior xcb:ConfigWindow:X - xcb:ConfigWindow:Y) - :x 0 :y 0)) + (exwm--set-geometry outer-id 0 0 nil nil) (xcb:flush exwm--connection)) (with-current-buffer (exwm--id->buffer id) (run-hooks 'exwm-floating-setup-hook)) @@ -286,10 +275,6 @@ context of the corresponding buffer.") (with-current-buffer buffer (when exwm--floating-frame ;; The X window is already mapped. - ;; Unmap the container to prevent flickering. - (xcb:+request exwm--connection - (make-instance 'xcb:UnmapWindow :window exwm--container)) - (xcb:flush exwm--connection) ;; Unmap the X window. (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes @@ -315,29 +300,30 @@ context of the corresponding buffer.") ;; Also destroy its container. (xcb:+request exwm--connection (make-instance 'xcb:DestroyWindow :window frame-container)))) - ;; Put the X window container just above the Emacs frame container + ;; Place the X window just above the reference X window. ;; (the stacking order won't change from now on). ;; Also hide the possible floating border. (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow - :window exwm--container + :window id :value-mask (logior xcb:ConfigWindow:BorderWidth xcb:ConfigWindow:Sibling xcb:ConfigWindow:StackMode) :border-width 0 - :sibling (frame-parameter exwm-workspace--current - 'exwm-container) + :sibling exwm--guide-window :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 (set-window-dedicated-p (frame-first-window exwm--floating-frame) nil) - (delete-frame exwm--floating-frame))) ;remove the floating frame + ;; Select a tiling window and delete the old frame. + (select-window (frame-selected-window exwm-workspace--current)) + (with-current-buffer buffer + (delete-frame exwm--floating-frame)))) (with-current-buffer buffer (setq window-size-fixed nil - exwm--floating-frame nil - exwm--frame exwm-workspace--current)) + exwm--floating-frame nil)) ;; Only show X windows in normal state. (unless (exwm-layout--iconic-state-p) (pop-to-buffer-same-window buffer))) @@ -361,14 +347,7 @@ context of the corresponding buffer.") (interactive) (when (and (eq major-mode 'exwm-mode) exwm--floating-frame) - ;; Put this floating X window at bottom. - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window exwm--container - :value-mask xcb:ConfigWindow:StackMode - :stack-mode xcb:StackMode:Below)) - (exwm-layout--set-state exwm--id xcb:icccm:WM_STATE:IconicState) - (xcb:flush exwm--connection) + (exwm-layout--hide exwm--id) (select-frame-set-input-focus exwm-workspace--current))) (define-obsolete-function-alias 'exwm-floating-hide-mode-line @@ -387,7 +366,8 @@ context of the corresponding buffer.") ;; Managed. (with-current-buffer buffer-or-id (setq frame exwm--floating-frame - container-or-id exwm--container)) + container-or-id (frame-parameter exwm--floating-frame + 'exwm-container))) ;; Unmanaged. (setq container-or-id id)) (when (and container-or-id @@ -545,96 +525,58 @@ context of the corresponding buffer.") "Stop move/resize." (xcb:+request exwm--connection (make-instance 'xcb:UngrabPointer :time xcb:Time:CurrentTime)) - ;; Inform the X window that its absolute position is changed - (when (and exwm-floating--moveresize-calculate - ;; Unmanaged. - (eq major-mode 'exwm-mode)) - (let ((edges (window-inside-absolute-pixel-edges (frame-selected-window))) - x y width height id) - (setq x (pop edges) - y (pop edges) - width (- (pop edges) x) - height (- (pop edges) y)) - (with-current-buffer (window-buffer (frame-selected-window)) - (setq id exwm--id) - (with-slots ((x* x) - (y* y) - (width* width) - (height* height)) - exwm--geometry - (setf x* x - y* y - width* width - height* height))) - (xcb:+request exwm--connection - (make-instance 'xcb:SendEvent - :propagate 0 - :destination id - :event-mask xcb:EventMask:StructureNotify - :event (xcb:marshal - (make-instance 'xcb:ConfigureNotify - :event id :window id - :above-sibling xcb:Window:None - :x x - :y y - :width width - :height height - :border-width 0 - :override-redirect 0) - exwm--connection))))) - (xcb:flush exwm--connection) - (setq exwm-floating--moveresize-calculate nil)) + (when exwm-floating--moveresize-calculate + (let (result buffer-or-id) + (setq result (funcall exwm-floating--moveresize-calculate 0 0) + buffer-or-id (aref result 0)) + (when (bufferp buffer-or-id) + (with-current-buffer buffer-or-id + (exwm-layout--show exwm--id + (frame-root-window exwm--floating-frame))))) + (setq exwm-floating--moveresize-calculate nil))) (defun exwm-floating--do-moveresize (data _synthetic) "Perform move/resize." (when exwm-floating--moveresize-calculate (let* ((obj (make-instance 'xcb:MotionNotify)) - (workarea (elt exwm-workspace--workareas - exwm-workspace-current-index)) - (frame-x (aref workarea 0)) - (frame-y (aref workarea 1)) - result value-mask width height buffer-or-id container-or-id) + result value-mask x y width height buffer-or-id container-or-id) (xcb:unmarshal obj data) (setq result (funcall exwm-floating--moveresize-calculate (slot-value obj 'root-x) (slot-value obj 'root-y)) - value-mask (logand (aref result 1) - (eval-when-compile - (logior xcb:ConfigWindow:Width - xcb:ConfigWindow:Height))) + buffer-or-id (aref result 0) + value-mask (aref result 1) + x (aref result 2) + y (aref result 3) width (max 1 (aref result 4)) height (max 1 (aref result 5))) - (setq buffer-or-id (aref result 0)) (setq container-or-id (if (bufferp buffer-or-id) ;; Managed. - (buffer-local-value 'exwm--container buffer-or-id) + (with-current-buffer buffer-or-id + (frame-parameter exwm--floating-frame 'exwm-container)) ;; Unmanaged. buffer-or-id)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window container-or-id :value-mask (aref result 1) - :x (- (aref result 2) frame-x) - :y (- (aref result 3) frame-y) + :x x + :y y :width width :height height)) (when (bufferp buffer-or-id) ;; Managed. - (with-current-buffer buffer-or-id - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window (frame-parameter exwm--floating-frame - 'exwm-container) - :value-mask value-mask - :width width - :height height)) - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window (frame-parameter exwm--floating-frame - 'exwm-outer-id) - :value-mask value-mask - :width width - :height height)))) + (setq value-mask (logand value-mask (logior xcb:ConfigWindow:Width + xcb:ConfigWindow:Height))) + (when (/= 0 value-mask) + (with-current-buffer buffer-or-id + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm--floating-frame + 'exwm-outer-id) + :value-mask value-mask + :width width + :height height))))) (xcb:flush exwm--connection)))) (defun exwm-floating-move (&optional delta-x delta-y) @@ -646,37 +588,19 @@ Both DELTA-X and DELTA-Y default to 1. This command should be bound locally." (unless delta-x (setq delta-x 1)) (unless delta-y (setq delta-y 1)) (unless (and (= 0 delta-x) (= 0 delta-y)) - (let* ((geometry (xcb:+request-unchecked+reply exwm--connection + (let* ((floating-container (frame-parameter exwm--floating-frame + 'exwm-container)) + (geometry (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry - :drawable exwm--container))) + :drawable floating-container))) (edges (window-inside-absolute-pixel-edges))) - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window exwm--container - :value-mask (eval-when-compile - (logior xcb:ConfigWindow:X - xcb:ConfigWindow:Y)) - :x (+ (slot-value geometry 'x) delta-x) - :y (+ (slot-value geometry 'y) delta-y))) - ;; Inform the X window that its absolute position is changed - (xcb:+request exwm--connection - (make-instance 'xcb:SendEvent - :propagate 0 :destination exwm--id - :event-mask xcb:EventMask:StructureNotify - :event (xcb:marshal - (make-instance 'xcb:ConfigureNotify - :event exwm--id - :window exwm--id - :above-sibling xcb:Window:None - :x (+ (elt edges 0) delta-x) - :y (+ (elt edges 1) delta-y) - :width (- (elt edges 2) - (elt edges 0)) - :height (- (elt edges 3) - (elt edges 1)) - :border-width 0 - :override-redirect 0) - exwm--connection)))) + (with-slots (x y) geometry + (exwm--set-geometry floating-container + (+ x delta-x) (+ y delta-y) nil nil)) + (exwm--set-geometry exwm--id + (+ (pop edges) delta-x) + (+ (pop edges) delta-y) + nil nil)) (xcb:flush exwm--connection))) (defun exwm-floating--init () diff --git a/exwm-input.el b/exwm-input.el index 54d0540e4646..eaddf6b25268 100644 --- a/exwm-input.el +++ b/exwm-input.el @@ -63,6 +63,8 @@ (defvar exwm-input--simulation-prefix-keys nil "List of prefix keys of simulation keys in line-mode.") +(declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) + (defun exwm-input--set-focus (id) "Set input focus to window ID in a proper way." (when (exwm--id->buffer id) @@ -183,20 +185,6 @@ ARGS are additional arguments to CALLBACK." (let ((exwm-input--global-prefix-keys nil)) (exwm-input--update-global-prefix-keys))) -(defun exwm-input--on-workspace-list-change () - "Run in `exwm-input--update-global-prefix-keys'." - (dolist (f exwm-workspace--list) - ;; Reuse the 'exwm-grabbed' frame parameter set in - ;; `exwm-input--update-global-prefix-keys'. - (unless (frame-parameter f 'exwm-grabbed) - (xcb:+request exwm--connection - (make-instance 'xcb:ChangeWindowAttributes - :window (frame-parameter f 'exwm-workspace) - :value-mask xcb:CW:EventMask - :event-mask xcb:EventMask:FocusChange)))) - (exwm-input--update-global-prefix-keys) - (xcb:flush exwm--connection)) - (declare-function exwm-workspace--client-p "exwm-workspace.el" (&optional frame)) @@ -253,7 +241,6 @@ This value should always be overwritten.") exwm-input--update-focus-window)))) (declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) -(declare-function exwm-layout--set-state "exwm-layout.el" (id state)) (declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el") (declare-function exwm-workspace-switch "exwm-workspace.el" (frame-or-index &optional force)) @@ -276,19 +263,27 @@ This value should always be overwritten.") (set-frame-parameter exwm--frame 'exwm-selected-window window) (exwm--defer 0 #'exwm-workspace-switch exwm--frame)) (exwm--log "Set focus on #x%x" exwm--id) - (exwm-input--set-focus exwm--id) (when exwm--floating-frame - ;; Adjust stacking orders of the floating container. + ;; Adjust stacking orders of the floating X window. (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow - :window exwm--container + :window exwm--id :value-mask xcb:ConfigWindow:StackMode - :stack-mode xcb:StackMode:Above)) + :stack-mode xcb:StackMode:TopIf)) + (xcb:+request exwm--connection + (make-instance 'xcb:ConfigureWindow + :window (frame-parameter exwm--floating-frame + 'exwm-container) + :value-mask (logior + xcb:ConfigWindow:Sibling + xcb:ConfigWindow:StackMode) + :sibling exwm--id + :stack-mode xcb:StackMode:Below)) ;; 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))) + (exwm-layout--show exwm--id window)) + (xcb:flush exwm--connection)) + (exwm-input--set-focus exwm--id)) (when (eq (selected-window) window) (exwm--log "Focus on %s" window) (if (and (exwm-workspace--workspace-p (selected-frame)) @@ -389,51 +384,38 @@ This value should always be overwritten.") "Update `exwm-input--global-prefix-keys'." (when exwm--connection (let ((original exwm-input--global-prefix-keys) - keysym keycode ungrab-key grab-key workspace) + keysym keycode grab-key) (setq exwm-input--global-prefix-keys nil) (dolist (i exwm-input--global-keys) (cl-pushnew (elt i 0) exwm-input--global-prefix-keys)) ;; Stop here if the global prefix keys are update-to-date and ;; there's no new workspace. - (unless (and (equal original exwm-input--global-prefix-keys) - (cl-every (lambda (w) (frame-parameter w 'exwm-grabbed)) - exwm-workspace--list)) - (setq ungrab-key (make-instance 'xcb:UngrabKey - :key xcb:Grab:Any :grab-window nil - :modifiers xcb:ModMask:Any) - grab-key (make-instance 'xcb:GrabKey + (unless (equal original exwm-input--global-prefix-keys) + (setq grab-key (make-instance 'xcb:GrabKey :owner-events 0 - :grab-window nil + :grab-window exwm--root :modifiers nil :key nil :pointer-mode xcb:GrabMode:Async :keyboard-mode xcb:GrabMode:Async)) - (dolist (w exwm-workspace--list) - (setq workspace (frame-parameter w 'exwm-workspace)) - (setf (slot-value ungrab-key 'grab-window) workspace) - (if (xcb:+request-checked+request-check exwm--connection ungrab-key) - (exwm--log "Failed to ungrab keys") - ;; Label this frame. - (set-frame-parameter w 'exwm-grabbed t) - (dolist (k exwm-input--global-prefix-keys) - (setq keysym (xcb:keysyms:event->keysym exwm--connection k) - keycode (xcb:keysyms:keysym->keycode exwm--connection - (car keysym))) - (setf (slot-value grab-key 'grab-window) workspace - (slot-value grab-key 'modifiers) (cdr keysym) - (slot-value grab-key 'key) keycode) - (when (or (= 0 keycode) - (xcb:+request-checked+request-check exwm--connection - grab-key) - ;; Also grab this key with num-lock mask set. - (when (/= 0 xcb:keysyms:num-lock-mask) - (setf (slot-value grab-key 'modifiers) - (logior (cdr keysym) - xcb:keysyms:num-lock-mask)) - (xcb:+request-checked+request-check exwm--connection - grab-key))) - (user-error "[EXWM] Failed to grab key: %s" - (single-key-description k)))))))))) + (dolist (k exwm-input--global-prefix-keys) + (setq keysym (xcb:keysyms:event->keysym exwm--connection k) + keycode (xcb:keysyms:keysym->keycode exwm--connection + (car keysym))) + (setf (slot-value grab-key 'modifiers) (cdr keysym) + (slot-value grab-key 'key) keycode) + (when (or (= 0 keycode) + (xcb:+request-checked+request-check exwm--connection + grab-key) + ;; Also grab this key with num-lock mask set. + (when (/= 0 xcb:keysyms:num-lock-mask) + (setf (slot-value grab-key 'modifiers) + (logior (cdr keysym) + xcb:keysyms:num-lock-mask)) + (xcb:+request-checked+request-check exwm--connection + grab-key))) + (user-error "[EXWM] Failed to grab key: %s" + (single-key-description k)))))))) ;;;###autoload (defun exwm-input-set-key (key command) @@ -808,23 +790,17 @@ Its usage is the same with `exwm-input-set-simulation-keys'." (add-hook 'pre-command-hook #'exwm-input--on-pre-command) (add-hook 'post-command-hook #'exwm-input--on-post-command) ;; Update focus when buffer list updates - (add-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update) - ;; Re-grab global keys. - (add-hook 'exwm-workspace-list-change-hook - #'exwm-input--on-workspace-list-change) - (exwm-input--on-workspace-list-change) - ;; Prevent frame parameters introduced by this module from being - ;; saved/restored. - (dolist (i '(exwm-grabbed)) - (push (cons i :never) frameset-filter-alist))) + (add-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update)) + +(defun exwm-input--post-init () + "The second stage in the initialization of the input module." + (exwm-input--update-global-prefix-keys)) (defun exwm-input--exit () "Exit the input module." (remove-hook 'pre-command-hook #'exwm-input--on-pre-command) (remove-hook 'post-command-hook #'exwm-input--on-post-command) (remove-hook 'buffer-list-update-hook #'exwm-input--on-buffer-list-update) - (remove-hook 'exwm-workspace-list-change-hook - #'exwm-input--on-workspace-list-change) (when exwm-input--update-focus-defer-timer (cancel-timer exwm-input--update-focus-defer-timer)) (when exwm-input--update-focus-timer diff --git a/exwm-layout.el b/exwm-layout.el index bcf9c3a67f52..cda942e47df3 100644 --- a/exwm-layout.el +++ b/exwm-layout.el @@ -30,27 +30,6 @@ (defvar exwm-floating-border-width) (defvar exwm-workspace--id-struts-alist) -(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)))) - (defun exwm-layout--set-state (id state) "Set WM_STATE." (xcb:+request exwm--connection @@ -73,72 +52,24 @@ (y (pop edges)) (width (- (pop edges) x)) (height (- (pop edges) y)) - (edges (window-inside-pixel-edges window)) - (relative-x (pop edges)) - (relative-y (pop edges)) - frame-width frame-height) + frame-x frame-y frame-width frame-height) (with-current-buffer (exwm--id->buffer id) - (if (not exwm--floating-frame) - (exwm-layout--resize-container id exwm--container - relative-x relative-y width height - ;; Keep the size of the X window if - ;; it's the minibuffer that resized. - (and - (active-minibuffer-window) - (< 1 (window-height - (active-minibuffer-window))))) - ;; A floating X window is of the same size as the Emacs window, - ;; whereas its container is of the same size as the Emacs frame. + (when exwm--floating-frame (setq frame-width (frame-pixel-width exwm--floating-frame) frame-height (frame-pixel-height exwm--floating-frame)) - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window exwm--container - :value-mask (logior xcb:ConfigWindow:Width - xcb:ConfigWindow:Height) - :width frame-width - :height frame-height)) - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window (frame-parameter exwm--floating-frame - 'exwm-container) - :value-mask (logior xcb:ConfigWindow:Width - xcb:ConfigWindow:Height) - :width frame-width - :height frame-height)) - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window exwm--id - :value-mask (logior xcb:ConfigWindow:X - xcb:ConfigWindow:Y - xcb:ConfigWindow:Width - xcb:ConfigWindow:Height) - :x relative-x - :y relative-y - :width width - :height height))) - ;; Make the resizing take effect. - (xcb:flush exwm--connection) + (when exwm--floating-frame-position + (setq frame-x (elt exwm--floating-frame-position 0) + frame-y (elt exwm--floating-frame-position 1) + ;; The frame was placed at (-1, -1). + x (+ x frame-x 1) + y (+ y frame-y 1)) + (setq exwm--floating-frame-position nil)) + (exwm--set-geometry (frame-parameter exwm--floating-frame + 'exwm-container) + frame-x frame-y frame-width frame-height)) + (exwm--set-geometry id x y width height) (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window id)) - (xcb:+request exwm--connection - (make-instance 'xcb:MapWindow :window exwm--container)) - (exwm-layout--set-state id xcb:icccm:WM_STATE:NormalState)) - (xcb:+request exwm--connection - (make-instance 'xcb:SendEvent - :propagate 0 :destination id - :event-mask xcb:EventMask:StructureNotify - :event (xcb:marshal - (make-instance 'xcb:ConfigureNotify - :event id - :window id - :above-sibling xcb:Window:None - :x x - :y y - :width width - :height height - :border-width 0 - :override-redirect 0) - exwm--connection)))) + (exwm-layout--set-state id xcb:icccm:WM_STATE:NormalState))) (xcb:flush exwm--connection)) (defun exwm-layout--hide (id) @@ -146,6 +77,15 @@ (with-current-buffer (exwm--id->buffer id) (unless (exwm-layout--iconic-state-p) ;already hidden (exwm--log "Hide #x%x" id) + (when exwm--floating-frame + (let* ((container (frame-parameter exwm--floating-frame + 'exwm-container)) + (geometry (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable container)))) + (setq exwm--floating-frame-position + (vector (slot-value geometry 'x) (slot-value geometry 'y))) + (exwm--set-geometry container -1 -1 1 1))) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window id :value-mask xcb:CW:EventMask @@ -156,8 +96,6 @@ (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)) (exwm-layout--set-state id xcb:icccm:WM_STATE:IconicState) (xcb:flush exwm--connection)))) @@ -167,9 +105,7 @@ (declare-function exwm-input-release-keyboard "exwm-input.el") (declare-function exwm-workspace--current-height "exwm-workspace.el") (declare-function exwm-workspace--current-width "exwm-workspace.el") -(declare-function exwm-workspace--get-geometry "exwm-workspace.el" (frame)) (declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el") -(declare-function exwm-workspace--set-fullscreen "exwm-workspace.el" (frame)) (declare-function exwm-workspace-move-window "exwm-workspace.el" (frame-or-index &optional id)) @@ -180,41 +116,16 @@ (with-current-buffer (if id (exwm--id->buffer id) (window-buffer)) (when (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state) (user-error "Already in full-screen mode")) - ;; Save the position of floating frame. - (when exwm--floating-frame - (let* ((geometry (xcb:+request-unchecked+reply exwm--connection - (make-instance 'xcb:GetGeometry - :drawable exwm--container)))) - (setq exwm--floating-frame-position - (vector (slot-value geometry 'x) (slot-value geometry 'y))))) - ;; Expand the workspace to fill the whole screen. - (with-slots (x y width height) (exwm-workspace--get-geometry exwm--frame) - (exwm-layout--resize-container nil - (frame-parameter exwm--frame - 'exwm-workspace) - x y width height - t)) - ;; Raise the workspace container (in case there are docks). - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window (frame-parameter exwm--frame 'exwm-workspace) - :value-mask xcb:ConfigWindow:StackMode - :stack-mode xcb:StackMode:Above)) - ;; Expand the X window and its container to fill the whole screen. + ;; Expand the X window to fill the whole screen. ;; Rationale: Floating X windows may not be positioned at (0, 0) ;; due to the extra border. - (exwm-layout--resize-container nil exwm--container 0 0 - (exwm-workspace--current-width) - (exwm-workspace--current-height) - t) - (exwm-layout--resize-container nil exwm--id 0 0 - (exwm-workspace--current-width) - (exwm-workspace--current-height) - t) + (exwm--set-geometry exwm--id 0 0 + (exwm-workspace--current-width) + (exwm-workspace--current-height)) ;; Raise the X window. (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow - :window exwm--container + :window exwm--id :value-mask (logior xcb:ConfigWindow:BorderWidth xcb:ConfigWindow:StackMode) :border-width 0 @@ -234,39 +145,20 @@ (with-current-buffer (if id (exwm--id->buffer id) (window-buffer)) (unless (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state) (user-error "Not in full-screen mode")) - ;; Restore the size of this workspace. - (exwm-workspace--set-fullscreen exwm--frame) (if exwm--floating-frame - ;; Restore the floating frame. - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window exwm--container - :value-mask (eval-when-compile - (logior xcb:ConfigWindow:X - xcb:ConfigWindow:Y - xcb:ConfigWindow:BorderWidth)) - :x (elt exwm--floating-frame-position 0) - :y (elt exwm--floating-frame-position 1) - :border-width exwm-floating-border-width)) - ;; Put the X window just above the Emacs frame. + (exwm-layout--show exwm--id (frame-root-window exwm--floating-frame)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow - :window exwm--container + :window exwm--id :value-mask (logior xcb:ConfigWindow:Sibling xcb:ConfigWindow:StackMode) - :sibling (frame-parameter exwm-workspace--current - 'exwm-container) - :stack-mode xcb:StackMode:Above))) - (exwm-layout--show exwm--id) + :sibling exwm--guide-window + :stack-mode xcb:StackMode:Above)) + (let ((window (get-buffer-window nil t))) + (when window + (exwm-layout--show exwm--id window)))) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_STATE :window exwm--id :data [])) - ;; Raise X windows with struts set again. - (dolist (pair exwm-workspace--id-struts-alist) - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window (car pair) - :value-mask xcb:ConfigWindow:StackMode - :stack-mode xcb:StackMode:Above))) (xcb:flush exwm--connection) (setq exwm--ewmh-state (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state)) diff --git a/exwm-manage.el b/exwm-manage.el index 97c9d8e3e202..0a9d92fc024b 100644 --- a/exwm-manage.el +++ b/exwm-manage.el @@ -92,8 +92,6 @@ corresponding buffer.") :window exwm--root :data (vconcat (mapcar #'car exwm--id-buffer-alist))))) -(defvar exwm-floating--border-colormap) -(defvar exwm-floating--border-pixel) (defvar exwm-workspace--current) (defvar exwm-workspace--switch-history-outdated) (defvar exwm-workspace-current-index) @@ -137,7 +135,8 @@ corresponding buffer.") (setq exwm--id-buffer-alist (nconc exwm--id-buffer-alist `((,id . ,(current-buffer))))) (exwm-mode) - (setq exwm--id id) + (setq exwm--id id + exwm--frame exwm-workspace--current) (exwm--update-window-type id) (exwm--update-class id) (exwm--update-transient-for id) @@ -180,38 +179,13 @@ corresponding buffer.") (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window id)) (with-slots (x y width height) exwm--geometry - ;; Reparent to virtual root - (unless (or (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DESKTOP - exwm-window-type) - (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK - exwm-window-type)) - (let ((workspace (frame-parameter exwm-workspace--current - 'exwm-workspace)) - workarea) - (when (and (/= x 0) - (/= y 0)) - (setq workarea (elt exwm-workspace--workareas - exwm-workspace-current-index) - x (- x (aref workarea 0)) - y (- y (aref workarea 1)))) - (xcb:+request exwm--connection - (make-instance 'xcb:ReparentWindow - :window id - :parent workspace - :x x :y y)))) ;; Center window of type _NET_WM_WINDOW_TYPE_SPLASH (when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH exwm-window-type) - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window id - :value-mask (eval-when-compile - (logior xcb:ConfigWindow:X - xcb:ConfigWindow:Y)) - :x (/ (- (exwm-workspace--current-width) width) - 2) - :y (/ (- (exwm-workspace--current-height) - height) - 2))))) + (exwm--set-geometry id + (/ (- (exwm-workspace--current-width) width) 2) + (/ (- (exwm-workspace--current-height) height) + 2) + nil nil))) ;; Check for desktop. (when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DESKTOP exwm-window-type) ;; There should be only one desktop X window. @@ -229,41 +203,6 @@ corresponding buffer.") (throw 'return 'ignored)) ;; Manage the window (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:InputOutput - :visual 0 - :value-mask (logior xcb:CW:BackPixmap - (if exwm-floating--border-pixel - xcb:CW:BorderPixel 0) - xcb:CW:OverrideRedirect - xcb:CW:EventMask - (if exwm-floating--border-colormap - xcb:CW:Colormap 0)) - :background-pixmap xcb:BackPixmap:ParentRelative - :border-pixel exwm-floating--border-pixel - :override-redirect 1 - :event-mask xcb:EventMask:SubstructureRedirect - :colormap exwm-floating--border-colormap)) - (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 (make-instance 'xcb:ConfigureWindow :window id :value-mask xcb:ConfigWindow:BorderWidth @@ -340,12 +279,6 @@ manager is shutting down." (exwm-workspace--set-fullscreen f))) (when (buffer-live-p buffer) (with-current-buffer buffer - ;; Flickering seems unavoidable here if the DestroyWindow request is - ;; not initiated by us. - ;; What we can do is to hide the its container ASAP. - (xcb:+request exwm--connection - (make-instance 'xcb:UnmapWindow :window exwm--container)) - (xcb:flush exwm--connection) ;; Unmap the X window. (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window id)) @@ -353,30 +286,10 @@ manager is shutting down." (setq exwm-workspace--switch-history-outdated t) ;; (when withdraw-only - ;; Reparent back to root (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window id :value-mask xcb:CW:EventMask :event-mask xcb:EventMask:NoEvent)) - (let (x y geometry geometry-parent) - (if (not exwm--floating-frame) - (setq x 0 y 0) ;the position does not matter - (setq geometry-parent - (xcb:+request-unchecked+reply exwm--connection - (make-instance 'xcb:GetGeometry - :drawable exwm--container)) - geometry (xcb:+request-unchecked+reply exwm--connection - (make-instance 'xcb:GetGeometry - :drawable id))) - (if (not (and geometry-parent geometry)) - (setq x 0 y 0) ;e.g. have been destroyed - (setq x (+ (slot-value geometry-parent 'x) - (slot-value geometry 'x)) - y (+ (slot-value geometry-parent 'y) - (slot-value geometry 'y))))) - (xcb:+request exwm--connection - (make-instance 'xcb:ReparentWindow - :window id :parent exwm--root :x x :y y))) ;; Delete WM_STATE property (xcb:+request exwm--connection (make-instance 'xcb:DeleteProperty @@ -388,19 +301,20 @@ manager is shutting down." :window id :property xcb:Atom:_NET_WM_DESKTOP)))) (when exwm--floating-frame - ;; Unmap the floating frame before destroying the containers. - (let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id))) + ;; Unmap the floating frame before destroying its container. + (let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id)) + (container (frame-parameter exwm--floating-frame + 'exwm-container))) (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window window)) (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow - :window window :parent exwm--root :x 0 :y 0)))) + :window window :parent exwm--root :x 0 :y 0)) + (xcb:+request exwm--connection + (make-instance 'xcb:DestroyWindow :window container)))) ;; Restore the workspace if this X window is currently fullscreen. (when (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state) (exwm-workspace--set-fullscreen exwm--frame)) - ;; Destroy the X window container (and the frame container if any). - (xcb:+request exwm--connection - (make-instance 'xcb:DestroyWindow :window exwm--container)) (exwm-manage--set-client-list) (xcb:flush exwm--connection)) (let ((kill-buffer-func @@ -444,38 +358,28 @@ manager is shutting down." "Run in `kill-buffer-query-functions'." (catch 'return (when (or (not exwm--id) - (not exwm--container) (xcb:+request-checked+request-check exwm--connection (make-instance 'xcb:MapWindow :window exwm--id))) ;; The X window is no longer alive so just close the buffer. - ;; Destroy the container. - ;; Hide the container to prevent flickering. - (when exwm--container - (xcb:+request exwm--connection - (make-instance 'xcb:UnmapWindow - :window exwm--container)) - (xcb:flush exwm--connection)) (when exwm--floating-frame - (let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id))) + (let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id)) + (container (frame-parameter exwm--floating-frame + 'exwm-container))) (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window window)) (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window window :parent exwm--root - :x 0 :y 0)))) - (when exwm--container - (xcb:+request exwm--connection - (make-instance 'xcb:DestroyWindow - :window exwm--container))) + :x 0 :y 0)) + (xcb:+request exwm--connection + (make-instance 'xcb:DestroyWindow + :window container)))) (xcb:flush exwm--connection) (throw 'return t)) (unless (memq xcb:Atom:WM_DELETE_WINDOW exwm--protocols) ;; The X window does not support WM_DELETE_WINDOW; destroy it. - ;; Hide the container to prevent flickering. - (xcb:+request exwm--connection - (make-instance 'xcb:UnmapWindow :window exwm--container)) (xcb:+request exwm--connection (make-instance 'xcb:DestroyWindow :window exwm--id)) (xcb:flush exwm--connection) @@ -529,13 +433,6 @@ Would you like to kill it? " (defun exwm-manage--kill-client (&optional id) "Kill an X client." (unless id (setq id (exwm--buffer->id (current-buffer)))) - ;; Hide the container to prevent flickering. - (let ((buffer (exwm--id->buffer id))) - (when buffer - (with-current-buffer buffer - (xcb:+request exwm--connection - (make-instance 'xcb:UnmapWindow :window exwm--container)) - (xcb:flush exwm--connection)))) (let* ((response (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:ewmh:get-_NET_WM_PID :window id))) (pid (and response (slot-value response 'value))) diff --git a/exwm-randr.el b/exwm-randr.el index 07a000c3b3ff..74938d6b71e1 100644 --- a/exwm-randr.el +++ b/exwm-randr.el @@ -164,7 +164,7 @@ (add-hook 'exwm-workspace-list-change-hook #'exwm-randr--refresh)))) ;; Prevent frame parameters introduced by this module from being ;; saved/restored. - (dolist (i '(exwm-randr-output exwm-geometry)) + (dolist (i '(exwm-randr-output)) (push (cons i :never) frameset-filter-alist))) (defun exwm-randr--exit () diff --git a/exwm-workspace.el b/exwm-workspace.el index 0aabbefcdda2..2917c6910b6a 100644 --- a/exwm-workspace.el +++ b/exwm-workspace.el @@ -321,16 +321,12 @@ Value nil means to use the default position which is fixed at bottom, while (defvar exwm-workspace--fullscreen-frame-count 0 "Count the fullscreen workspace frames.") -(declare-function exwm-layout--resize-container "exwm-layout.el" - (id container x y width height &optional container-only)) - (defun exwm-workspace--set-fullscreen (frame) "Make frame FRAME fullscreen according to `exwm-workspace--workareas'." (let ((workarea (elt exwm-workspace--workareas (exwm-workspace--position frame))) (id (frame-parameter frame 'exwm-outer-id)) (container (frame-parameter frame 'exwm-container)) - (workspace (frame-parameter frame 'exwm-workspace)) x y width height) (setq x (aref workarea 0) y (aref workarea 1) @@ -339,8 +335,8 @@ Value nil means to use the default position which is fixed at bottom, while (when (and (eq frame exwm-workspace--current) (exwm-workspace--minibuffer-own-frame-p)) (exwm-workspace--resize-minibuffer-frame)) - (exwm-layout--resize-container id container 0 0 width height) - (exwm-layout--resize-container nil workspace x y width height t) + (exwm--set-geometry container x y width height) + (exwm--set-geometry id nil nil width height) (xcb:flush exwm--connection)) ;; This is only used for workspace initialization. (when exwm-workspace--fullscreen-frame-count @@ -457,26 +453,18 @@ The optional FORCE option is for internal use only." (let* ((frame (exwm-workspace--workspace-from-frame-or-index frame-or-index)) (old-frame exwm-workspace--current) (index (exwm-workspace--position frame)) - (workspace (frame-parameter frame 'exwm-workspace)) (window (frame-parameter frame 'exwm-selected-window))) (when (or force (not (eq frame exwm-workspace--current))) (unless (window-live-p window) (setq window (frame-selected-window frame))) - ;; Raise the workspace container. + ;; Raise this frame. (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow - :window workspace - :value-mask xcb:ConfigWindow:StackMode - :stack-mode xcb:StackMode:Above)) - ;; Raise X windows with struts set if there's no fullscreen X window. - (unless (with-current-buffer (window-buffer window) - (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state)) - (dolist (pair exwm-workspace--id-struts-alist) - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window (car pair) - :value-mask xcb:ConfigWindow:StackMode - :stack-mode xcb:StackMode:Above)))) + :window (frame-parameter frame 'exwm-container) + :value-mask (logior xcb:ConfigWindow:Sibling + xcb:ConfigWindow:StackMode) + :sibling exwm--guide-window + :stack-mode xcb:StackMode:Below)) (setq exwm-workspace--current frame exwm-workspace-current-index index) (unless (exwm-workspace--workspace-p (selected-frame)) @@ -497,6 +485,15 @@ The optional FORCE option is for internal use only." (exwm-workspace--resize-minibuffer-frame) ;; Set a default minibuffer frame. (setq default-minibuffer-frame frame)) + ;; Show/Hide X windows. + (dolist (i exwm--id-buffer-alist) + (with-current-buffer (cdr i) + (if (eq old-frame exwm--frame) + (exwm-layout--hide exwm--id) + (when (eq frame exwm--frame) + (let ((window (get-buffer-window nil t))) + (when window + (exwm-layout--show exwm--id window))))))) ;; Hide windows in other workspaces by preprending a space (unless exwm-workspace-show-all-buffers (dolist (i exwm--id-buffer-alist) @@ -538,7 +535,7 @@ each time.") (exwm-workspace--count))))) (make-frame)) (run-hooks 'exwm-workspace-list-change-hook)) - (exwm-workspace-switch (car (last exwm-workspace--list))))) + (exwm-workspace-switch frame-or-index))) (defvar exwm-workspace-list-change-hook nil "Normal hook run when the workspace list is changed (workspace added, @@ -662,7 +659,8 @@ INDEX must not exceed the current number of workspaces." (let ((exwm-workspace--prompt-add-allowed t) (exwm-workspace--prompt-delete-allowed t)) (exwm-workspace--prompt-for-workspace "Move to [+/-]: ")))) - (let ((frame (exwm-workspace--workspace-from-frame-or-index frame-or-index))) + (let ((frame (exwm-workspace--workspace-from-frame-or-index frame-or-index)) + old-frame container) (unless id (setq id (exwm--buffer->id (window-buffer)))) (with-current-buffer (exwm--id->buffer id) (unless (eq exwm--frame frame) @@ -672,112 +670,111 @@ INDEX must not exceed the current number of workspaces." (if (eq frame exwm-workspace--current) name (concat " " name))))) - (setq exwm--frame frame) - (if exwm--floating-frame - ;; Move the floating container. - (with-slots (x y) - (xcb:+request-unchecked+reply exwm--connection - (make-instance 'xcb:GetGeometry :drawable exwm--container)) + (setq old-frame exwm--frame + exwm--frame frame) + (if (not exwm--floating-frame) + ;; Tiling. + (progn + (set-window-buffer (get-buffer-window nil t) + (other-buffer nil t)) + (unless (eq frame exwm-workspace--current) + ;; Clear the 'exwm-selected-window' frame parameter. + (set-frame-parameter frame 'exwm-selected-window nil)) + (set-window-buffer (frame-selected-window frame) + (exwm--id->buffer id)) + (if (eq frame exwm-workspace--current) + (select-window (frame-selected-window frame)) + (exwm-layout--hide id))) + ;; Floating. + (setq container (frame-parameter exwm--floating-frame + 'exwm-container)) + (with-slots ((x1 x) + (y1 y)) + (exwm-workspace--get-geometry old-frame) + (with-slots ((x2 x) + (y2 y)) + (exwm-workspace--get-geometry frame) + (unless (and (= x1 x2) + (= y1 y2)) + (with-slots (x y) + (xcb:+request-unchecked+reply exwm--connection + (make-instance 'xcb:GetGeometry + :drawable container)) + (setq x (+ x (- x2 x1)) + y (+ y (- y2 y1))) + (exwm--set-geometry id x y nil nil) + (exwm--set-geometry container x y nil nil))))) + (if (exwm-workspace--minibuffer-own-frame-p) + (if (eq frame exwm-workspace--current) + (select-window (frame-root-window exwm--floating-frame)) + (select-window (frame-selected-window exwm-workspace--current)) + (exwm-layout--hide id)) + ;; The frame needs to be recreated since it won't use the + ;; minibuffer on the new workspace. + ;; The code is mostly copied from `exwm-floating--set-floating'. + (let* ((old-frame exwm--floating-frame) + (new-frame + (with-current-buffer + (or (get-buffer "*scratch*") + (progn + (set-buffer-major-mode + (get-buffer-create "*scratch*")) + (get-buffer "*scratch*"))) + (make-frame + `((minibuffer . ,(minibuffer-window frame)) + (left . ,(* window-min-width -100)) + (top . ,(* window-min-height -100)) + (width . ,window-min-width) + (height . ,window-min-height) + (unsplittable . t))))) + (outer-id (string-to-number + (frame-parameter new-frame + 'outer-window-id))) + (window-id (string-to-number + (frame-parameter new-frame 'window-id))) + (window (frame-root-window new-frame))) + (set-frame-parameter new-frame 'exwm-outer-id outer-id) + (set-frame-parameter new-frame 'exwm-id window-id) + (set-frame-parameter new-frame 'exwm-container container) + (make-frame-invisible new-frame) + (set-frame-size new-frame + (frame-pixel-width old-frame) + (frame-pixel-height old-frame) + t) (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow - :window exwm--container - :parent - (frame-parameter frame 'exwm-workspace) - :x x :y y)) + :window outer-id + :parent container + :x 0 :y 0)) + (xcb:flush exwm--connection) + (with-current-buffer (exwm--id->buffer id) + (setq window-size-fixed nil + exwm--floating-frame new-frame) + (set-window-dedicated-p (frame-root-window old-frame) nil) + (remove-hook 'window-configuration-change-hook + #'exwm-layout--refresh) + (set-window-buffer window (current-buffer)) + (add-hook 'window-configuration-change-hook + #'exwm-layout--refresh) + (set-window-dedicated-p window t)) + ;; Select a tiling window and delete the old frame. + (select-window (frame-selected-window exwm-workspace--current)) + (delete-frame old-frame) + ;; The rest is the same. + (make-frame-visible new-frame) + (exwm--set-geometry outer-id 0 0 nil nil) (xcb:flush exwm--connection) - (if (exwm-workspace--minibuffer-own-frame-p) - (when (eq frame exwm-workspace--current) - (select-frame-set-input-focus exwm--floating-frame) - (exwm-layout--refresh)) - ;; The frame needs to be recreated since it won't use the - ;; minibuffer on the new workspace. - (let* ((old-frame exwm--floating-frame) - (new-frame - (with-current-buffer - (or (get-buffer "*scratch*") - (progn - (set-buffer-major-mode - (get-buffer-create "*scratch*")) - (get-buffer "*scratch*"))) - (make-frame - `((minibuffer . ,(minibuffer-window frame)) - (left . 10000) - (top . 10000) - (width . ,window-min-width) - (height . ,window-min-height) - (unsplittable . t))))) - (outer-id (string-to-number - (frame-parameter new-frame - 'outer-window-id))) - (window-id (string-to-number - (frame-parameter new-frame 'window-id))) - (frame-container (frame-parameter old-frame - 'exwm-container)) - (window (frame-root-window new-frame))) - (set-frame-parameter new-frame 'exwm-outer-id outer-id) - (set-frame-parameter new-frame 'exwm-id window-id) - (set-frame-parameter new-frame 'exwm-container - frame-container) - (make-frame-invisible new-frame) - (set-frame-size new-frame - (frame-pixel-width old-frame) - (frame-pixel-height old-frame) - t) - (xcb:+request exwm--connection - (make-instance 'xcb:ReparentWindow - :window outer-id - :parent frame-container - :x 0 :y 0)) - (xcb:flush exwm--connection) + (redisplay) + (if (eq frame exwm-workspace--current) (with-current-buffer (exwm--id->buffer id) - (setq window-size-fixed nil - exwm--frame frame - exwm--floating-frame new-frame) - (set-window-dedicated-p (frame-root-window old-frame) nil) - (remove-hook 'window-configuration-change-hook - #'exwm-layout--refresh) - (set-window-buffer window (current-buffer)) - (add-hook 'window-configuration-change-hook - #'exwm-layout--refresh) - (delete-frame old-frame) - (set-window-dedicated-p window t) - (exwm-layout--show id window)) - (if (not (eq frame exwm-workspace--current)) - (make-frame-visible new-frame) - (select-frame-set-input-focus new-frame) - (redisplay)))) - ;; Update the 'exwm-selected-window' frame parameter. - (when (not (eq frame exwm-workspace--current)) - (with-current-buffer (exwm--id->buffer id) - (set-frame-parameter frame 'exwm-selected-window - (frame-root-window - exwm--floating-frame))))) - ;; Move the X window container. - (set-window-buffer (get-buffer-window (current-buffer) t) - (other-buffer nil t)) - (unless (eq frame exwm-workspace--current) - ;; Clear the 'exwm-selected-window' frame parameter. - (set-frame-parameter frame 'exwm-selected-window nil)) - (exwm-layout--hide id) - ;; (current-buffer) is changed. - (with-current-buffer (exwm--id->buffer id) - ;; Reparent to the destination workspace. - (xcb:+request exwm--connection - (make-instance 'xcb:ReparentWindow - :window exwm--container - :parent (frame-parameter frame 'exwm-workspace) - :x 0 :y 0)) - ;; Place it just above the destination frame container. - (xcb:+request exwm--connection - (make-instance 'xcb:ConfigureWindow - :window exwm--container - :value-mask (logior xcb:ConfigWindow:Sibling - xcb:ConfigWindow:StackMode) - :sibling (frame-parameter frame 'exwm-container) - :stack-mode xcb:StackMode:Above))) - (xcb:flush exwm--connection) - (set-window-buffer (frame-selected-window frame) - (exwm--id->buffer id))) + (select-window (frame-root-window exwm--floating-frame))) + (exwm-layout--hide id)))) + ;; Update the 'exwm-selected-window' frame parameter. + (when (not (eq frame exwm-workspace--current)) + (with-current-buffer (exwm--id->buffer id) + (set-frame-parameter frame 'exwm-selected-window + (frame-root-window + exwm--floating-frame))))) ;; Set _NET_WM_DESKTOP. (exwm-workspace--set-desktop id) (xcb:flush exwm--connection))) @@ -1005,16 +1002,7 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." 'exwm-container) :value-mask xcb:ConfigWindow:StackMode :stack-mode xcb:StackMode:Above)) - (xcb:flush exwm--connection) - ;; Unfortunately we need the following lines to workaround a cursor - ;; flickering issue for line-mode floating X windows. They just make the - ;; minibuffer appear to be focused. - ;; (FIXED?) - ;; (with-current-buffer (window-buffer (minibuffer-window - ;; exwm-workspace--minibuffer)) - ;; (setq cursor-in-non-selected-windows - ;; (frame-parameter exwm-workspace--minibuffer 'cursor-type))) - ) + (xcb:flush exwm--connection)) (defun exwm-workspace--hide-minibuffer () "Hide the minibuffer frame." @@ -1198,13 +1186,11 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (let ((outer-id (string-to-number (frame-parameter frame 'outer-window-id))) (window-id (string-to-number (frame-parameter frame 'window-id))) - (container (xcb:generate-id exwm--connection)) - (workspace (xcb:generate-id exwm--connection))) + (container (xcb:generate-id exwm--connection))) ;; Save window IDs (set-frame-parameter frame 'exwm-outer-id outer-id) (set-frame-parameter frame 'exwm-id window-id) (set-frame-parameter frame 'exwm-container container) - (set-frame-parameter frame 'exwm-workspace workspace) ;; In case it's created by emacsclient. (set-frame-parameter frame 'client nil) ;; Copy RandR frame parameters from the first workspace to @@ -1217,51 +1203,27 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 - :wid workspace + :wid container :parent exwm--root - :x 0 - :y 0 - :width (x-display-pixel-width) - :height (x-display-pixel-height) + :x -1 + :y -1 + :width 1 + :height 1 :border-width 0 :class xcb:WindowClass:InputOutput :visual 0 :value-mask (logior xcb:CW:BackPixmap - xcb:CW:OverrideRedirect - xcb:CW:EventMask) + xcb:CW:OverrideRedirect) :background-pixmap xcb:BackPixmap:ParentRelative - :override-redirect 1 - :event-mask xcb:EventMask:SubstructureRedirect)) + :override-redirect 1)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow - :window workspace + :window container :value-mask xcb:ConfigWindow:StackMode :stack-mode xcb:StackMode:Below)) - (xcb:+request exwm--connection - (make-instance 'xcb:CreateWindow - :depth 0 - :wid container - :parent workspace - :x 0 - :y 0 - :width (x-display-pixel-width) - :height (x-display-pixel-height) - :border-width 0 - :class xcb:WindowClass:InputOutput - :visual 0 - :value-mask (logior xcb:CW:BackPixmap - xcb:CW:OverrideRedirect) - :background-pixmap xcb:BackPixmap:ParentRelative - :override-redirect 1)) (exwm--debug (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME - :window workspace - :data - (format "EXWM workspace %d" - (exwm-workspace--position frame)))) - (xcb:+request exwm--connection - (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window container :data (format "EXWM workspace %d frame container" @@ -1270,9 +1232,7 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." (make-instance 'xcb:ReparentWindow :window outer-id :parent container :x 0 :y 0)) (xcb:+request exwm--connection - (make-instance 'xcb:MapWindow :window container)) - (xcb:+request exwm--connection - (make-instance 'xcb:MapWindow :window workspace))) + (make-instance 'xcb:MapWindow :window container))) (xcb:flush exwm--connection) ;; Delay making the workspace fullscreen until Emacs becomes idle (exwm--defer 0 #'set-frame-parameter frame 'fullscreen 'fullboth) @@ -1323,10 +1283,10 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." :parent exwm--root :x 0 :y 0)) - ;; Destroy the containers. + ;; Destroy the container. (xcb:+request exwm--connection (make-instance 'xcb:DestroyWindow - :window (frame-parameter frame 'exwm-workspace))) + :window (frame-parameter frame 'exwm-container))) ;; Update EWMH properties. (exwm-workspace--update-ewmh-props) ;; Update switch history. @@ -1343,15 +1303,7 @@ Please check `exwm-workspace--minibuffer-own-frame-p' first." ;; Set _NET_DESKTOP_GEOMETRY. (exwm-workspace--set-desktop-geometry) ;; Update workareas. - (exwm-workspace--update-workareas) - ;; Set _NET_VIRTUAL_ROOTS. - (xcb:+request exwm--connection - (make-instance 'xcb:ewmh:set-_NET_VIRTUAL_ROOTS - :window exwm--root - :data (vconcat (mapcar - (lambda (i) - (frame-parameter i 'exwm-workspace)) - exwm-workspace--list))))) + (exwm-workspace--update-workareas)) (xcb:flush exwm--connection)) (defun exwm-workspace--modify-all-x-frames-parameters (new-x-parameters) @@ -1505,7 +1457,7 @@ applied to all subsequently created X frames." (exwm-workspace-switch 0 t) ;; Prevent frame parameters introduced by this module from being ;; saved/restored. - (dolist (i '(exwm-outer-id exwm-id exwm-container exwm-workspace + (dolist (i '(exwm-outer-id exwm-id exwm-container exwm-geometry fullscreen exwm-selected-window exwm-urgency)) (push (cons i :never) frameset-filter-alist))) diff --git a/exwm.el b/exwm.el index 3c0124672b49..02e9152ed0e6 100644 --- a/exwm.el +++ b/exwm.el @@ -36,7 +36,6 @@ ;; + Dynamic workspace support ;; + ICCCM/EWMH compliance ;; + (Optional) RandR (multi-monitor) support -;; + (Optional) Built-in compositing manager ;; + (Optional) Built-in system tray ;; Installation & configuration @@ -509,7 +508,7 @@ xcb:Atom:_NET_ACTIVE_WINDOW ;; xcb:Atom:_NET_WORKAREA xcb:Atom:_NET_SUPPORTING_WM_CHECK - xcb:Atom:_NET_VIRTUAL_ROOTS + ;; xcb:Atom:_NET_VIRTUAL_ROOTS ;; xcb:Atom:_NET_DESKTOP_LAYOUT ;; xcb:Atom:_NET_SHOWING_DESKTOP @@ -593,13 +592,14 @@ xcb:Atom:_NET_WM_FULL_PLACEMENT))) ;; Create a child window for setting _NET_SUPPORTING_WM_CHECK (let ((new-id (xcb:generate-id exwm--connection))) + (setq exwm--guide-window new-id) (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 :wid new-id :parent exwm--root - :x 0 - :y 0 + :x -1 + :y -1 :width 1 :height 1 :border-width 0 @@ -636,7 +636,6 @@ xcb:Atom:_NET_CURRENT_DESKTOP xcb:Atom:_NET_ACTIVE_WINDOW xcb:Atom:_NET_SUPPORTING_WM_CHECK - xcb:Atom:_NET_VIRTUAL_ROOTS ;; TODO: Keep this list synchronized with that in ;; `exwm--init-icccm-ewmh'. )) @@ -688,6 +687,7 @@ (exwm-input--init) (exwm--unlock) (exwm-workspace--post-init) + (exwm-input--post-init) ;; Manage existing windows (exwm-manage--scan) (run-hooks 'exwm-init-hook))))) |