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 /exwm-cm.el | |
| 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.
Diffstat (limited to 'exwm-cm.el')
| -rw-r--r-- | exwm-cm.el | 1756 |
1 files changed, 9 insertions, 1747 deletions
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"))) |