Add basic RandR support
This implementation is analogous to that in i3-wm, which requires external tools to properly configure RandR first.
This commit is contained in:
		
							parent
							
								
									f4416a10e3
								
							
						
					
					
						commit
						86764d27a3
					
				
					 3 changed files with 184 additions and 28 deletions
				
			
		
							
								
								
									
										131
									
								
								exwm-randr.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										131
									
								
								exwm-randr.el
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -0,0 +1,131 @@
 | 
			
		|||
;;; exwm-randr.el --- RandR 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 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
 | 
			
		||||
| 
						 | 
				
			
			@ -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))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										3
									
								
								exwm.el
									
										
									
									
									
								
							
							
						
						
									
										3
									
								
								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)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue