diff options
| -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))))) |