First commit

1 files changed, 333 insertions, 0 deletions

diff --git a/exwm-manage.el b/exwm-manage.el
new file mode 100644
index 0000000000..afab18e924
--- /dev/null
+++ b/exwm-manage.el
@@ -0,0 +1,333 @@
+;;; exwm-manage.el --- Window Management Module for  -*- lexical-binding: t -*-
+;;;                    EXWM
+
+;; 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 is the fundamental module of EXWM that deals with window management.
+
+;;; Code:
+
+(require 'exwm-input)
+
+(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."
+  (exwm--with-current-id id
+    (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))))))
+
+(defun exwm-manage--manage-window (id)
+  "Manage window ID."
+  (setq exwm-input--focus-lock t)
+  (catch 'return
+    ;; Ensure it's not managed
+    (when (assoc id exwm--id-buffer-alist)
+      (throw 'return 'managed))
+    ;; 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)
+      (exwm-manage--update-geometry id)
+      ;; 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)))
+             ;; For Java applications
+             (and exwm-instance-name
+                  (string-prefix-p "sun-awt-X11-" exwm-instance-name)
+                  (not (string-suffix-p "XFramePeer" exwm-instance-name))))
+        ;; Remove all events
+        (xcb:+request-checked+request-check exwm--connection
+            (make-instance 'xcb:ChangeWindowAttributes
+                           :window id :value-mask xcb:CW:EventMask
+                           :event-mask xcb:EventMask:NoEvent))
+        ;; The window needs to be mapped
+        (xcb:+request exwm--connection
+            (make-instance xcb:MapWindow :window id))
+        (with-slots (x y width height) exwm--geometry
+          ;; Reparent to virtual root (essential)
+          (xcb:+request exwm--connection
+              (make-instance 'xcb:ReparentWindow
+                             :window id
+                             :parent (frame-parameter exwm-workspace--current
+                                                      'exwm-window-id)
+                             :x x :y y))
+          ;; 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
+                               :value-mask (logior xcb:ConfigWindow:X
+                                                   xcb:ConfigWindow:Y)
+                               :x (/ (- (x-display-pixel-width) width) 2)
+                               :y (/ (- (x-display-pixel-height) height) 2)))))
+        (xcb:flush exwm--connection)
+        (setq kill-buffer-query-functions nil)
+        (setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist))
+        (kill-buffer (current-buffer))
+        (throw 'return 'ignored))
+      ;; Manage the window
+      (xcb:+request exwm--connection    ;remove border
+          (make-instance 'xcb:ConfigureWindow
+                         :window id :value-mask xcb:ConfigWindow:BorderWidth
+                         :border-width 0))
+      (xcb:+request exwm--connection ;grab buttons for set focus/move/resize
+          (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 xcb:ButtonIndex:Any
+                         :modifiers xcb:ModMask:Any))
+      (xcb:flush exwm--connection)
+      (exwm--update-title id)
+      (exwm--update-transient-for id)
+      (exwm--update-normal-hints id)
+      (exwm--update-hints 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)
+      (exwm-workspace--update-switch-history)
+      (setq exwm-input--focus-lock nil) ;unlocked in advance
+      (with-current-buffer (exwm--id->buffer id)
+        (run-hooks 'exwm-manage-finish-hook))))
+  (setq exwm-input--focus-lock nil))
+
+(defun exwm-manage--unmanage-window (id &optional withdraw-only)
+  "Unmanage window ID."
+  (let ((buffer (exwm--id->buffer id)))
+    (setq exwm--id-buffer-alist (assq-delete-all id exwm--id-buffer-alist))
+    (when (buffer-live-p buffer)
+      (with-current-buffer buffer
+        (exwm-workspace--update-switch-history)
+        ;;
+        (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
+                                       :drawable
+                                       (frame-parameter exwm--floating-frame
+                                                        'exwm-outer-id)))
+                    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
+                             :window id :property xcb:Atom:WM_STATE))
+          (xcb:flush exwm--connection))
+        (setq kill-buffer-query-functions nil)
+        (kill-buffer)
+        (select-frame-set-input-focus exwm-workspace--current)))))
+
+(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))
+          (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.")
+
+(defun exwm-manage--close-window (id &optional buffer)
+  "Close window ID in a proper way."
+  (catch 'return
+    (unless buffer (setq buffer (exwm--id->buffer id)))
+    ;; Destroy the client window if it does not support WM_DELETE_WINDOW
+    (unless (and (buffer-live-p buffer)
+                 (with-current-buffer buffer
+                   (memq xcb:Atom:WM_DELETE_WINDOW exwm--protocols)))
+      (xcb:+request exwm--connection
+          (make-instance 'xcb:DestroyWindow :window id))
+      (xcb:flush exwm--connection)
+      (throw 'return nil))
+    ;; Try to close the window with WM_DELETE_WINDOW client message
+    (xcb:+request exwm--connection
+        (make-instance 'xcb:icccm:SendEvent
+                       :destination id
+                       :event (xcb:marshal
+                               (make-instance 'xcb:icccm:WM_DELETE_WINDOW
+                                              :window id)
+                               exwm--connection)))
+    (xcb:flush exwm--connection)
+    ;; Try to determine if the client stop responding
+    ;; FIXME: check
+    (with-current-buffer buffer
+      (when (memq xcb:Atom:_NET_WM_PING exwm--protocols)
+        (setq exwm-manage--ping-lock t)
+        (xcb:+request exwm--connection
+            (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)))
+        (xcb:flush exwm--connection)
+        (with-timeout (exwm-manage-ping-timeout
+                       (if (yes-or-no-p (format "\
+`%s' is not responding. Would you like to kill it? " (buffer-name buffer)))
+                           (progn (exwm-manage--kill-client id)
+                                  (throw 'return nil))
+                         (throw 'return nil)))
+          (while (and exwm-manage--ping-lock
+                      (exwm--id->buffer id)) ;may have be destroyed
+            (accept-process-output nil 0.1)))
+        (throw 'return nil)))
+    (throw 'return nil)))
+
+(defun exwm-manage--kill-client (&optional id)
+  "Kill an X client."
+  (interactive)
+  (unless id (setq id (exwm--buffer->id (current-buffer))))
+  (let ((pid (slot-value
+              (xcb:+request-unchecked+reply exwm--connection
+                  (make-instance 'xcb:ewmh:get-_NET_WM_PID :window id))
+              'value)))
+    (if pid
+        (signal-process pid 'SIGKILL)
+      (xcb:+request exwm--connection
+          (make-instance 'xcb:KillClient :resource id))
+      (xcb:flush exwm--connection))))
+
+(defun exwm-manage--on-ConfigureRequest (data synthetic)
+  "Handle ConfigureRequest event."
+  (let ((obj (make-instance 'xcb:ConfigureRequest))
+        buffer edges)
+    (xcb:unmarshal obj data)
+    (with-slots (window x y width height border-width) obj
+      (if (setq buffer (exwm--id->buffer window))
+          ;; Send client message for managed windows
+          (progn
+            (setq edges (or (with-current-buffer buffer exwm--floating-edges)
+                            (window-inside-absolute-pixel-edges
+                             (get-buffer-window buffer))))
+            (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))))
+        ;; Configure unmanaged windows
+        (xcb:+request exwm--connection
+            (make-instance 'xcb:ConfigureWindow
+                           :window window
+                           :value-mask (logior xcb:ConfigWindow:X
+                                               xcb:ConfigWindow:Y
+                                               xcb:ConfigWindow:Width
+                                               xcb:ConfigWindow:Height
+                                               xcb:ConfigWindow:BorderWidth)
+                           :x x :y y :width width :height height
+                           :border-width border-width)))))
+  (xcb:flush exwm--connection))
+
+(defun exwm-manage--on-MapRequest (data synthetic)
+  "Handle MapRequest event."
+  (let ((obj (make-instance 'xcb:MapRequest)))
+    (xcb:unmarshal obj data)
+    (exwm-manage--manage-window (slot-value obj 'window))))
+
+(defun exwm-manage--on-UnmapNotify (data synthetic)
+  "Handle UnmapNotify event."
+  (unless synthetic
+    (let ((obj (make-instance 'xcb:UnmapNotify)))
+      (xcb:unmarshal obj data)
+      (exwm-manage--unmanage-window (slot-value obj 'window) t))))
+
+(defun exwm-manage--on-DestroyNotify (data synthetic)
+  "Handle DestroyNotify event."
+  (unless synthetic
+    (let ((obj (make-instance 'xcb:DestroyNotify)))
+      (xcb:unmarshal obj data)
+      (exwm-manage--unmanage-window (slot-value obj 'window)))))
+
+(defun exwm-manage--init ()
+  "Initialize manage module."
+  (xcb:+event exwm--connection 'xcb:ConfigureRequest
+              'exwm-manage--on-ConfigureRequest)
+  (xcb:+event exwm--connection 'xcb:MapRequest 'exwm-manage--on-MapRequest)
+  (xcb:+event exwm--connection 'xcb:UnmapNotify 'exwm-manage--on-UnmapNotify)
+  (xcb:+event exwm--connection 'xcb:DestroyNotify
+              'exwm-manage--on-DestroyNotify))
+
+
+
+(provide 'exwm-manage)
+
+;;; exwm-manage.el ends here