2015-07-17 13:16:08 +02:00
|
|
|
|
;;; exwm-floating.el --- Floating Module for EXWM -*- lexical-binding: t -*-
|
|
|
|
|
|
2016-02-02 15:33:58 +01:00
|
|
|
|
;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
;; Author: Chris Feng <chris.w.feng@gmail.com>
|
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
;; This file is part of GNU Emacs.
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; 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.
|
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; 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
|
2015-09-04 03:09:59 +02:00
|
|
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
;;; 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)
|
2015-09-04 03:09:59 +02:00
|
|
|
|
(require 'exwm-core)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
(defvar exwm-floating-border-width 1 "Border width of the floating window.")
|
2015-10-28 07:04:41 +01:00
|
|
|
|
(defvar exwm-floating-border-color "navy"
|
2015-07-17 13:16:08 +02:00
|
|
|
|
"Border color of the floating window.")
|
|
|
|
|
|
2015-08-16 13:00:42 +02:00
|
|
|
|
(defvar exwm-floating-setup-hook nil
|
|
|
|
|
"Normal hook run when a window has been made floating.")
|
|
|
|
|
(defvar exwm-floating-exit-hook nil
|
|
|
|
|
"Normal hook run when a window has exited floating state.")
|
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
;; 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)
|
|
|
|
|
|
2016-02-19 10:12:43 +01:00
|
|
|
|
(defvar exwm-workspace--current)
|
|
|
|
|
(defvar exwm-workspace--list)
|
|
|
|
|
(defvar exwm-workspace-current-index)
|
|
|
|
|
(defvar exwm-workspace--switch-history-outdated)
|
|
|
|
|
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(declare-function exwm-layout--refresh "exwm-layout.el")
|
2016-02-19 10:12:43 +01:00
|
|
|
|
(declare-function exwm-layout--show "exwm-layout.el")
|
2016-02-18 12:56:01 +01:00
|
|
|
|
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(defun exwm-floating--set-floating (id)
|
|
|
|
|
"Make window ID floating."
|
2015-08-13 06:02:44 +02:00
|
|
|
|
(let ((window (get-buffer-window (exwm--id->buffer id))))
|
|
|
|
|
(when window ;window in non-floating state
|
|
|
|
|
(set-window-buffer window (other-buffer)))) ;hide it first
|
2016-02-21 09:39:34 +01:00
|
|
|
|
(let* ((original-frame exwm-workspace--current)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; Create new frame
|
2015-09-16 15:32:38 +02:00
|
|
|
|
(frame (with-current-buffer
|
|
|
|
|
(or (get-buffer "*scratch*")
|
2015-10-26 05:38:20 +01:00
|
|
|
|
(progn
|
|
|
|
|
(set-buffer-major-mode
|
|
|
|
|
(get-buffer-create "*scratch*"))
|
|
|
|
|
(get-buffer "*scratch*")))
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(make-frame
|
2016-02-21 09:39:34 +01:00
|
|
|
|
`((minibuffer . nil) ;use the default minibuffer.
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(background-color . ,exwm-floating-border-color)
|
|
|
|
|
(internal-border-width . ,exwm-floating-border-width)
|
|
|
|
|
(left . 10000)
|
|
|
|
|
(top . 10000)
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(width . ,window-min-width)
|
|
|
|
|
(height . ,window-min-height)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(unsplittable . t))))) ;and fix the size later
|
2015-09-04 03:09:59 +02:00
|
|
|
|
(outer-id (string-to-number (frame-parameter frame 'outer-window-id)))
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(container (with-current-buffer (exwm--id->buffer id)
|
2016-02-19 10:12:43 +01:00
|
|
|
|
exwm--container))
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(frame-container (xcb:generate-id exwm--connection))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(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))
|
2015-10-01 03:30:14 +02:00
|
|
|
|
(height (slot-value exwm--geometry 'height))
|
|
|
|
|
(frame-geometry (frame-parameter original-frame 'exwm-geometry)))
|
|
|
|
|
(exwm--log "Floating geometry (original, absolute): %dx%d%+d%+d"
|
|
|
|
|
width height x y)
|
|
|
|
|
(when frame-geometry
|
|
|
|
|
(setq x (- x (slot-value frame-geometry 'x))
|
|
|
|
|
y (- y (slot-value frame-geometry 'y))))
|
|
|
|
|
(exwm--log "Floating geometry (original, relative): %dx%d%+d%+d"
|
|
|
|
|
width height x y)
|
2016-02-20 14:52:07 +01:00
|
|
|
|
;; Save frame parameters.
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(set-frame-parameter frame 'exwm-outer-id outer-id)
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(set-frame-parameter frame 'exwm-container frame-container)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; Fix illegal parameters
|
|
|
|
|
;; FIXME: check normal hints restrictions
|
2015-08-13 06:02:44 +02:00
|
|
|
|
(let* ((display-width (frame-pixel-width original-frame))
|
|
|
|
|
(display-height (- (frame-pixel-height original-frame)
|
2016-02-21 13:19:45 +01:00
|
|
|
|
(if (exwm-workspace--minibuffer-own-frame-p)
|
2016-02-06 05:59:33 +01:00
|
|
|
|
0
|
|
|
|
|
(window-pixel-height (minibuffer-window
|
|
|
|
|
original-frame)))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(* 2 (window-mode-line-height))
|
|
|
|
|
(window-header-line-height window)
|
|
|
|
|
(* 2 exwm-floating-border-width)))
|
|
|
|
|
(display-height (* 2 (/ display-height 2)))) ;round to even
|
|
|
|
|
(if (> width display-width)
|
|
|
|
|
;; Too wide
|
|
|
|
|
(progn (setq x 0
|
|
|
|
|
width display-width))
|
|
|
|
|
;; Invalid width
|
|
|
|
|
(when (= 0 width) (setq width (/ display-width 2)))
|
2015-08-27 05:03:27 +02:00
|
|
|
|
;; Make sure at least half of the window is visible
|
|
|
|
|
(when (or (> (+ x (/ width 2)) display-width) (> 0 (+ x (/ width 2))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(setq x (/ (- display-width width) 2))))
|
|
|
|
|
(if (> height display-height)
|
|
|
|
|
;; Too tall
|
|
|
|
|
(setq y 0
|
|
|
|
|
height display-height)
|
|
|
|
|
;; Invalid height
|
|
|
|
|
(when (= 0 height) (setq height (/ display-height 2)))
|
2015-08-27 05:03:27 +02:00
|
|
|
|
;; Make sure at least half of the window is visible
|
|
|
|
|
(when (or (> (+ y (/ height 2)) display-height)
|
|
|
|
|
(> 0 (+ y (/ height 2))))
|
2015-08-11 09:06:11 +02:00
|
|
|
|
(setq y (/ (- display-height height) 2))))
|
|
|
|
|
;; Center floating windows
|
|
|
|
|
(when (and (= x 0) (= y 0))
|
|
|
|
|
(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
|
2015-09-24 14:03:57 +02:00
|
|
|
|
(setq x (/ (- (elt edges 2) (elt edges 0) width) 2)
|
|
|
|
|
y (/ (- (elt edges 3) (elt edges 1) height) 2))
|
2015-08-11 09:06:11 +02:00
|
|
|
|
;; Put at the center of screen
|
|
|
|
|
(setq x (/ (- display-width width) 2)
|
|
|
|
|
y (/ (- display-height height) 2))))))
|
|
|
|
|
(exwm--log "Floating geometry (corrected): %dx%d%+d%+d" width height x y)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; Fit frame to client
|
2016-02-18 12:56:01 +01:00
|
|
|
|
;; 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)
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(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))))))
|
|
|
|
|
(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.
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:CreateWindow
|
|
|
|
|
:depth 0 :wid frame-container
|
|
|
|
|
:parent container
|
|
|
|
|
:x 0 :y 0 :width width :height height :border-width 0
|
|
|
|
|
:class xcb:WindowClass:CopyFromParent
|
|
|
|
|
:visual 0 ;CopyFromParent
|
|
|
|
|
:value-mask xcb:CW:OverrideRedirect
|
|
|
|
|
: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))
|
|
|
|
|
(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)))))
|
|
|
|
|
;; Reparent this frame to its container.
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ReparentWindow
|
2016-02-20 14:52:07 +01:00
|
|
|
|
:window outer-id :parent frame-container :x 0 :y 0))
|
|
|
|
|
;; Place the X window container.
|
2015-10-28 07:04:41 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(make-instance 'xcb:ConfigureWindow
|
|
|
|
|
:window container
|
|
|
|
|
:value-mask (eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:X
|
|
|
|
|
xcb:ConfigWindow:Y))
|
2015-10-28 07:04:41 +01:00
|
|
|
|
:x (- x exwm-floating-border-width)
|
|
|
|
|
:y (- y exwm-floating-border-width)))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:flush exwm--connection)
|
|
|
|
|
;; Set window/buffer
|
|
|
|
|
(with-current-buffer (exwm--id->buffer id)
|
2015-09-11 11:13:43 +02:00
|
|
|
|
(setq window-size-fixed exwm--fixed-size
|
2015-07-17 13:16:08 +02:00
|
|
|
|
exwm--frame original-frame
|
|
|
|
|
exwm--floating-frame frame)
|
2016-02-18 12:56:01 +01:00
|
|
|
|
;; Do the refresh manually.
|
|
|
|
|
(remove-hook 'window-configuration-change-hook #'exwm-layout--refresh)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(set-window-buffer window (current-buffer)) ;this changes current buffer
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(add-hook 'window-configuration-change-hook #'exwm-layout--refresh)
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(set-window-dedicated-p window t)
|
|
|
|
|
(exwm-layout--show id window))
|
2016-02-24 14:27:23 +01:00
|
|
|
|
(with-selected-frame exwm-workspace--current
|
|
|
|
|
(exwm-layout--refresh))
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(select-frame-set-input-focus frame))
|
2016-02-20 07:52:53 +01:00
|
|
|
|
(run-hooks 'exwm-floating-setup-hook)
|
|
|
|
|
;; Redraw the frame.
|
|
|
|
|
(redisplay))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
(defun exwm-floating--unset-floating (id)
|
|
|
|
|
"Make window ID non-floating."
|
|
|
|
|
(let ((buffer (exwm--id->buffer id)))
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(with-current-buffer buffer
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(when exwm--floating-frame
|
2016-02-20 07:52:53 +01:00
|
|
|
|
;; 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
|
|
|
|
|
: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--client-event-mask))
|
|
|
|
|
;; Reparent the floating frame back to the root window.
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(let ((frame-id (frame-parameter exwm--floating-frame 'exwm-outer-id))
|
|
|
|
|
(frame-container (frame-parameter exwm--floating-frame
|
|
|
|
|
'exwm-container)))
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(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
|
2016-02-20 14:52:07 +01:00
|
|
|
|
:x 0 :y 0))
|
|
|
|
|
;; 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
|
|
|
|
|
;; (the stacking order won't change from now on).
|
2016-02-06 05:59:33 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ConfigureWindow
|
|
|
|
|
:window exwm--container
|
|
|
|
|
:value-mask (logior xcb:ConfigWindow:Sibling
|
|
|
|
|
xcb:ConfigWindow:StackMode)
|
|
|
|
|
:sibling (frame-parameter exwm-workspace--current
|
2016-02-20 14:52:07 +01:00
|
|
|
|
'exwm-container)
|
2016-02-06 05:59:33 +01:00
|
|
|
|
:stack-mode xcb:StackMode:Above)))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(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
|
|
|
|
|
(with-current-buffer buffer
|
2015-08-12 12:09:35 +02:00
|
|
|
|
(setq window-size-fixed nil
|
|
|
|
|
exwm--floating-frame nil
|
2015-07-17 13:16:08 +02:00
|
|
|
|
exwm--frame exwm-workspace--current))
|
2015-08-12 12:09:35 +02:00
|
|
|
|
(let ((window (frame-selected-window exwm-workspace--current)))
|
|
|
|
|
(set-window-buffer window buffer)
|
2015-08-16 13:00:42 +02:00
|
|
|
|
(select-window window)))
|
|
|
|
|
(run-hooks 'exwm-floating-exit-hook))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
;;;###autoload
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(defun exwm-floating-toggle-floating ()
|
|
|
|
|
"Toggle the current window between floating and non-floating states."
|
|
|
|
|
(interactive)
|
|
|
|
|
(with-current-buffer (window-buffer)
|
|
|
|
|
(if exwm--floating-frame
|
|
|
|
|
(exwm-floating--unset-floating exwm--id)
|
|
|
|
|
(exwm-floating--set-floating exwm--id))))
|
|
|
|
|
|
2016-02-25 05:41:35 +01:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun exwm-floating-hide ()
|
|
|
|
|
"Hide the current floating X window (which would show again when selected)."
|
|
|
|
|
(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))
|
|
|
|
|
;; FIXME: Should it be put into iconic state?
|
|
|
|
|
(xcb:flush exwm--connection)
|
|
|
|
|
(select-frame-set-input-focus exwm-workspace--current)))
|
|
|
|
|
|
2016-02-07 03:45:59 +01:00
|
|
|
|
(define-obsolete-function-alias 'exwm-floating-hide-mode-line
|
|
|
|
|
'exwm-layout-hide-mode-line "25.1" "Hide mode-line of a floating frame.")
|
|
|
|
|
(define-obsolete-function-alias 'exwm-floating-show-mode-line
|
|
|
|
|
'exwm-layout-show-mode-line "25.1" "Show mode-line of a floating frame.")
|
2015-09-07 11:33:22 +02:00
|
|
|
|
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(defvar exwm-floating--moveresize-calculate nil
|
2016-02-03 05:12:24 +01:00
|
|
|
|
"Calculate move/resize parameters [buffer event-mask x y width height].")
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
(defun exwm-floating--start-moveresize (id &optional type)
|
|
|
|
|
"Start move/resize."
|
|
|
|
|
(let ((buffer (exwm--id->buffer id))
|
2016-02-03 05:12:24 +01:00
|
|
|
|
frame container x y width height cursor)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(when (and buffer
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
(setq frame exwm--floating-frame
|
|
|
|
|
container exwm--container))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; Test if the pointer can be grabbed
|
|
|
|
|
(= xcb:GrabStatus:Success
|
|
|
|
|
(slot-value
|
|
|
|
|
(xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:GrabPointer
|
2016-02-03 05:12:24 +01:00
|
|
|
|
:owner-events 0 :grab-window container
|
2015-07-17 13:16:08 +02:00
|
|
|
|
: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))
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(select-window (frame-first-window frame)) ;transfer input focus
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(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 not 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)
|
|
|
|
|
((< y 1) xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP)
|
|
|
|
|
((> 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))))
|
2015-09-03 12:56:36 +02:00
|
|
|
|
(if (not type)
|
|
|
|
|
(exwm-floating--stop-moveresize)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(cond ((= type xcb:ewmh:_NET_WM_MOVERESIZE_MOVE)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq cursor exwm-floating--cursor-move
|
|
|
|
|
exwm-floating--moveresize-calculate
|
|
|
|
|
`(lambda (x y)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(vector ,buffer
|
2015-09-27 13:31:00 +02:00
|
|
|
|
,(eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:X
|
|
|
|
|
xcb:ConfigWindow:Y))
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(- x ,win-x) (- y ,win-y) 0 0))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq cursor exwm-floating--cursor-top-left
|
|
|
|
|
exwm-floating--moveresize-calculate
|
|
|
|
|
`(lambda (x y)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(vector ,buffer
|
2015-09-27 13:31:00 +02:00
|
|
|
|
,(eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:X
|
|
|
|
|
xcb:ConfigWindow:Y
|
|
|
|
|
xcb:ConfigWindow:Width
|
|
|
|
|
xcb:ConfigWindow:Height))
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(- x ,win-x) (- y ,win-y)
|
|
|
|
|
(- ,(+ root-x width) x)
|
|
|
|
|
(- ,(+ root-y height) y)))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq cursor exwm-floating--cursor-top
|
|
|
|
|
exwm-floating--moveresize-calculate
|
|
|
|
|
`(lambda (x y)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(vector ,buffer
|
2015-09-27 13:31:00 +02:00
|
|
|
|
,(eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:Y
|
|
|
|
|
xcb:ConfigWindow:Height))
|
2015-07-18 04:23:24 +02:00
|
|
|
|
0 (- y ,win-y) 0 (- ,(+ root-y height) y)))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq cursor exwm-floating--cursor-top-right
|
|
|
|
|
exwm-floating--moveresize-calculate
|
|
|
|
|
`(lambda (x y)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(vector ,buffer
|
2015-09-27 13:31:00 +02:00
|
|
|
|
,(eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:Y
|
|
|
|
|
xcb:ConfigWindow:Width
|
|
|
|
|
xcb:ConfigWindow:Height))
|
2015-07-18 04:23:24 +02:00
|
|
|
|
0 (- y ,win-y) (- x ,(- root-x width))
|
|
|
|
|
(- ,(+ root-y height) y)))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq cursor exwm-floating--cursor-right
|
|
|
|
|
exwm-floating--moveresize-calculate
|
|
|
|
|
`(lambda (x y)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(vector ,buffer ,xcb:ConfigWindow:Width
|
2015-07-18 04:23:24 +02:00
|
|
|
|
0 0 (- x ,(- root-x width)) 0))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq cursor exwm-floating--cursor-bottom-right
|
|
|
|
|
exwm-floating--moveresize-calculate
|
|
|
|
|
`(lambda (x y)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(vector ,buffer
|
2015-09-27 13:31:00 +02:00
|
|
|
|
,(eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:Width
|
|
|
|
|
xcb:ConfigWindow:Height))
|
2015-07-18 04:23:24 +02:00
|
|
|
|
0 0 (- x ,(- root-x width))
|
|
|
|
|
(- y ,(- root-y height))))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq cursor exwm-floating--cursor-bottom
|
|
|
|
|
exwm-floating--moveresize-calculate
|
|
|
|
|
`(lambda (x y)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(vector ,buffer
|
2015-07-18 04:23:24 +02:00
|
|
|
|
,xcb:ConfigWindow:Height
|
|
|
|
|
0 0 0 (- y ,(- root-y height))))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq cursor exwm-floating--cursor-bottom-left
|
|
|
|
|
exwm-floating--moveresize-calculate
|
|
|
|
|
`(lambda (x y)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(vector ,buffer
|
2015-09-27 13:31:00 +02:00
|
|
|
|
,(eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:X
|
|
|
|
|
xcb:ConfigWindow:Width
|
|
|
|
|
xcb:ConfigWindow:Height))
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(- x ,win-x)
|
|
|
|
|
0
|
|
|
|
|
(- ,(+ root-x width) x)
|
|
|
|
|
(- y ,(- root-y height))))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq cursor exwm-floating--cursor-left
|
|
|
|
|
exwm-floating--moveresize-calculate
|
|
|
|
|
`(lambda (x y)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(vector ,buffer
|
2015-09-27 13:31:00 +02:00
|
|
|
|
,(eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:X
|
|
|
|
|
xcb:ConfigWindow:Width))
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(- x ,win-x) 0 (- ,(+ root-x width) x) 0)))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; Select events and change cursor (should always succeed)
|
|
|
|
|
(xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:GrabPointer
|
2016-02-03 05:12:24 +01:00
|
|
|
|
:owner-events 0 :grab-window container
|
2015-09-27 13:31:00 +02:00
|
|
|
|
:event-mask (eval-when-compile
|
|
|
|
|
(logior xcb:EventMask:ButtonRelease
|
|
|
|
|
xcb:EventMask:ButtonMotion))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
:pointer-mode xcb:GrabMode:Async
|
|
|
|
|
:keyboard-mode xcb:GrabMode:Async
|
|
|
|
|
:confine-to xcb:Window:None
|
|
|
|
|
:cursor cursor
|
2015-07-18 04:23:24 +02:00
|
|
|
|
:time xcb:Time:CurrentTime)))))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
(defun exwm-floating--stop-moveresize (&rest _args)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
"Stop move/resize."
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UngrabPointer :time xcb:Time:CurrentTime))
|
2015-09-18 08:17:52 +02:00
|
|
|
|
;; Inform the X window that its absolute position is changed
|
|
|
|
|
(when exwm-floating--moveresize-calculate
|
|
|
|
|
(let ((edges (window-inside-absolute-pixel-edges (frame-selected-window)))
|
|
|
|
|
(id (with-current-buffer (window-buffer (frame-selected-window))
|
|
|
|
|
exwm--id)))
|
|
|
|
|
(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 (elt edges 0)
|
|
|
|
|
:y (elt edges 1)
|
|
|
|
|
:width (- (elt edges 2)
|
|
|
|
|
(elt edges 0))
|
|
|
|
|
:height (- (elt edges 3)
|
|
|
|
|
(elt edges 1))
|
|
|
|
|
:border-width 0
|
|
|
|
|
:override-redirect 0)
|
|
|
|
|
exwm--connection)))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:flush exwm--connection)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq exwm-floating--moveresize-calculate nil))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
(defun exwm-floating--do-moveresize (data _synthetic)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
"Perform move/resize."
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(when exwm-floating--moveresize-calculate
|
|
|
|
|
(let ((obj (make-instance 'xcb:MotionNotify))
|
2015-08-26 11:25:21 +02:00
|
|
|
|
(geometry (frame-parameter exwm-workspace--current 'exwm-geometry))
|
|
|
|
|
(frame-x 0)
|
|
|
|
|
(frame-y 0)
|
2016-02-20 14:52:07 +01:00
|
|
|
|
result value-mask width height)
|
2015-08-26 11:25:21 +02:00
|
|
|
|
(when geometry
|
|
|
|
|
(setq frame-x (slot-value geometry 'x)
|
|
|
|
|
frame-y (slot-value geometry 'y)))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:unmarshal obj data)
|
2015-07-18 04:23:24 +02:00
|
|
|
|
(setq result (funcall exwm-floating--moveresize-calculate
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(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)))
|
|
|
|
|
width (aref result 4)
|
|
|
|
|
height (aref result 5))
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(with-current-buffer (aref result 0)
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ConfigureWindow
|
|
|
|
|
:window exwm--container
|
|
|
|
|
:value-mask (logand (aref result 1)
|
|
|
|
|
(eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:X
|
|
|
|
|
xcb:ConfigWindow:Y)))
|
|
|
|
|
:x (- (aref result 2) frame-x)
|
|
|
|
|
:y (- (aref result 3) frame-y)))
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ConfigureWindow
|
|
|
|
|
:window (frame-parameter exwm--floating-frame
|
|
|
|
|
'exwm-container)
|
|
|
|
|
:value-mask value-mask
|
|
|
|
|
:width width
|
|
|
|
|
:height height))
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ConfigureWindow
|
|
|
|
|
:window (frame-parameter exwm--floating-frame
|
|
|
|
|
'exwm-outer-id)
|
2016-02-20 14:52:07 +01:00
|
|
|
|
:value-mask value-mask
|
|
|
|
|
:width width
|
|
|
|
|
:height height)))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:flush exwm--connection))))
|
|
|
|
|
|
2015-09-11 11:13:43 +02:00
|
|
|
|
(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."
|
|
|
|
|
(unless (and (eq major-mode '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))
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(let* ((geometry (xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:GetGeometry
|
|
|
|
|
:drawable exwm--container)))
|
2015-09-18 08:17:52 +02:00
|
|
|
|
(edges (window-inside-absolute-pixel-edges)))
|
2015-09-11 11:13:43 +02:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ConfigureWindow
|
2016-02-03 05:12:24 +01:00
|
|
|
|
:window exwm--container
|
2015-09-27 13:31:00 +02:00
|
|
|
|
:value-mask (eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:X
|
|
|
|
|
xcb:ConfigWindow:Y))
|
2015-09-11 11:13:43 +02:00
|
|
|
|
:x (+ (slot-value geometry 'x) delta-x)
|
2015-09-18 08:17:52 +02:00
|
|
|
|
: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))))
|
2015-09-11 11:13:43 +02:00
|
|
|
|
(xcb:flush exwm--connection)))
|
|
|
|
|
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(defun exwm-floating--init ()
|
|
|
|
|
"Initialize floating module."
|
|
|
|
|
;; 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")))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(provide 'exwm-floating)
|
|
|
|
|
|
|
|
|
|
;;; exwm-floating.el ends here
|