2015-07-17 13:16:08 +02:00
|
|
|
|
;;; exwm-manage.el --- Window Management Module for -*- lexical-binding: t -*-
|
|
|
|
|
;;; EXWM
|
|
|
|
|
|
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 is the fundamental module of EXWM that deals with window management.
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
(require 'exwm-core)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
(defvar exwm-manage-finish-hook nil
|
|
|
|
|
"Normal hook run after a window is just managed, in the context of the
|
|
|
|
|
corresponding buffer.")
|
|
|
|
|
|
|
|
|
|
(defun exwm-manage--update-geometry (id &optional force)
|
|
|
|
|
"Update window geometry."
|
2015-08-10 08:23:37 +02:00
|
|
|
|
(with-current-buffer (exwm--id->buffer id)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(unless (and exwm--geometry (not force))
|
|
|
|
|
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:GetGeometry :drawable id))))
|
|
|
|
|
(when reply ;nil when destroyed
|
|
|
|
|
(setq exwm--geometry reply))))))
|
|
|
|
|
|
2015-09-19 10:46:08 +02:00
|
|
|
|
;; The _MOTIF_WM_HINTS atom (see <Xm/MwmUtil.h> for more details)
|
|
|
|
|
;; It's currently only used in 'exwm-manage' module
|
|
|
|
|
(defvar exwm-manage--_MOTIF_WM_HINTS nil "_MOTIF_WM_HINTS atom.")
|
|
|
|
|
|
|
|
|
|
(defun exwm-manage--update-mwm-hints (id &optional force)
|
|
|
|
|
"Update _MOTIF_WM_HINTS."
|
|
|
|
|
(with-current-buffer (exwm--id->buffer id)
|
2016-05-24 06:30:53 +02:00
|
|
|
|
(unless (and (not exwm--mwm-hints-decorations) (not force))
|
2015-09-19 10:46:08 +02:00
|
|
|
|
(let ((reply (xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:icccm:-GetProperty
|
|
|
|
|
:window id
|
|
|
|
|
:property exwm-manage--_MOTIF_WM_HINTS
|
|
|
|
|
:type exwm-manage--_MOTIF_WM_HINTS
|
|
|
|
|
:long-length 5))))
|
|
|
|
|
(when reply
|
2016-05-24 06:30:53 +02:00
|
|
|
|
;; Check MotifWmHints.decorations.
|
|
|
|
|
(with-slots (value) reply
|
|
|
|
|
(setq value (append value nil))
|
|
|
|
|
(when (and value
|
|
|
|
|
;; See <Xm/MwmUtil.h> for fields definitions.
|
|
|
|
|
(/= 0 (logand
|
|
|
|
|
(elt value 0) ;MotifWmHints.flags
|
|
|
|
|
2)) ;MWM_HINTS_DECORATIONS
|
|
|
|
|
(= 0
|
|
|
|
|
(elt value 2))) ;MotifWmHints.decorations
|
|
|
|
|
(setq exwm--mwm-hints-decorations nil))))))))
|
2015-09-19 10:46:08 +02:00
|
|
|
|
|
2016-02-19 10:12:43 +01:00
|
|
|
|
(defvar exwm-workspace--current)
|
|
|
|
|
(defvar exwm-workspace--switch-history-outdated)
|
|
|
|
|
|
|
|
|
|
(declare-function exwm--update-window-type "exwm.el" (id &optional force))
|
|
|
|
|
(declare-function exwm--update-class "exwm.el" (id &optional force))
|
|
|
|
|
(declare-function exwm--update-transient-for "exwm.el" (id &optional force))
|
|
|
|
|
(declare-function exwm--update-normal-hints "exwm.el" (id &optional force))
|
|
|
|
|
(declare-function exwm--update-title "exwm.el" (id))
|
|
|
|
|
(declare-function exwm--update-hints "exwm.el" (id &optional force))
|
|
|
|
|
(declare-function exwm--update-protocols "exwm.el" (id &optional force))
|
|
|
|
|
(declare-function exwm--update-state "exwm.el" (id &optional force))
|
2016-07-12 12:35:51 +02:00
|
|
|
|
(declare-function exwm--update-strut "exwm.el" (id))
|
2016-02-19 10:12:43 +01:00
|
|
|
|
(declare-function exwm-floating--set-floating "exwm-floating.el" (id))
|
|
|
|
|
(declare-function exwm-floating--unset-floating "exwm-floating.el" (id))
|
|
|
|
|
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(defun exwm-manage--manage-window (id)
|
|
|
|
|
"Manage window ID."
|
2015-08-07 15:52:34 +02:00
|
|
|
|
(exwm--log "Try to manage #x%x" id)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(catch 'return
|
|
|
|
|
;; Ensure it's alive
|
|
|
|
|
(when (xcb:+request-checked+request-check exwm--connection
|
|
|
|
|
(make-instance 'xcb:ChangeWindowAttributes
|
|
|
|
|
:window id :value-mask xcb:CW:EventMask
|
|
|
|
|
:event-mask exwm--client-event-mask))
|
|
|
|
|
(throw 'return 'dead))
|
|
|
|
|
(with-current-buffer (generate-new-buffer "*EXWM*")
|
|
|
|
|
(push `(,id . ,(current-buffer)) exwm--id-buffer-alist)
|
|
|
|
|
(exwm-mode)
|
|
|
|
|
(setq exwm--id id)
|
|
|
|
|
(exwm--update-window-type id)
|
|
|
|
|
(exwm--update-class id)
|
2015-09-19 11:52:04 +02:00
|
|
|
|
(exwm--update-transient-for id)
|
|
|
|
|
(exwm--update-normal-hints id)
|
2016-05-24 06:30:53 +02:00
|
|
|
|
(exwm--update-hints id)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(exwm-manage--update-geometry id)
|
2015-09-19 10:46:08 +02:00
|
|
|
|
(exwm-manage--update-mwm-hints id)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; No need to manage (please check OverrideRedirect outside)
|
|
|
|
|
(when (or
|
|
|
|
|
(not
|
|
|
|
|
(or (not exwm-window-type)
|
|
|
|
|
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY exwm-window-type)
|
|
|
|
|
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG exwm-window-type)
|
|
|
|
|
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_NORMAL exwm-window-type)))
|
2016-03-04 12:11:10 +01:00
|
|
|
|
;; Check the _MOTIF_WM_HINTS property.
|
2016-05-24 06:30:53 +02:00
|
|
|
|
(and (not exwm--mwm-hints-decorations)
|
|
|
|
|
(not exwm--hints-input)
|
2015-09-19 11:52:04 +02:00
|
|
|
|
;; Floating windows only
|
|
|
|
|
(or exwm-transient-for exwm--fixed-size
|
|
|
|
|
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY
|
|
|
|
|
exwm-window-type)
|
|
|
|
|
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG
|
|
|
|
|
exwm-window-type))))
|
2015-08-07 15:52:34 +02:00
|
|
|
|
(exwm--log "No need to manage #x%x" id)
|
2016-07-12 12:35:51 +02:00
|
|
|
|
;; Update struts.
|
|
|
|
|
(when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK exwm-window-type)
|
|
|
|
|
(exwm--update-strut id))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; Remove all events
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(make-instance 'xcb:ChangeWindowAttributes
|
|
|
|
|
:window id :value-mask xcb:CW:EventMask
|
2016-07-12 12:35:51 +02:00
|
|
|
|
:event-mask
|
|
|
|
|
(if (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK
|
|
|
|
|
exwm-window-type)
|
|
|
|
|
;; Listen for change of struts property of dock.
|
|
|
|
|
xcb:EventMask:PropertyChange
|
|
|
|
|
xcb:EventMask:NoEvent)))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; The window needs to be mapped
|
|
|
|
|
(xcb:+request exwm--connection
|
2015-08-28 20:14:04 +02:00
|
|
|
|
(make-instance 'xcb:MapWindow :window id))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(with-slots (x y width height) exwm--geometry
|
2015-12-11 05:11:24 +01:00
|
|
|
|
;; Reparent to virtual root
|
|
|
|
|
(unless (or (memq xcb:Atom:_NET_WM_WINDOW_TYPE_DESKTOP
|
|
|
|
|
exwm-window-type)
|
|
|
|
|
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_DOCK
|
|
|
|
|
exwm-window-type))
|
2016-04-21 13:30:55 +02:00
|
|
|
|
(let ((frame-geometry (frame-parameter exwm-workspace--current
|
|
|
|
|
'exwm-geometry))
|
|
|
|
|
(workspace (frame-parameter exwm-workspace--current
|
|
|
|
|
'exwm-workspace)))
|
|
|
|
|
(when (and frame-geometry
|
|
|
|
|
(/= x 0)
|
|
|
|
|
(/= y 0))
|
|
|
|
|
(setq x (- x (slot-value frame-geometry 'x))
|
|
|
|
|
y (- y (slot-value frame-geometry 'y))))
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ReparentWindow
|
|
|
|
|
:window id
|
|
|
|
|
:parent workspace
|
|
|
|
|
:x x :y y))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; Center window of type _NET_WM_WINDOW_TYPE_SPLASH
|
|
|
|
|
(when (memq xcb:Atom:_NET_WM_WINDOW_TYPE_SPLASH exwm-window-type)
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ConfigureWindow
|
|
|
|
|
:window id
|
2015-09-27 13:31:00 +02:00
|
|
|
|
:value-mask (eval-when-compile
|
|
|
|
|
(logior xcb:ConfigWindow:X
|
|
|
|
|
xcb:ConfigWindow:Y))
|
2016-02-19 10:12:43 +01:00
|
|
|
|
:x (/ (- (exwm-workspace--current-width) width)
|
2015-08-13 06:02:44 +02:00
|
|
|
|
2)
|
2016-02-19 10:12:43 +01:00
|
|
|
|
:y (/ (- (exwm-workspace--current-height)
|
2015-08-13 06:02:44 +02:00
|
|
|
|
height)
|
|
|
|
|
2)))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:flush exwm--connection)
|
|
|
|
|
(setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist))
|
2015-10-28 07:04:41 +01:00
|
|
|
|
(let ((kill-buffer-query-functions nil))
|
|
|
|
|
(kill-buffer (current-buffer)))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(throw 'return 'ignored))
|
|
|
|
|
;; Manage the window
|
2015-08-07 15:52:34 +02:00
|
|
|
|
(exwm--log "Manage #x%x" id)
|
2016-02-03 05:12:24 +01:00
|
|
|
|
;; Create a new container as the parent of this X window
|
|
|
|
|
(setq exwm--container (xcb:generate-id exwm--connection))
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:CreateWindow
|
|
|
|
|
:depth 0 :wid exwm--container
|
|
|
|
|
:parent (frame-parameter exwm-workspace--current
|
|
|
|
|
'exwm-workspace)
|
|
|
|
|
:x 0 :y 0 :width 1 :height 1 :border-width 0
|
|
|
|
|
:class xcb:WindowClass:CopyFromParent
|
|
|
|
|
:visual 0 ;CopyFromParent
|
|
|
|
|
:value-mask (logior xcb:CW:OverrideRedirect
|
|
|
|
|
xcb:CW:EventMask)
|
|
|
|
|
:override-redirect 1
|
|
|
|
|
:event-mask xcb:EventMask:SubstructureRedirect))
|
|
|
|
|
(exwm--debug
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ewmh:set-_NET_WM_NAME
|
|
|
|
|
:window exwm--container
|
|
|
|
|
:data (format "EXWM container for 0x%x" id))))
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ReparentWindow
|
|
|
|
|
:window id :parent exwm--container :x 0 :y 0))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:+request exwm--connection ;remove border
|
|
|
|
|
(make-instance 'xcb:ConfigureWindow
|
|
|
|
|
:window id :value-mask xcb:ConfigWindow:BorderWidth
|
|
|
|
|
:border-width 0))
|
2015-09-20 04:51:58 +02:00
|
|
|
|
(dolist (button ;grab buttons to set focus / move / resize
|
|
|
|
|
(list xcb:ButtonIndex:1 xcb:ButtonIndex:2 xcb:ButtonIndex:3))
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
2015-09-20 04:51:58 +02:00
|
|
|
|
(make-instance 'xcb:GrabButton
|
|
|
|
|
:owner-events 0 :grab-window id
|
|
|
|
|
:event-mask xcb:EventMask:ButtonPress
|
|
|
|
|
:pointer-mode xcb:GrabMode:Sync
|
|
|
|
|
:keyboard-mode xcb:GrabMode:Async
|
|
|
|
|
:confine-to xcb:Window:None :cursor xcb:Cursor:None
|
|
|
|
|
:button button :modifiers xcb:ModMask:Any)))
|
2015-09-09 05:26:17 +02:00
|
|
|
|
(xcb:+request exwm--connection ;update _NET_CLIENT_LIST
|
|
|
|
|
(make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST
|
|
|
|
|
:window exwm--root
|
|
|
|
|
:data (vconcat (mapcar #'car exwm--id-buffer-alist))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:flush exwm--connection)
|
|
|
|
|
(exwm--update-title id)
|
|
|
|
|
(exwm--update-protocols id)
|
|
|
|
|
(exwm--update-state id)
|
|
|
|
|
(if (or exwm-transient-for exwm--fixed-size
|
|
|
|
|
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_UTILITY exwm-window-type)
|
|
|
|
|
(memq xcb:Atom:_NET_WM_WINDOW_TYPE_DIALOG exwm-window-type))
|
|
|
|
|
(exwm-floating--set-floating id)
|
|
|
|
|
(exwm-floating--unset-floating id))
|
|
|
|
|
(exwm-input-grab-keyboard id)
|
2015-09-17 13:48:50 +02:00
|
|
|
|
(setq exwm-workspace--switch-history-outdated t)
|
2015-08-10 08:23:37 +02:00
|
|
|
|
(with-current-buffer (exwm--id->buffer id)
|
2015-08-11 03:18:21 +02:00
|
|
|
|
(run-hooks 'exwm-manage-finish-hook)))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
(defun exwm-manage--unmanage-window (id &optional withdraw-only)
|
|
|
|
|
"Unmanage window ID."
|
|
|
|
|
(let ((buffer (exwm--id->buffer id)))
|
2016-02-20 07:52:53 +01:00
|
|
|
|
(exwm--log "Unmanage #x%x (buffer: %s, widthdraw: %s)"
|
|
|
|
|
id buffer withdraw-only)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist))
|
|
|
|
|
(when (buffer-live-p buffer)
|
|
|
|
|
(with-current-buffer buffer
|
2016-02-20 07:52:53 +01:00
|
|
|
|
;; Flickering seems unavoidable here if the DestroyWindow request is
|
|
|
|
|
;; not initiated by us.
|
|
|
|
|
;; What we can do is to hide the its container ASAP.
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UnmapWindow :window exwm--container))
|
2016-02-20 07:52:53 +01:00
|
|
|
|
(xcb:flush exwm--connection)
|
2016-02-20 14:52:07 +01:00
|
|
|
|
;; Unmap the X window.
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UnmapWindow :window id))
|
2016-02-20 07:52:53 +01:00
|
|
|
|
;;
|
2015-09-17 13:48:50 +02:00
|
|
|
|
(setq exwm-workspace--switch-history-outdated t)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;;
|
|
|
|
|
(when withdraw-only
|
|
|
|
|
;; Reparent back to root
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ChangeWindowAttributes
|
|
|
|
|
:window id :value-mask xcb:CW:EventMask
|
|
|
|
|
:event-mask xcb:EventMask:NoEvent))
|
|
|
|
|
(let (x y geometry geometry-parent)
|
|
|
|
|
(if (not exwm--floating-frame)
|
|
|
|
|
(setq x 0 y 0) ;the position does not matter
|
|
|
|
|
(setq geometry-parent
|
|
|
|
|
(xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:GetGeometry
|
2016-02-03 05:12:24 +01:00
|
|
|
|
:drawable exwm--container))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
geometry (xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:GetGeometry
|
|
|
|
|
:drawable id)))
|
|
|
|
|
(if (not (and geometry-parent geometry))
|
|
|
|
|
(setq x 0 y 0) ;e.g. have been destroyed
|
|
|
|
|
(setq x (+ (slot-value geometry-parent 'x)
|
|
|
|
|
(slot-value geometry 'x))
|
|
|
|
|
y (+ (slot-value geometry-parent 'y)
|
|
|
|
|
(slot-value geometry 'y)))))
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ReparentWindow
|
|
|
|
|
:window id :parent exwm--root :x x :y y)))
|
|
|
|
|
;; Delete WM_STATE property
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:DeleteProperty
|
2016-02-18 12:56:01 +01:00
|
|
|
|
:window id :property xcb:Atom:WM_STATE)))
|
|
|
|
|
(when exwm--floating-frame
|
2016-02-20 14:52:07 +01:00
|
|
|
|
;; Unmap the floating frame before destroying the containers.
|
2016-02-20 07:52:53 +01:00
|
|
|
|
(let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id)))
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UnmapWindow :window window))
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ReparentWindow
|
|
|
|
|
:window window :parent exwm--root :x 0 :y 0))))
|
2016-02-20 14:52:07 +01:00
|
|
|
|
;; Destroy the X window container (and the frame container if any).
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:DestroyWindow :window exwm--container))
|
2015-10-28 07:04:41 +01:00
|
|
|
|
(let ((kill-buffer-query-functions nil)
|
|
|
|
|
(floating exwm--floating-frame))
|
2015-08-07 14:22:12 +02:00
|
|
|
|
(kill-buffer)
|
|
|
|
|
(when floating
|
2015-08-12 12:09:35 +02:00
|
|
|
|
(select-window
|
2016-02-20 07:52:53 +01:00
|
|
|
|
(frame-selected-window exwm-workspace--current)))))
|
|
|
|
|
(xcb:+request exwm--connection ;update _NET_CLIENT_LIST
|
|
|
|
|
(make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST
|
|
|
|
|
:window exwm--root
|
|
|
|
|
:data (vconcat (mapcar #'car exwm--id-buffer-alist))))
|
|
|
|
|
(xcb:flush exwm--connection))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
(defun exwm-manage--scan ()
|
|
|
|
|
"Search for existing windows and try to manage them."
|
|
|
|
|
(let* ((tree (xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:QueryTree :window exwm--root))))
|
|
|
|
|
(dolist (i (slot-value tree 'children))
|
|
|
|
|
(with-slots (override-redirect map-state)
|
|
|
|
|
(xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:GetWindowAttributes :window i))
|
|
|
|
|
(when (and (= 0 override-redirect) (= xcb:MapState:Viewable map-state))
|
2016-02-09 06:26:48 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UnmapWindow :window i))
|
|
|
|
|
(xcb:flush exwm--connection)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(exwm-manage--manage-window i))))))
|
|
|
|
|
|
|
|
|
|
(defvar exwm-manage--ping-lock nil
|
|
|
|
|
"Non-nil indicates EXWM is pinging a window.")
|
|
|
|
|
(defvar exwm-manage-ping-timeout 3 "Seconds to wait before killing a client.")
|
|
|
|
|
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(defun exwm-manage--kill-buffer-query-function ()
|
|
|
|
|
"Run in `kill-buffer-query-functions'."
|
|
|
|
|
(catch 'return
|
|
|
|
|
(when (xcb:+request-checked+request-check exwm--connection
|
|
|
|
|
(make-instance 'xcb:MapWindow :window exwm--id))
|
|
|
|
|
;; The X window is no longer alive so just close the buffer.
|
|
|
|
|
;; Destroy the container.
|
2016-02-20 07:52:53 +01:00
|
|
|
|
;; Hide the container to prevent flickering.
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UnmapWindow :window exwm--container))
|
|
|
|
|
(xcb:flush exwm--connection)
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(when exwm--floating-frame
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(let ((window (frame-parameter exwm--floating-frame 'exwm-outer-id)))
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UnmapWindow :window window))
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ReparentWindow
|
|
|
|
|
:window window
|
|
|
|
|
:parent exwm--root
|
|
|
|
|
:x 0 :y 0))))
|
2015-10-29 11:31:16 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(make-instance 'xcb:DestroyWindow :window exwm--container))
|
2015-10-29 11:31:16 +01:00
|
|
|
|
(xcb:flush exwm--connection)
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(throw 'return t))
|
|
|
|
|
(unless (memq xcb:Atom:WM_DELETE_WINDOW exwm--protocols)
|
|
|
|
|
;; The X window does not support WM_DELETE_WINDOW; destroy it.
|
2016-02-20 07:52:53 +01:00
|
|
|
|
;; Hide the container to prevent flickering.
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UnmapWindow :window exwm--container))
|
2016-02-18 12:56:01 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:DestroyWindow :window exwm--id))
|
|
|
|
|
(xcb:flush exwm--connection)
|
|
|
|
|
;; Wait for DestroyNotify event.
|
|
|
|
|
(throw 'return nil))
|
2016-03-03 12:34:17 +01:00
|
|
|
|
(let ((id exwm--id))
|
|
|
|
|
;; Try to close the X window with WM_DELETE_WINDOW client message.
|
2016-02-20 07:52:53 +01:00
|
|
|
|
(xcb:+request exwm--connection
|
2016-03-06 06:45:13 +01:00
|
|
|
|
(make-instance 'xcb:icccm:SendEvent
|
|
|
|
|
:destination id
|
|
|
|
|
:event (xcb:marshal
|
|
|
|
|
(make-instance 'xcb:icccm:WM_DELETE_WINDOW
|
|
|
|
|
:window id)
|
|
|
|
|
exwm--connection)))
|
2016-02-20 07:52:53 +01:00
|
|
|
|
(xcb:flush exwm--connection)
|
2016-03-03 12:34:17 +01:00
|
|
|
|
;;
|
|
|
|
|
(unless (memq xcb:Atom:_NET_WM_PING exwm--protocols)
|
2016-03-06 06:45:13 +01:00
|
|
|
|
;; The window does not support _NET_WM_PING. To make sure it'll die,
|
|
|
|
|
;; kill it after the time runs out.
|
|
|
|
|
;; Hide the container to prevent flickering.
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UnmapWindow :window exwm--container))
|
|
|
|
|
(xcb:flush exwm--connection)
|
|
|
|
|
(run-with-timer exwm-manage-ping-timeout nil
|
|
|
|
|
`(lambda () (exwm-manage--kill-client ,id)))
|
|
|
|
|
;; Wait for DestroyNotify event.
|
|
|
|
|
(throw 'return nil))
|
2016-03-03 12:34:17 +01:00
|
|
|
|
;; Try to determine if the X window is dead with _NET_WM_PING.
|
|
|
|
|
(setq exwm-manage--ping-lock t)
|
|
|
|
|
(xcb:+request exwm--connection
|
2016-03-06 06:45:13 +01:00
|
|
|
|
(make-instance 'xcb:SendEvent
|
|
|
|
|
:propagate 0
|
|
|
|
|
:destination id
|
|
|
|
|
:event-mask xcb:EventMask:NoEvent
|
|
|
|
|
:event (xcb:marshal
|
|
|
|
|
(make-instance 'xcb:ewmh:_NET_WM_PING
|
|
|
|
|
:window id
|
|
|
|
|
:timestamp 0
|
|
|
|
|
:client-window id)
|
|
|
|
|
exwm--connection)))
|
2016-03-03 12:34:17 +01:00
|
|
|
|
(xcb:flush exwm--connection)
|
|
|
|
|
(with-timeout (exwm-manage-ping-timeout
|
2016-03-06 06:45:13 +01:00
|
|
|
|
(if (yes-or-no-p (format "'%s' is not responding. \
|
2016-02-18 12:56:01 +01:00
|
|
|
|
Would you like to kill it? "
|
2016-03-06 06:45:13 +01:00
|
|
|
|
(buffer-name)))
|
|
|
|
|
(progn (exwm-manage--kill-client id)
|
|
|
|
|
;; Kill the unresponsive X window and
|
|
|
|
|
;; wait for DestroyNotify event.
|
|
|
|
|
(throw 'return nil))
|
|
|
|
|
;; Give up.
|
|
|
|
|
(throw 'return nil)))
|
|
|
|
|
(while (and exwm-manage--ping-lock
|
|
|
|
|
(exwm--id->buffer id)) ;may have been destroyed.
|
|
|
|
|
(accept-process-output nil 0.1))
|
|
|
|
|
;; Give up.
|
|
|
|
|
(throw 'return nil)))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
(defun exwm-manage--kill-client (&optional id)
|
|
|
|
|
"Kill an X client."
|
|
|
|
|
(unless id (setq id (exwm--buffer->id (current-buffer))))
|
2016-02-20 07:52:53 +01:00
|
|
|
|
;; Hide the container to prevent flickering.
|
|
|
|
|
(let ((buffer (exwm--id->buffer id)))
|
|
|
|
|
(when buffer
|
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:UnmapWindow :window exwm--container))
|
|
|
|
|
(xcb:flush exwm--connection))))
|
2015-08-16 20:53:04 +02:00
|
|
|
|
(let* ((response (xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:ewmh:get-_NET_WM_PID :window id)))
|
2015-10-29 11:31:16 +01:00
|
|
|
|
(pid (and response (slot-value response 'value)))
|
|
|
|
|
(request (make-instance 'xcb:KillClient :resource id)))
|
|
|
|
|
(if (not pid)
|
|
|
|
|
(xcb:+request exwm--connection request)
|
|
|
|
|
;; What if the PID is fake/wrong?
|
|
|
|
|
(signal-process pid 'SIGKILL)
|
|
|
|
|
;; Ensure it's dead
|
|
|
|
|
(run-with-timer exwm-manage-ping-timeout nil
|
|
|
|
|
`(lambda ()
|
|
|
|
|
(xcb:+request exwm--connection ,request))))
|
|
|
|
|
(xcb:flush exwm--connection)))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
2016-03-11 07:12:01 +01:00
|
|
|
|
;; FIXME: Make the following values as small as possible.
|
|
|
|
|
(defconst exwm-manage--width-delta-min 5)
|
|
|
|
|
(defconst exwm-manage--height-delta-min 5)
|
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
(defun exwm-manage--on-ConfigureRequest (data _synthetic)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
"Handle ConfigureRequest event."
|
|
|
|
|
(let ((obj (make-instance 'xcb:ConfigureRequest))
|
2016-03-11 07:12:01 +01:00
|
|
|
|
buffer edges width-delta height-delta)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:unmarshal obj data)
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(with-slots (window x y width height
|
|
|
|
|
border-width sibling stack-mode value-mask)
|
2015-08-14 11:46:43 +02:00
|
|
|
|
obj
|
2016-02-20 14:52:07 +01:00
|
|
|
|
(exwm--log "ConfigureRequest from #x%x (#x%x) @%dx%d%+d%+d; \
|
|
|
|
|
border-width: %d; sibling: #x%x; stack-mode: %d"
|
|
|
|
|
window value-mask width height x y
|
|
|
|
|
border-width sibling stack-mode)
|
2016-03-06 07:28:42 +01:00
|
|
|
|
(if (and (setq buffer (exwm--id->buffer window))
|
|
|
|
|
(with-current-buffer buffer
|
2016-03-11 07:12:01 +01:00
|
|
|
|
(or exwm--fullscreen
|
|
|
|
|
;; Make sure it's a floating X window wanting to resize
|
|
|
|
|
;; itself.
|
|
|
|
|
(or (not exwm--floating-frame)
|
|
|
|
|
(progn
|
|
|
|
|
(setq edges
|
|
|
|
|
(window-inside-pixel-edges
|
|
|
|
|
(get-buffer-window buffer t))
|
|
|
|
|
width-delta (- width (- (elt edges 2)
|
|
|
|
|
(elt edges 0)))
|
|
|
|
|
height-delta (- height (- (elt edges 3)
|
|
|
|
|
(elt edges 1))))
|
|
|
|
|
;; We cannot do resizing precisely for now.
|
|
|
|
|
(and (if (= 0 (logand value-mask
|
|
|
|
|
xcb:ConfigWindow:Width))
|
|
|
|
|
t
|
|
|
|
|
(< (abs width-delta)
|
|
|
|
|
exwm-manage--width-delta-min))
|
|
|
|
|
(if (= 0 (logand value-mask
|
|
|
|
|
xcb:ConfigWindow:Height))
|
|
|
|
|
t
|
|
|
|
|
(< (abs height-delta)
|
|
|
|
|
exwm-manage--height-delta-min))))))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
;; Send client message for managed windows
|
2015-08-06 06:32:14 +02:00
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
(setq edges
|
|
|
|
|
(if exwm--fullscreen
|
|
|
|
|
(list 0 0
|
2016-02-19 10:12:43 +01:00
|
|
|
|
(exwm-workspace--current-width)
|
|
|
|
|
(exwm-workspace--current-height))
|
2016-02-03 05:12:24 +01:00
|
|
|
|
(window-inside-absolute-pixel-edges
|
|
|
|
|
(get-buffer-window buffer t))))
|
2015-08-11 09:06:11 +02:00
|
|
|
|
(exwm--log "Reply with ConfigureNotify (edges): %s" edges)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:SendEvent
|
|
|
|
|
:propagate 0 :destination window
|
|
|
|
|
:event-mask xcb:EventMask:StructureNotify
|
|
|
|
|
:event (xcb:marshal
|
|
|
|
|
(make-instance
|
|
|
|
|
'xcb:ConfigureNotify
|
|
|
|
|
:event window :window window
|
|
|
|
|
: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))))
|
2016-03-06 07:28:42 +01:00
|
|
|
|
(if buffer
|
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
(exwm--log "ConfigureWindow (resize floating X window)")
|
2016-03-11 07:12:01 +01:00
|
|
|
|
(when (and (/= 0 (logand value-mask xcb:ConfigWindow:Width))
|
|
|
|
|
(>= (abs width-delta) exwm-manage--width-delta-min))
|
|
|
|
|
(set-frame-width exwm--floating-frame
|
|
|
|
|
(+ (frame-pixel-width exwm--floating-frame)
|
|
|
|
|
width-delta)
|
|
|
|
|
nil t))
|
|
|
|
|
(when (and (/= 0 (logand value-mask xcb:ConfigWindow:Height))
|
|
|
|
|
(>= (abs height-delta) exwm-manage--height-delta-min))
|
|
|
|
|
(set-frame-height exwm--floating-frame
|
|
|
|
|
(+ (frame-pixel-height exwm--floating-frame)
|
|
|
|
|
height-delta)
|
|
|
|
|
nil t)))
|
2016-03-06 07:28:42 +01:00
|
|
|
|
(exwm--log "ConfigureWindow (preserve geometry)")
|
|
|
|
|
;; Configure the unmanaged window.
|
|
|
|
|
(xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:ConfigureWindow
|
|
|
|
|
:window window
|
|
|
|
|
:value-mask value-mask
|
|
|
|
|
:x x :y y :width width :height height
|
|
|
|
|
:border-width border-width
|
|
|
|
|
:sibling sibling
|
|
|
|
|
:stack-mode stack-mode))))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:flush exwm--connection))
|
|
|
|
|
|
2015-09-04 03:09:59 +02:00
|
|
|
|
(defun exwm-manage--on-MapRequest (data _synthetic)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
"Handle MapRequest event."
|
|
|
|
|
(let ((obj (make-instance 'xcb:MapRequest)))
|
|
|
|
|
(xcb:unmarshal obj data)
|
2015-08-24 13:01:14 +02:00
|
|
|
|
(with-slots (parent window) obj
|
2015-10-29 05:22:00 +01:00
|
|
|
|
(if (assoc window exwm--id-buffer-alist)
|
2015-11-10 12:10:16 +01:00
|
|
|
|
(exwm--log "#x%x is already managed" window)
|
2015-10-29 05:22:00 +01:00
|
|
|
|
(if (/= exwm--root parent)
|
|
|
|
|
(progn (xcb:+request exwm--connection
|
|
|
|
|
(make-instance 'xcb:MapWindow :window window))
|
|
|
|
|
(xcb:flush exwm--connection))
|
|
|
|
|
(exwm--log "MapRequest from #x%x" window)
|
|
|
|
|
(exwm-manage--manage-window window))))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
2016-02-09 06:26:48 +01:00
|
|
|
|
(defun exwm-manage--on-UnmapNotify (data _synthetic)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
"Handle UnmapNotify event."
|
2016-02-09 06:26:48 +01:00
|
|
|
|
(let ((obj (make-instance 'xcb:UnmapNotify)))
|
|
|
|
|
(xcb:unmarshal obj data)
|
|
|
|
|
(with-slots (window) obj
|
|
|
|
|
(exwm--log "UnmapNotify from #x%x" window)
|
|
|
|
|
(exwm-manage--unmanage-window window t))))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
(defun exwm-manage--on-DestroyNotify (data synthetic)
|
|
|
|
|
"Handle DestroyNotify event."
|
|
|
|
|
(unless synthetic
|
|
|
|
|
(let ((obj (make-instance 'xcb:DestroyNotify)))
|
|
|
|
|
(xcb:unmarshal obj data)
|
2015-08-11 09:06:11 +02:00
|
|
|
|
(exwm--log "DestroyNotify from #x%x" (slot-value obj 'window))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(exwm-manage--unmanage-window (slot-value obj 'window)))))
|
|
|
|
|
|
|
|
|
|
(defun exwm-manage--init ()
|
|
|
|
|
"Initialize manage module."
|
2015-09-19 10:46:08 +02:00
|
|
|
|
;; Intern _MOTIF_WM_HINTS
|
|
|
|
|
(let ((atom-name "_MOTIF_WM_HINTS"))
|
|
|
|
|
(setq exwm-manage--_MOTIF_WM_HINTS
|
|
|
|
|
(slot-value (xcb:+request-unchecked+reply exwm--connection
|
|
|
|
|
(make-instance 'xcb:InternAtom
|
|
|
|
|
:only-if-exists 0
|
|
|
|
|
:name-len (length atom-name)
|
|
|
|
|
:name atom-name))
|
|
|
|
|
'atom)))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:+event exwm--connection 'xcb:ConfigureRequest
|
2015-09-04 03:09:59 +02:00
|
|
|
|
#'exwm-manage--on-ConfigureRequest)
|
|
|
|
|
(xcb:+event exwm--connection 'xcb:MapRequest #'exwm-manage--on-MapRequest)
|
|
|
|
|
(xcb:+event exwm--connection 'xcb:UnmapNotify #'exwm-manage--on-UnmapNotify)
|
2015-07-17 13:16:08 +02:00
|
|
|
|
(xcb:+event exwm--connection 'xcb:DestroyNotify
|
2015-09-04 03:09:59 +02:00
|
|
|
|
#'exwm-manage--on-DestroyNotify))
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
2016-05-23 13:13:42 +02:00
|
|
|
|
(defun exwm-manage--exit ()
|
|
|
|
|
"Exit the manage module."
|
|
|
|
|
(setq exwm-manage--_MOTIF_WM_HINTS nil))
|
|
|
|
|
|
2015-07-17 13:16:08 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(provide 'exwm-manage)
|
|
|
|
|
|
|
|
|
|
;;; exwm-manage.el ends here
|