Mirrors/exwm2
2
0
Fork 0
mirror of https://github.com/emacs-exwm/exwm.git synced 2024-11-27 14:57:59 +01:00
Code Issues Projects Releases Packages Wiki Activity
exwm2/exwm-floating.el
Chris Feng 10a7fe8d65 First commit
2015-07-17 19:16:08 +08:00

431 lines
20 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; exwm-floating.el --- Floating Module for EXWM -*- lexical-binding: t -*-
;; Copyright (C) 2015 Chris Feng
;; Author: Chris Feng <chris.w.feng@gmail.com>
;; Keywords: unix
;; This file is not part of GNU Emacs.
;; This file 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.
;; This file 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 this file. 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.
;; Todo:
;; + move/resize with keyboard.
;;; Code:
(require 'xcb-cursor)
(defvar exwm-floating-border-width 1 "Border width of the floating window.")
(defvar exwm-floating-border-color "blue"
"Border color of the floating window.")
(defun exwm-floating--set-floating (id)
"Make window ID floating."
(interactive)
(setq exwm-input--focus-lock t)
(when (get-buffer-window (exwm--id->buffer id)) ;window in non-floating state
(set-window-buffer (selected-window) (other-buffer))) ;hide it first
(let* ((original-frame
(with-current-buffer (exwm--id->buffer id)
(if (and exwm-transient-for (exwm--id->buffer exwm-transient-for))
;; Place a modal in the same workspace with its leading window
(with-current-buffer (exwm--id->buffer exwm-transient-for)
exwm--frame)
;; Fallback to current workspace
exwm-workspace--current)))
(original-id (frame-parameter original-frame 'exwm-window-id))
;; Create new frame
(frame (with-current-buffer "*scratch*"
(make-frame `((minibuffer . nil) ;use the one on workspace
(background-color
. ,exwm-floating-border-color)
(internal-border-width
. ,exwm-floating-border-width)
(unsplittable . t))))) ;and fix the size later
(frame-id (string-to-int (frame-parameter frame 'window-id)))
(outer-id (string-to-int (frame-parameter frame 'outer-window-id)))
(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)))
;; Save window IDs
(set-frame-parameter frame 'exwm-window-id frame-id)
(set-frame-parameter frame 'exwm-outer-id outer-id)
;; Set urgency flag if it's not appear in the active workspace
(let ((idx (cl-position original-frame exwm-workspace--list)))
(when (/= idx exwm-workspace-current-index)
(set-frame-parameter original-frame 'exwm--urgency t)
(exwm-workspace--update-switch-history)))
;; Fix illegal parameters
;; FIXME: check normal hints restrictions
(let* ((display-width (x-display-pixel-width))
(display-height (- (x-display-pixel-height)
(window-pixel-height (minibuffer-window
original-frame))
(* 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)))
;; Completely outsize
(when (or (> x display-width) (> 0 (+ x display-width)))
(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)))
;; Completely outside
(when (or (> y display-height) (> 0 (+ y display-height)))
(setq y (/ (- display-height height) 2)))))
;; Set OverrideRedirect on this frame
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window outer-id :value-mask xcb:CW:OverrideRedirect
:override-redirect 1))
;; Set event mask
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window frame-id :value-mask xcb:CW:EventMask
:event-mask xcb:EventMask:SubstructureRedirect))
;; Reparent this frame to the original one
(xcb:+request exwm--connection
(make-instance 'xcb:ReparentWindow
:window outer-id :parent original-id
:x (- x exwm-floating-border-width)
:y (- y exwm-floating-border-width)))
;; Save the geometry
;; Rationale: the frame will not be ready for some time, thus we cannot
;; infer the correct window size from its geometry.
(with-current-buffer (exwm--id->buffer id)
(setq exwm--floating-edges
(vector exwm-floating-border-width exwm-floating-border-width
(+ width exwm-floating-border-width)
(+ height exwm-floating-border-width))))
;; Fit frame to client
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window outer-id
:value-mask (logior xcb:ConfigWindow:Width
xcb:ConfigWindow:Height
xcb:ConfigWindow:StackMode)
:width (+ width (* 2 exwm-floating-border-width))
:height (+ height (* 2 exwm-floating-border-width)
(window-mode-line-height)
(window-header-line-height))
:stack-mode xcb:StackMode:Above)) ;top-most
;; Reparent window to this frame
(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:ReparentWindow
:window id :parent frame-id
:x exwm-floating-border-width
:y exwm-floating-border-width))
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window id :value-mask xcb:CW:EventMask
:event-mask exwm--client-event-mask))
(xcb:flush exwm--connection)
;; Set window/buffer
(with-current-buffer (exwm--id->buffer id)
(setq window-size-fixed t ;make frame fixed size
exwm--frame original-frame
exwm--floating-frame frame)
(set-window-buffer window (current-buffer)) ;this changes current buffer
(set-window-dedicated-p window t))
(with-current-buffer (exwm--id->buffer id)
;; Some window should not get input focus on creation
;; FIXME: other conditions?
(unless (memq xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY exwm-window-type)
(x-focus-frame exwm--floating-frame)
(exwm-input--set-focus id)))
(setq exwm-input--focus-lock nil)))
(defun exwm-floating--unset-floating (id)
"Make window ID non-floating."
(interactive)
(setq exwm-input--focus-lock t)
(let ((buffer (exwm--id->buffer id)))
;; Reparent to workspace frame
(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:ReparentWindow
:window id
:parent (frame-parameter exwm-workspace--current
'exwm-window-id)
:x 0 :y 0)) ;temporary position
(xcb:+request exwm--connection
(make-instance 'xcb:ChangeWindowAttributes
:window id :value-mask xcb:CW:EventMask
:event-mask exwm--client-event-mask))
(xcb:flush exwm--connection)
(with-current-buffer buffer
(when exwm--floating-frame ;from floating to non-floating
(setq exwm--floating-edges nil) ;invalid by now
(set-window-dedicated-p (frame-first-window exwm--floating-frame) nil)
(delete-frame exwm--floating-frame))) ;remove the floating frame
(with-current-buffer buffer
(setq exwm--floating-frame nil
exwm--frame exwm-workspace--current))
(select-frame exwm-workspace--current t)
(set-window-buffer nil buffer)
(exwm-layout--show id)
(exwm-input--set-focus id))
(setq exwm-input--focus-lock nil))
(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))))
(defvar exwm-floating--moveresize-id nil)
(defvar exwm-floating--moveresize-type nil)
(defvar exwm-floating--moveresize-delta nil)
(defun exwm-floating--start-moveresize (id &optional type)
"Start move/resize."
(let ((buffer (exwm--id->buffer id))
frame frame-id cursor)
(when (and buffer
(setq frame (with-current-buffer buffer exwm--floating-frame))
(setq frame-id (frame-parameter frame 'exwm-outer-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 frame-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)))
(setq exwm--floating-edges nil) ;invalid by now
(with-slots (root-x root-y win-x win-y)
(xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:QueryPointer :window id))
(select-frame-set-input-focus frame) ;raise and focus it
(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))))
(when type
(cond ((= type xcb:ewmh:_NET_WM_MOVERESIZE_MOVE)
(setq exwm-floating--moveresize-delta (list win-x win-y 0 0)
cursor exwm-floating--cursor-move))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT)
(setq exwm-floating--moveresize-delta
(list win-x win-y (+ root-x width) (+ root-y height))
cursor exwm-floating--cursor-top-left))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP)
(setq exwm-floating--moveresize-delta
(list 0 win-y 0 (+ root-y height))
cursor exwm-floating--cursor-top))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT)
(setq exwm-floating--moveresize-delta
(list 0 win-y (- root-x width) (+ root-y height))
cursor exwm-floating--cursor-top-right))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT)
(setq exwm-floating--moveresize-delta
(list 0 0 (- root-x width) 0)
cursor exwm-floating--cursor-right))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT)
(setq exwm-floating--moveresize-delta
(list 0 0 (- root-x width) (- root-y height))
cursor exwm-floating--cursor-bottom-right))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM)
(setq exwm-floating--moveresize-delta
(list 0 0 0 (- root-y height))
cursor exwm-floating--cursor-bottom))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT)
(setq exwm-floating--moveresize-delta
(list win-x 0 (+ root-x width) (- root-y height))
cursor exwm-floating--cursor-bottom-left))
((= type xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT)
(setq exwm-floating--moveresize-delta
(list win-x 0 (+ root-x width) 0)
cursor exwm-floating--cursor-left)))
;; Select events and change cursor (should always succeed)
(xcb:+request-unchecked+reply exwm--connection
(make-instance 'xcb:GrabPointer
:owner-events 0 :grab-window frame-id
:event-mask (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))
(setq exwm-floating--moveresize-id frame-id
exwm-floating--moveresize-type type))))))
(defun exwm-floating--stop-moveresize (&rest args)
"Stop move/resize."
(xcb:+request exwm--connection
(make-instance 'xcb:UngrabPointer :time xcb:Time:CurrentTime))
(xcb:flush exwm--connection)
(setq exwm-floating--moveresize-id nil
exwm-floating--moveresize-type nil
exwm-floating--moveresize-delta nil))
(defun exwm-floating--do-moveresize (data synthetic)
"Perform move/resize."
(let ((mask 0) (x 0) (y 0) (width 0) (height 0)
(delta exwm-floating--moveresize-delta)
obj root-x root-y)
(when (and exwm-floating--moveresize-id exwm-floating--moveresize-type)
(setq obj (make-instance 'xcb:MotionNotify))
(xcb:unmarshal obj data)
(setq root-x (slot-value obj 'root-x)
root-y (slot-value obj 'root-y))
;; Perform move/resize according to the previously set type
(cond ((= exwm-floating--moveresize-type
xcb:ewmh:_NET_WM_MOVERESIZE_MOVE)
(setq mask (logior xcb:ConfigWindow:X xcb:ConfigWindow:Y)
x (- root-x (elt delta 0))
y (- root-y (elt delta 1))))
((= exwm-floating--moveresize-type
xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPLEFT)
(setq mask
(logior xcb:ConfigWindow:X xcb:ConfigWindow:Y
xcb:ConfigWindow:Width xcb:ConfigWindow:Height)
x (- root-x (elt delta 0))
y (- root-y (elt delta 1))
width (- (elt delta 2) root-x)
height (- (elt delta 3) root-y)))
((= exwm-floating--moveresize-type
xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOP)
(setq mask (logior xcb:ConfigWindow:Y xcb:ConfigWindow:Height)
y (- root-y (elt delta 1))
height (- (elt delta 3) root-y)))
((= exwm-floating--moveresize-type
xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_TOPRIGHT)
(setq mask
(logior xcb:ConfigWindow:Y
xcb:ConfigWindow:Width xcb:ConfigWindow:Height)
y (- root-y (elt delta 1))
width (- root-x (elt delta 2))
height (- (elt delta 3) root-y)))
((= exwm-floating--moveresize-type
xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_RIGHT)
(setq mask (logior xcb:ConfigWindow:Width)
width (- root-x (elt delta 2))))
((= exwm-floating--moveresize-type
xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT)
(setq mask
(logior xcb:ConfigWindow:Width xcb:ConfigWindow:Height)
width (- root-x (elt delta 2))
height (- root-y (elt delta 3))))
((= exwm-floating--moveresize-type
xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOM)
(setq mask (logior xcb:ConfigWindow:Height)
height (- root-y (elt delta 3))))
((= exwm-floating--moveresize-type
xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT)
(setq mask
(logior xcb:ConfigWindow:X
xcb:ConfigWindow:Width xcb:ConfigWindow:Height)
x (- root-x (elt delta 0))
width (- (elt delta 2) root-x)
height (- root-y (elt delta 3))))
((= exwm-floating--moveresize-type
xcb:ewmh:_NET_WM_MOVERESIZE_SIZE_LEFT)
(setq mask
(logior xcb:ConfigWindow:X xcb:ConfigWindow:Width)
x (- root-x (elt delta 0))
width (- (elt delta 2) root-x))))
(xcb:+request exwm--connection
(make-instance 'xcb:ConfigureWindow
:window exwm-floating--moveresize-id :value-mask mask
:x x :y y :width width :height height))
(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)
(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
Reference in a new issue View git blame Copy permalink