diff options
Diffstat (limited to 'third_party/emacs/exwm/exwm-floating.el')
| -rw-r--r-- | third_party/emacs/exwm/exwm-floating.el | 783 |
1 files changed, 0 insertions, 783 deletions
diff --git a/third_party/emacs/exwm/exwm-floating.el b/third_party/emacs/exwm/exwm-floating.el deleted file mode 100644 index d1882cf74615..000000000000 --- a/third_party/emacs/exwm/exwm-floating.el +++ /dev/null @@ -1,783 +0,0 @@ -;;; exwm-floating.el --- Floating Module for EXWM -*- lexical-binding: t -*- - -;; Copyright (C) 2015-2020 Free Software Foundation, Inc. - -;; Author: Chris Feng <chris.w.feng@gmail.com> - -;; 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 <http://www.gnu.org/licenses/>. - -;;; 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." - :version "25.3" - :group 'exwm) - -(defcustom exwm-floating-setup-hook nil - "Normal hook run when an X window has been made floating, 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, 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) -(defvar exwm-workspace--workareas) -(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" ()) - -(defun exwm-floating--set-allowed-actions (id tilling) - "Set _NET_WM_ALLOWED_ACTIONS." - (exwm--log "#x%x" id) - (xcb:+request exwm--connection - (make-instance 'xcb:ewmh:set-_NET_WM_ALLOWED_ACTIONS - :window id - :data (if tilling - (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)) - (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 - (let* ((workarea (elt exwm-workspace--workareas - (exwm-workspace--position original-frame))) - (x* (aref workarea 0)) - (y* (aref workarea 1)) - (width* (aref workarea 2)) - (height* (aref workarea 3))) - ;; 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." - (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." - (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. - (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) - "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 |