;;; exwm-floating.el --- Floating Module for EXWM -*- lexical-binding: t -*- ;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Chris Feng ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This module deals with the conversion between floating and non-floating ;; states and implements moving/resizing operations on floating windows. ;;; Code: (require 'xcb-cursor) (require 'exwm-core) (defgroup exwm-floating nil "Floating." :group 'exwm) (defcustom exwm-floating-setup-hook nil "Normal hook run when an X window has been made floating. This hook runs in the context of the corresponding buffer." :type 'hook) (defcustom exwm-floating-exit-hook nil "Normal hook run when an X window has exited floating state. This hook runs in the context of the corresponding buffer." :type 'hook) (defcustom exwm-floating-border-color "navy" "Border color of floating windows." :type 'color :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) ;; Change border color for all floating X windows. (when exwm--connection (let ((border-pixel (exwm--color->pixel value))) (when border-pixel (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (when exwm--floating-frame (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window (frame-parameter exwm--floating-frame 'exwm-container) :value-mask xcb:CW:BorderPixel :border-pixel border-pixel))))) (xcb:flush exwm--connection)))))) (defcustom exwm-floating-border-width 1 "Border width of floating windows." :type `(integer :validate ,(lambda (widget) (when (< (widget-value widget) 0) (widget-put widget :error "Border width is at least 0") widget))) :initialize #'custom-initialize-default :set (lambda (symbol value) (let ((delta (- value exwm-floating-border-width)) container) (set-default symbol value) ;; Change border width for all floating X windows. (dolist (pair exwm--id-buffer-alist) (with-current-buffer (cdr pair) (when exwm--floating-frame (setq container (frame-parameter exwm--floating-frame 'exwm-container)) (with-slots (x y) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable container)) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window container :value-mask (logior xcb:ConfigWindow:X xcb:ConfigWindow:Y xcb:ConfigWindow:BorderWidth) :border-width value :x (- x delta) :y (- y delta))))))) (when exwm--connection (xcb:flush exwm--connection))))) ;; Cursors for moving/resizing a window (defvar exwm-floating--cursor-move nil) (defvar exwm-floating--cursor-top-left nil) (defvar exwm-floating--cursor-top nil) (defvar exwm-floating--cursor-top-right nil) (defvar exwm-floating--cursor-right nil) (defvar exwm-floating--cursor-bottom-right nil) (defvar exwm-floating--cursor-bottom nil) (defvar exwm-floating--cursor-bottom-left nil) (defvar exwm-floating--cursor-left nil) (defvar exwm-floating--moveresize-calculate nil "Calculate move/resize parameters [buffer event-mask x y width height].") (defvar exwm-workspace--current) (defvar exwm-workspace--frame-y-offset) (defvar exwm-workspace--window-y-offset) (declare-function exwm-layout--hide "exwm-layout.el" (id)) (declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id)) (declare-function exwm-layout--refresh "exwm-layout.el" ()) (declare-function exwm-layout--show "exwm-layout.el" (id &optional window)) (declare-function exwm-workspace--position "exwm-workspace.el" (frame)) (declare-function exwm-workspace--update-offsets "exwm-workspace.el" ()) (declare-function exwm-workspace--workarea "exwm-workspace.el" (frame)) (defun exwm-floating--set-allowed-actions (id tiled-p) "Set _NET_WM_ALLOWED_ACTIONS for window with ID. If TILED-P is non-nil, set actions for tiled window." (exwm--log "#x%x" id) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_ALLOWED_ACTIONS :window id :data (if tiled-p (vector xcb:Atom:_NET_WM_ACTION_MINIMIZE xcb:Atom:_NET_WM_ACTION_FULLSCREEN xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP xcb:Atom:_NET_WM_ACTION_CLOSE) (vector xcb:Atom:_NET_WM_ACTION_MOVE xcb:Atom:_NET_WM_ACTION_RESIZE xcb:Atom:_NET_WM_ACTION_MINIMIZE xcb:Atom:_NET_WM_ACTION_FULLSCREEN xcb:Atom:_NET_WM_ACTION_CHANGE_DESKTOP xcb:Atom:_NET_WM_ACTION_CLOSE))))) (defun exwm-floating--set-floating (id) "Make window ID floating." (let ((window (get-buffer-window (exwm--id->buffer id)))) (when window ;; Hide the non-floating X window first. (set-window-buffer window (other-buffer nil t)))) (let* ((original-frame (buffer-local-value 'exwm--frame (exwm--id->buffer id))) ;; Create new frame (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 exwm--frame)) (tab-bar-lines . 0) (tab-bar-lines-keep-state . t) (left . ,(* window-min-width -10000)) (top . ,(* window-min-height -10000)) (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))) (frame-container (xcb:generate-id exwm--connection)) (window (frame-first-window frame)) ;and it's the only window (x (slot-value exwm--geometry 'x)) (y (slot-value exwm--geometry 'y)) (width (slot-value exwm--geometry 'width)) (height (slot-value exwm--geometry 'height))) ;; Force drawing menu-bar & tool-bar. (redisplay t) (exwm-workspace--update-offsets) (exwm--log "Floating geometry (original): %dx%d%+d%+d" width height x y) ;; Save frame parameters. (set-frame-parameter frame 'exwm-outer-id outer-id) (set-frame-parameter frame 'exwm-id window-id) (set-frame-parameter frame 'exwm-container frame-container) ;; Fix illegal parameters ;; FIXME: check normal hints restrictions (with-slots ((x* x) (y* y) (width* width) (height* height)) (exwm-workspace--workarea original-frame) ;; Center floating windows (when (and (or (= x 0) (= x x*)) (or (= y 0) (= y y*))) (let ((buffer (exwm--id->buffer exwm-transient-for)) window edges) (when (and buffer (setq window (get-buffer-window buffer))) (setq edges (window-inside-absolute-pixel-edges window)) (unless (and (<= width (- (elt edges 2) (elt edges 0))) (<= height (- (elt edges 3) (elt edges 1)))) (setq edges nil))) (if edges ;; Put at the center of leading window (setq x (+ x* (/ (- (elt edges 2) (elt edges 0) width) 2)) y (+ y* (/ (- (elt edges 3) (elt edges 1) height) 2))) ;; Put at the center of screen (setq x (/ (- width* width) 2) y (/ (- height* height) 2))))) (if (> width width*) ;; Too wide (progn (setq x x* width width*)) ;; Invalid width (when (= 0 width) (setq width (/ width* 2))) ;; Make sure at least half of the window is visible (unless (< x* (+ x (/ width 2)) (+ x* width*)) (setq x (+ x* (/ (- width* width) 2))))) (if (> height height*) ;; Too tall (setq y y* height height*) ;; Invalid height (when (= 0 height) (setq height (/ height* 2))) ;; Make sure at least half of the window is visible (unless (< y* (+ y (/ height 2)) (+ y* height*)) (setq y (+ y* (/ (- height* height) 2))))) ;; The geometry can be overridden by user options. (let ((x** (plist-get exwm--configurations 'x)) (y** (plist-get exwm--configurations 'y)) (width** (plist-get exwm--configurations 'width)) (height** (plist-get exwm--configurations 'height))) (if (integerp x**) (setq x (+ x* x**)) (when (and (floatp x**) (>= 1 x** 0)) (setq x (+ x* (round (* x** width*)))))) (if (integerp y**) (setq y (+ y* y**)) (when (and (floatp y**) (>= 1 y** 0)) (setq y (+ y* (round (* y** height*)))))) (if (integerp width**) (setq width width**) (when (and (floatp width**) (> 1 width** 0)) (setq width (max 1 (round (* width** width*)))))) (if (integerp height**) (setq height height**) (when (and (floatp height**) (> 1 height** 0)) (setq height (max 1 (round (* height** height*)))))))) (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 ;; timely. ;; The frame will be made visible by `select-frame-set-input-focus'. (make-frame-invisible frame) (let* ((edges (window-inside-pixel-edges window)) (frame-width (+ width (- (frame-pixel-width frame) (- (elt edges 2) (elt edges 0))))) (frame-height (+ height (- (frame-pixel-height frame) (- (elt edges 3) (elt edges 1))) ;; Use `frame-outer-height' in the future. exwm-workspace--frame-y-offset)) (floating-mode-line (plist-get exwm--configurations 'floating-mode-line)) (floating-header-line (plist-get exwm--configurations 'floating-header-line)) (border-pixel (exwm--color->pixel exwm-floating-border-color))) (if floating-mode-line (setq exwm--mode-line-format (or exwm--mode-line-format mode-line-format) mode-line-format floating-mode-line) (if (and (not (plist-member exwm--configurations 'floating-mode-line)) exwm--mwm-hints-decorations) (when exwm--mode-line-format (setq mode-line-format exwm--mode-line-format)) ;; The mode-line need to be hidden in floating mode. (setq frame-height (- frame-height (window-mode-line-height (frame-root-window frame))) exwm--mode-line-format (or exwm--mode-line-format mode-line-format) mode-line-format nil))) (if floating-header-line (setq header-line-format floating-header-line) (if (and (not (plist-member exwm--configurations 'floating-header-line)) exwm--mwm-hints-decorations) (setq header-line-format nil) ;; The header-line need to be hidden in floating mode. (setq frame-height (- frame-height (window-header-line-height (frame-root-window frame))) header-line-format nil))) (set-frame-size frame frame-width frame-height t) ;; Create the frame container as the parent of the frame. (xcb:+request exwm--connection (make-instance 'xcb:CreateWindow :depth 0 :wid frame-container :parent exwm--root :x x :y (- y exwm-workspace--window-y-offset) :width width :height height :border-width (with-current-buffer (exwm--id->buffer id) (let ((border-witdh (plist-get exwm--configurations 'border-width))) (if (and (integerp border-witdh) (>= border-witdh 0)) border-witdh exwm-floating-border-width))) :class xcb:WindowClass:InputOutput :visual 0 :value-mask (logior xcb:CW:BackPixmap (if border-pixel xcb:CW:BorderPixel 0) xcb:CW:OverrideRedirect) :background-pixmap xcb:BackPixmap:ParentRelative :border-pixel border-pixel :override-redirect 1)) (xcb:+request exwm--connection (make-instance 'xcb:ewmh:set-_NET_WM_NAME :window frame-container :data (format "EXWM 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)) (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--floating-frame frame) ;; Do the refresh manually. (remove-hook 'window-configuration-change-hook #'exwm-layout--refresh) (set-window-buffer window (current-buffer)) ;this changes current buffer (add-hook 'window-configuration-change-hook #'exwm-layout--refresh) (set-window-dedicated-p window t) (exwm-layout--show id window)) (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. (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)) ;; Redraw the frame. (redisplay t)) (defun exwm-floating--unset-floating (id) "Make window ID non-floating." (exwm--log "#x%x" id) (let ((buffer (exwm--id->buffer id))) (with-current-buffer buffer (when exwm--floating-frame ;; The X window is already mapped. ;; Unmap the X window. (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window id :value-mask xcb:CW:EventMask :event-mask xcb:EventMask:NoEvent)) (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window id)) (xcb:+request exwm--connection (make-instance 'xcb:ChangeWindowAttributes :window id :value-mask xcb:CW:EventMask :event-mask (exwm--get-client-event-mask))) ;; Reparent the floating frame back to the root window. (let ((frame-id (frame-parameter exwm--floating-frame 'exwm-outer-id)) (frame-container (frame-parameter exwm--floating-frame 'exwm-container))) (xcb:+request exwm--connection (make-instance 'xcb:UnmapWindow :window frame-id)) (xcb:+request exwm--connection (make-instance 'xcb:ReparentWindow :window frame-id :parent exwm--root :x 0 :y 0)) ;; Also destroy its container. (xcb:+request exwm--connection (make-instance 'xcb:DestroyWindow :window 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 id :value-mask (logior xcb:ConfigWindow:BorderWidth xcb:ConfigWindow:Sibling xcb:ConfigWindow:StackMode) :border-width 0 :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) ;; 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) (if (not (plist-member exwm--configurations 'tiling-mode-line)) (when exwm--mode-line-format (setq mode-line-format exwm--mode-line-format)) (setq exwm--mode-line-format (or exwm--mode-line-format mode-line-format) mode-line-format (plist-get exwm--configurations 'tiling-mode-line))) (if (not (plist-member exwm--configurations 'tiling-header-line)) (setq header-line-format nil) (setq header-line-format (plist-get exwm--configurations 'tiling-header-line)))) ;; Only show X windows in normal state. (unless (exwm-layout--iconic-state-p) (pop-to-buffer-same-window buffer))) (with-current-buffer (exwm--id->buffer id) (run-hooks 'exwm-floating-exit-hook))) ;;;###autoload (cl-defun exwm-floating-toggle-floating () "Toggle the current window between floating and non-floating states." (interactive) (exwm--log) (unless (derived-mode-p 'exwm-mode) (cl-return-from exwm-floating-toggle-floating)) (with-current-buffer (window-buffer) (if exwm--floating-frame (exwm-floating--unset-floating exwm--id) (exwm-floating--set-floating exwm--id)))) ;;;###autoload (defun exwm-floating-hide () "Hide the current floating X window (which would show again when selected)." (interactive) (exwm--log) (when (and (derived-mode-p 'exwm-mode) exwm--floating-frame) (exwm-layout--hide exwm--id) (select-frame-set-input-focus exwm-workspace--current))) (defun exwm-floating--start-moveresize (id &optional type) "Start move/resize for window with ID. When non-nil, TYPE indicates the type of move/resize. Float resizing is stopped when TYPE is nil." (exwm--log "#x%x" id) (let ((buffer-or-id (or (exwm--id->buffer id) id)) frame container-or-id x y width height cursor) (if (bufferp buffer-or-id) ;; Managed. (with-current-buffer buffer-or-id (setq frame exwm--floating-frame container-or-id (frame-parameter exwm--floating-frame 'exwm-container))) ;; Unmanaged. (setq container-or-id id)) (when (and container-or-id ;; Test if the pointer can be grabbed (= xcb:GrabStatus:Success (slot-value (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GrabPointer :owner-events 0 :grab-window container-or-id :event-mask xcb:EventMask:NoEvent :pointer-mode xcb:GrabMode:Async :keyboard-mode xcb:GrabMode:Async :confine-to xcb:Window:None :cursor xcb:Cursor:None :time xcb:Time:CurrentTime)) 'status))) (with-slots (root-x root-y win-x win-y) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:QueryPointer :window id)) (if (not (bufferp buffer-or-id)) ;; Unmanaged. (unless (eq type xcb:ewmh:_NET_WM_MOVERESIZE_MOVE) (with-slots ((width* width) (height* height)) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable id)) (setq width width* height height*))) ;; Managed. (select-window (frame-first-window frame)) ;transfer input focus (setq width (frame-pixel-width frame) height (frame-pixel-height frame)) (unless type ;; Determine the resize type according to the pointer position ;; Clicking the center 1/3 part to resize has no effect (setq x (/ (* 3 win-x) (float width)) y (/ (* 3 win-y) (float height)) type (cond ((and (< x 1) (< y 1)) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT) ((and (> x 2) (< y 1)) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT) ((and (> x 2) (> y 2)) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT) ((and (< x 1) (> y 2)) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT) ((> x 2) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT) ((> y 2) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM) ((< x 1) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT) ((< y 1) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP))))) (if (not type) (exwm-floating--stop-moveresize) (cond ((= type xcb:ewmh:_NET_WM_MOVERESIZE_MOVE) (setq cursor exwm-floating--cursor-move exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:X xcb:ConfigWindow:Y)) (- x win-x) (- y win-y) 0 0)))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT) (setq cursor exwm-floating--cursor-top-left exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:X xcb:ConfigWindow:Y xcb:ConfigWindow:Width xcb:ConfigWindow:Height)) (- x win-x) (- y win-y) (- (+ root-x width) x) (- (+ root-y height) y))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP) (setq cursor exwm-floating--cursor-top exwm-floating--moveresize-calculate (lambda (_x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height)) 0 (- y win-y) 0 (- (+ root-y height) y))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT) (setq cursor exwm-floating--cursor-top-right exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Width xcb:ConfigWindow:Height)) 0 (- y win-y) (- x (- root-x width)) (- (+ root-y height) y))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT) (setq cursor exwm-floating--cursor-right exwm-floating--moveresize-calculate (lambda (x _y) (vector buffer-or-id xcb:ConfigWindow:Width 0 0 (- x (- root-x width)) 0)))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT) (setq cursor exwm-floating--cursor-bottom-right exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:Width xcb:ConfigWindow:Height)) 0 0 (- x (- root-x width)) (- y (- root-y height)))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM) (setq cursor exwm-floating--cursor-bottom exwm-floating--moveresize-calculate (lambda (_x y) (vector buffer-or-id xcb:ConfigWindow:Height 0 0 0 (- y (- root-y height)))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT) (setq cursor exwm-floating--cursor-bottom-left exwm-floating--moveresize-calculate (lambda (x y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:X xcb:ConfigWindow:Width xcb:ConfigWindow:Height)) (- x win-x) 0 (- (+ root-x width) x) (- y (- root-y height)))))) ((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT) (setq cursor exwm-floating--cursor-left exwm-floating--moveresize-calculate (lambda (x _y) (vector buffer-or-id (eval-when-compile (logior xcb:ConfigWindow:X xcb:ConfigWindow:Width)) (- x win-x) 0 (- (+ root-x width) x) 0))))) ;; Select events and change cursor (should always succeed) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GrabPointer :owner-events 0 :grab-window container-or-id :event-mask (eval-when-compile (logior xcb:EventMask:ButtonRelease xcb:EventMask:ButtonMotion)) :pointer-mode xcb:GrabMode:Async :keyboard-mode xcb:GrabMode:Async :confine-to xcb:Window:None :cursor cursor :time xcb:Time:CurrentTime))))))) (defun exwm-floating--stop-moveresize (&rest _args) "Stop move/resize." (exwm--log) (xcb:+request exwm--connection (make-instance 'xcb:UngrabPointer :time xcb:Time:CurrentTime)) (when exwm-floating--moveresize-calculate (let (result buffer-or-id outer-id container-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 (setq outer-id (frame-parameter exwm--floating-frame 'exwm-outer-id) container-id (frame-parameter exwm--floating-frame 'exwm-container)) (with-slots (x y width height border-width) (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable container-id)) ;; Notify Emacs frame about this the position change. (xcb:+request exwm--connection (make-instance 'xcb:SendEvent :propagate 0 :destination outer-id :event-mask xcb:EventMask:StructureNotify :event (xcb:marshal (make-instance 'xcb:ConfigureNotify :event outer-id :window outer-id :above-sibling xcb:Window:None :x (+ x border-width) :y (+ y border-width) :width width :height height :border-width 0 :override-redirect 0) exwm--connection))) (xcb:flush exwm--connection)) (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 on floating window with DATA." (when exwm-floating--moveresize-calculate (let* ((obj (make-instance 'xcb:MotionNotify)) 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)) 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))) (if (not (bufferp buffer-or-id)) ;; Unmanaged. (setq container-or-id buffer-or-id) ;; Managed. (setq container-or-id (with-current-buffer buffer-or-id (frame-parameter exwm--floating-frame 'exwm-container)) x (- x exwm-floating-border-width) ;; Use `frame-outer-height' in the future. y (- y exwm-floating-border-width exwm-workspace--window-y-offset) height (+ height exwm-workspace--window-y-offset))) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window container-or-id :value-mask (aref result 1) :x x :y y :width width :height height)) (when (bufferp buffer-or-id) ;; Managed. (with-current-buffer buffer-or-id (let ((resize-value-mask (logand value-mask (logior xcb:ConfigWindow:Width xcb:ConfigWindow:Height))) (move-value-mask (logand value-mask (logior xcb:ConfigWindow:X xcb:ConfigWindow:Y)))) (when (/= 0 resize-value-mask) (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))) (when (/= 0 move-value-mask) (xcb:+request exwm--connection (make-instance 'xcb:ConfigureWindow :window exwm--id :value-mask value-mask :x (+ x exwm-floating-border-width) :y (+ y exwm-floating-border-width))))))) (xcb:flush exwm--connection)))) (defun exwm-floating-move (&optional delta-x delta-y) "Move a floating window right by DELTA-X pixels and down by DELTA-Y pixels. Both DELTA-X and DELTA-Y default to 1. This command should be bound locally." (exwm--log "delta-x: %s, delta-y: %s" delta-x delta-y) (unless (and (derived-mode-p 'exwm-mode) exwm--floating-frame) (user-error "[EXWM] `exwm-floating-move' is only for floating X windows")) (unless delta-x (setq delta-x 1)) (unless delta-y (setq delta-y 1)) (unless (and (= 0 delta-x) (= 0 delta-y)) (let* ((floating-container (frame-parameter exwm--floating-frame 'exwm-container)) (geometry (xcb:+request-unchecked+reply exwm--connection (make-instance 'xcb:GetGeometry :drawable floating-container))) (edges (window-inside-absolute-pixel-edges))) (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 () "Initialize floating module." (exwm--log) ;; Initialize cursors for moving/resizing a window (xcb:cursor:init exwm--connection) (setq exwm-floating--cursor-move (xcb:cursor:load-cursor exwm--connection "fleur") exwm-floating--cursor-top-left (xcb:cursor:load-cursor exwm--connection "top_left_corner") exwm-floating--cursor-top (xcb:cursor:load-cursor exwm--connection "top_side") exwm-floating--cursor-top-right (xcb:cursor:load-cursor exwm--connection "top_right_corner") exwm-floating--cursor-right (xcb:cursor:load-cursor exwm--connection "right_side") exwm-floating--cursor-bottom-right (xcb:cursor:load-cursor exwm--connection "bottom_right_corner") exwm-floating--cursor-bottom (xcb:cursor:load-cursor exwm--connection "bottom_side") exwm-floating--cursor-bottom-left (xcb:cursor:load-cursor exwm--connection "bottom_left_corner") exwm-floating--cursor-left (xcb:cursor:load-cursor exwm--connection "left_side"))) (defun exwm-floating--exit () "Exit the floating module." (exwm--log)) (provide 'exwm-floating) ;;; exwm-floating.el ends here