[elpa] externals/exwm 86764d2 07/64: Add basic RandR support

[Chris Feng]

branch: externals/exwm
commit 86764d27a333be53336cf2e38d237c7bfa218e7b
Author: Chris Feng <address@hidden>
Commit: Chris Feng <address@hidden>

    Add basic RandR support
    
    This implementation is analogous to that in i3-wm, which requires external
    tools to properly configure RandR first.
---
 exwm-randr.el     |  131 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 exwm-workspace.el |   78 +++++++++++++++++++++-----------
 exwm.el           |    3 +-
 3 files changed, 184 insertions(+), 28 deletions(-)

diff --git a/exwm-randr.el b/exwm-randr.el
new file mode 100644
index 0000000..c9ad1ce
--- /dev/null
+++ b/exwm-randr.el
@@ -0,0 +1,131 @@
+;;; exwm-randr.el --- RandR Module for EXWM  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Chris Feng
+
+;; Author: Chris Feng <address@hidden>
+;; 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 adds RandR support for EXWM. Currently it requires external
+;; tools such as xrandr(1) to properly configure RandR first. This dependency
+;; may be removed in the future, but more work is needed before that.
+
+;; To use this module, first set `exwm-randr-workspace-output-plist':
+;;   (setq exwm-randr-workspace-output-plist '(0 "VGA1"))
+;; Then configure RandR with 'xrandr':
+;;   $ xrandr --output VGA1 --left-of LVDS1 --auto
+;; With above lines, workspace 0 should be assigned to the output named "VGA1",
+;; staying at the left of other workspaces on the output "LVDS1".
+
+;; Todo:
+;; + Update EWMH hints.
+
+;; References:
+;; + RandR (http://www.x.org/archive/X11R7.7/doc/randrproto/randrproto.txt)
+
+;;; Code:
+
+(require 'xcb-randr)
+
+(defvar exwm-randr-workspace-output-plist nil)
+
+(defun exwm-randr--refresh ()
+  "Refresh workspaces according to the updated RandR info."
+  (let (output-plist default-geometry)
+    ;; Query all outputs
+    (with-slots (config-timestamp outputs)
+        (xcb:+request-unchecked+reply exwm--connection
+            (make-instance 'xcb:randr:GetScreenResources
+                           :window exwm--root))
+      (dolist (output outputs)
+        (with-slots (crtc connection name)
+            (xcb:+request-unchecked+reply exwm--connection
+                (make-instance 'xcb:randr:GetOutputInfo
+                               :output output
+                               :config-timestamp config-timestamp))
+          (setq name                    ;UTF-8 encoded
+                (decode-coding-string (apply 'unibyte-string name) 'utf-8))
+          (if (or (/= connection xcb:randr:Connection:Connected)
+                  (= 0 crtc))           ;FIXME
+              (plist-put output-plist name nil)
+            (with-slots (x y width height)
+                (xcb:+request-unchecked+reply exwm--connection
+                    (make-instance 'xcb:randr:GetCrtcInfo
+                                   :crtc crtc
+                                   :config-timestamp config-timestamp))
+              (setq output-plist (plist-put output-plist name
+                                            (vector x y width height)))
+              (unless default-geometry ;assume the first output as primary
+                (setq default-geometry (vector x y width height))))))))
+    (cl-assert (<= 2 (length output-plist)))
+    (dotimes (i exwm-workspace-number)
+      (let* ((output (plist-get exwm-randr-workspace-output-plist i))
+             (geometry (lax-plist-get output-plist output))
+             (frame (elt exwm-workspace--list i)))
+        (unless geometry
+          (setq geometry default-geometry
+                output nil))
+        (set-frame-parameter frame 'exwm-randr-output output)
+        (xcb:+request exwm--connection
+            (make-instance 'xcb:ConfigureWindow
+                           :window (frame-parameter frame 'exwm-outer-id)
+                           :value-mask (logior xcb:ConfigWindow:X
+                                               xcb:ConfigWindow:Y
+                                               xcb:ConfigWindow:Width
+                                               xcb:ConfigWindow:Height)
+                           :x (elt geometry 0) :y (elt geometry 1)
+                           :width (elt geometry 2) :height (elt geometry 3)))))
+    (xcb:flush exwm--connection)))
+
+(defun exwm-randr--init ()
+  "Initialize RandR extension and EXWM RandR module."
+  (if (= 0 (slot-value (xcb:get-extension-data exwm--connection 'xcb:randr)
+                       'present))
+      (error "[EXWM] RandR extension is not supported by the server")
+    (with-slots (major-version minor-version)
+        (xcb:+request-unchecked+reply exwm--connection
+            (make-instance 'xcb:randr:QueryVersion
+                           :major-version 1 :minor-version 2))
+      (if (or (/= major-version 1) (< minor-version 2))
+          (error "[EXWM] The server only support RandR version up to %d.%d"
+                 major-version minor-version)
+        (exwm-randr--refresh)
+        (xcb:+event exwm--connection 'xcb:randr:ScreenChangeNotify
+                    (lambda (data synthetic)
+                      (exwm-randr--refresh)))
+        ;; (xcb:+event exwm--connection 'xcb:randr:Notify
+        ;;             (lambda (data synthetic)
+        ;;               (exwm-randr--refresh)))
+        (xcb:+request exwm--connection
+            (make-instance 'xcb:randr:SelectInput
+                           :window exwm--root
+                           :enable xcb:randr:NotifyMask:ScreenChange
+                           ;; :enable (logior
+                           ;;          xcb:randr:NotifyMask:ScreenChange
+                           ;;          xcb:randr:NotifyMask:OutputChange
+                           ;;          xcb:randr:NotifyMask:OutputProperty
+                           ;;          xcb:randr:NotifyMask:CrtcChange)
+                           ))
+        (xcb:flush exwm--connection)))))
+
+
+
+(provide 'exwm-randr)
+
+;;; exwm-randr.el ends here
diff --git a/exwm-workspace.el b/exwm-workspace.el
index b46b2e8..160055f 100644
--- a/exwm-workspace.el
+++ b/exwm-workspace.el
@@ -90,11 +90,12 @@
 
 (defvar exwm-workspace--current nil "Current active workspace.")
 (defvar exwm-workspace-current-index 0 "Index of current active workspace.")
+(defvar exwm-workspace--switch-lock nil "Non-nil to prevent workspace switch.")
 
 (defun exwm-workspace-switch (index &optional force)
   "Switch to workspace INDEX. Query for INDEX if it's not specified.
 
-The optional FORCE option is for internal use only "
+The optional FORCE option is for internal use only."
   (interactive
    (list
     (let* ((history-add-new-input nil)  ;prevent modifying history
@@ -105,32 +106,53 @@ The optional FORCE option is for internal use only "
                  `(exwm-workspace--switch-history
                    . ,(1+ exwm-workspace-current-index)))))
       (cl-position idx exwm-workspace--switch-history :test 'equal))))
-  (unless (and (<= 0 index) (< index exwm-workspace-number))
-    (user-error "[EXWM] Workspace index out of range: %d" index))
-  (when (or force (/= exwm-workspace-current-index index))
-    (select-frame-set-input-focus (elt exwm-workspace--list index))
-    ;; Hide all workspaces but the selected one
-    (dotimes (i exwm-workspace-number)
-      (unless (= i index) (make-frame-invisible (elt exwm-workspace--list i))))
-    (setq exwm-workspace--current (elt exwm-workspace--list index)
-          exwm-workspace-current-index index)
-    (setq default-minibuffer-frame (selected-frame))
-    ;; Hide windows in other workspaces by preprending a space
-    (dolist (i exwm--id-buffer-alist)
-      (with-current-buffer (cdr i)
-        (let ((name (replace-regexp-in-string "^\\s-*" "" (buffer-name))))
-          (exwm-workspace-rename-buffer (if (eq (selected-frame) exwm--frame)
-                                            name
-                                          (concat " " name))))))
-    ;; Update demands attention flag
-    (set-frame-parameter (selected-frame) 'exwm--urgency nil)
-    ;; Update switch workspace history
-    (exwm-workspace--update-switch-history)
-    ;; Update _NET_CURRENT_DESKTOP
-    (xcb:+request exwm--connection
-        (make-instance 'xcb:ewmh:set-_NET_CURRENT_DESKTOP
-                       :window exwm--root :data index))
-    (xcb:flush exwm--connection)))
+  (unless exwm-workspace--switch-lock
+    (setq exwm-workspace--switch-lock t)
+    (unless (and (<= 0 index) (< index exwm-workspace-number))
+      (user-error "[EXWM] Workspace index out of range: %d" index))
+    (when (or force (/= exwm-workspace-current-index index))
+      (let ((frame (elt exwm-workspace--list index)))
+        (setq exwm-workspace--current frame
+              exwm-workspace-current-index index)
+        (select-frame-set-input-focus frame)
+        (exwm--make-emacs-idle-for 0.1) ;FIXME
+        ;; Move mouse when necessary
+        (let ((position (mouse-pixel-position))
+              x y w h)
+          (unless (eq frame (car position))
+            (setq x (cadr position)
+                  y (cddr position)
+                  w (frame-pixel-width frame)
+                  h (frame-pixel-height frame))
+            (when (or (> x w) (> y h))
+              (setq x (/ w 2)
+                    y (/ h 2)))
+            (set-mouse-pixel-position frame x y)))
+        (setq default-minibuffer-frame frame)
+        ;; Hide windows in other workspaces by preprending a space
+        (dolist (i exwm--id-buffer-alist)
+          (with-current-buffer (cdr i)
+            (let ((name (replace-regexp-in-string "^\\s-*" "" (buffer-name))))
+              (exwm-workspace-rename-buffer (if (eq frame exwm--frame)
+                                                name
+                                              (concat " " name))))))
+        ;; Update demands attention flag
+        (set-frame-parameter frame 'exwm--urgency nil)
+        ;; Update switch workspace history
+        (exwm-workspace--update-switch-history)
+        ;; Update _NET_CURRENT_DESKTOP
+        (xcb:+request exwm--connection
+            (make-instance 'xcb:ewmh:set-_NET_CURRENT_DESKTOP
+                           :window exwm--root :data index))
+        (xcb:flush exwm--connection)))
+    (setq exwm-workspace--switch-lock nil)))
+
+(defun exwm-workspace--on-focus-in ()
+  "Fix unexpected frame switch."
+  (unless exwm-workspace--switch-lock
+    (let ((index (cl-position (selected-frame) exwm-workspace--list)))
+      (when (and index (/= index exwm-workspace-current-index))
+        (exwm-workspace-switch index)))))
 
 (defun exwm-workspace-move-window (index &optional id)
   "Move window ID to workspace INDEX."
@@ -228,6 +250,8 @@ The optional FORCE option is for internal use only "
                          :window window-id :value-mask xcb:CW:EventMask
                          :event-mask xcb:EventMask:SubstructureRedirect))))
   (xcb:flush exwm--connection)
+  ;; Handle unexpected frame switch
+  (add-hook 'focus-in-hook 'exwm-workspace--on-focus-in)
   ;; Switch to the first workspace
   (exwm-workspace-switch 0 t))
 
diff --git a/exwm.el b/exwm.el
index c6e0059..a38744f 100644
--- a/exwm.el
+++ b/exwm.el
@@ -125,7 +125,6 @@
 ;; XEmacs, though it seems nobody have ever got it working on GNU Emacs.
 
 ;; Todo:
-;; + Add RandR support.
 ;; + Investigate DnD support (e.g. drag a chromium tab to another window).
 ;; + Auto hide minibuffer, or allow users to place it elsewhere.
 ;; + Add system tray support.
@@ -145,6 +144,7 @@
 (require 'exwm-floating)
 (require 'exwm-manage)
 (require 'exwm-input)
+(require 'exwm-randr)
 
 (defvar exwm-debug-on nil "Non-nil to turn on debug for EXWM.")
 
@@ -618,6 +618,7 @@
         (exwm-floating--init)
         (exwm-manage--init)
         (exwm-input--init)
+        (exwm-randr--init)
         (exwm--unlock)
         ;; Disable events during new frame creation
         (add-hook 'before-make-frame-hook 'exwm--lock)