tvl-depot/exwm-layout.el

;;; exwm-layout.el --- Layout Module for EXWM  -*- lexical-binding: t -*-

;; Copyright (C) 2015-2018 Free Software Foundation, Inc.

;; Author: Chris Feng <chris.w.feng@gmail.com>

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This module is responsible for keeping X client window properly displayed.

;;; Code:

(require 'exwm-core)

(defgroup exwm-layout nil
  "Layout."
  :version "25.3"
  :group 'exwm)

(defcustom exwm-layout-show-all-buffers nil
  "Non-nil to allow switching to buffers on other workspaces."
  :type 'boolean)

(defvar exwm-layout--other-buffer-exclude-buffers nil
  "List of buffers that should not be selected by `other-buffer'.")

(defvar exwm-layout--other-buffer-exclude-exwm-mode-buffers nil
  "When non-nil, prevent EXWM buffers from being selected by `other-buffer'.")

(defvar exwm-layout--timer nil "Timer used to track echo area changes.")

(defvar exwm-workspace--current)
(declare-function exwm-input--release-keyboard "exwm-input.el")
(declare-function exwm-input--grab-keyboard "exwm-input.el")
(declare-function exwm-input-grab-keyboard "exwm-input.el")
(declare-function exwm-workspace--active-p "exwm-workspace.el" (frame))
(declare-function exwm-workspace--client-p "exwm-workspace.el"
                  (&optional frame))
(declare-function exwm-workspace--minibuffer-own-frame-p "exwm-workspace.el")
(declare-function exwm-workspace--workspace-p "exwm-workspace.el"
                  (workspace))
(declare-function exwm-workspace-move-window "exwm-workspace.el"
                  (frame-or-index &optional id))

(defun exwm-layout--set-state (id state)
  "Set WM_STATE."
  (exwm--log "id=#x%x" id)
  (xcb:+request exwm--connection
      (make-instance 'xcb:icccm:set-WM_STATE
                     :window id :state state :icon xcb:Window:None))
  (with-current-buffer (exwm--id->buffer id)
    (setq exwm-state state)))

(defun exwm-layout--iconic-state-p (&optional id)
  (= xcb:icccm:WM_STATE:IconicState
     (if id
         (buffer-local-value 'exwm-state (exwm--id->buffer id))
       exwm-state)))

(defun exwm-layout--fullscreen-p ()
  (when (derived-mode-p 'exwm-mode)
    (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state)))

(defun exwm-layout--show (id &optional window)
  "Show window ID exactly fit in the Emacs window WINDOW."
  (exwm--log "Show #x%x in %s" id window)
  (let* ((edges (window-inside-absolute-pixel-edges window))
         (x (pop edges))
         (y (pop edges))
         (width (- (pop edges) x))
         (height (- (pop edges) y))
         frame-x frame-y frame-width frame-height)
    (with-current-buffer (exwm--id->buffer id)
      (when exwm--floating-frame
        (setq frame-width (frame-pixel-width exwm--floating-frame)
              frame-height (frame-pixel-height exwm--floating-frame))
        (when exwm--floating-frame-position
          (setq frame-x (elt exwm--floating-frame-position 0)
                frame-y (elt exwm--floating-frame-position 1)
                ;; The frame was placed at (-1, -1).
                x (+ x frame-x 1)
                y (+ y frame-y 1))
          (setq exwm--floating-frame-position nil))
        (exwm--set-geometry (frame-parameter exwm--floating-frame
                                             'exwm-container)
                            frame-x frame-y frame-width frame-height))
      (when (exwm-layout--fullscreen-p)
        (with-slots ((x* x)
                     (y* y)
                     (width* width)
                     (height* height))
            (exwm-workspace--get-geometry exwm--frame)
          (setq x x*
                y y*
                width width*
                height height*)))
      (exwm--set-geometry id x y width height)
      (xcb:+request exwm--connection (make-instance 'xcb:MapWindow :window id))
      (exwm-layout--set-state id xcb:icccm:WM_STATE:NormalState)))
  (xcb:flush exwm--connection))

(defun exwm-layout--hide (id)
  "Hide window ID."
  (with-current-buffer (exwm--id->buffer id)
    (unless (or (exwm-layout--iconic-state-p)
                (and exwm--floating-frame
                     (eq 4294967295. exwm--desktop)))
      (exwm--log "Hide #x%x" id)
      (when exwm--floating-frame
        (let* ((container (frame-parameter exwm--floating-frame
                                           'exwm-container))
               (geometry (xcb:+request-unchecked+reply exwm--connection
                             (make-instance 'xcb:GetGeometry
                                            :drawable container))))
          (setq exwm--floating-frame-position
                (vector (slot-value geometry 'x) (slot-value geometry 'y)))
          (exwm--set-geometry container -1 -1 1 1)))
      (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:UnmapWindow :window id))
      (xcb:+request exwm--connection
          (make-instance 'xcb:ChangeWindowAttributes
                         :window id :value-mask xcb:CW:EventMask
                         :event-mask exwm--client-event-mask))
      (exwm-layout--set-state id xcb:icccm:WM_STATE:IconicState)
      (xcb:flush exwm--connection))))

;;;###autoload
(cl-defun exwm-layout-set-fullscreen (&optional id)
  "Make window ID fullscreen."
  (interactive)
  (exwm--log "id=#x%x" (or id 0))
  (unless (and (or id (derived-mode-p 'exwm-mode))
               (not (exwm-layout--fullscreen-p)))
    (cl-return-from exwm-layout-set-fullscreen))
  (with-current-buffer (if id (exwm--id->buffer id) (window-buffer))
    ;; Expand the X window to fill the whole screen.
    (with-slots (x y width height) (exwm-workspace--get-geometry exwm--frame)
      (exwm--set-geometry exwm--id x y width height))
    ;; Raise the X window.
    (xcb:+request exwm--connection
        (make-instance 'xcb:ConfigureWindow
                       :window exwm--id
                       :value-mask (logior xcb:ConfigWindow:BorderWidth
                                           xcb:ConfigWindow:StackMode)
                       :border-width 0
                       :stack-mode xcb:StackMode:Above))
    (xcb:+request exwm--connection
        (make-instance 'xcb:ewmh:set-_NET_WM_STATE
                       :window exwm--id
                       :data (vector xcb:Atom:_NET_WM_STATE_FULLSCREEN)))
    (xcb:flush exwm--connection)
    (set-window-dedicated-p (get-buffer-window) t)
    (cl-pushnew xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state)
    (exwm-input--release-keyboard exwm--id)))

;;;###autoload
(cl-defun exwm-layout-unset-fullscreen (&optional id)
  "Restore window from fullscreen state."
  (interactive)
  (exwm--log "id=#x%x" (or id 0))
  (unless (and (or id (derived-mode-p 'exwm-mode))
               (exwm-layout--fullscreen-p))
    (cl-return-from exwm-layout-unset-fullscreen))
  (with-current-buffer (if id (exwm--id->buffer id) (window-buffer))
    (setq exwm--ewmh-state
          (delq xcb:Atom:_NET_WM_STATE_FULLSCREEN exwm--ewmh-state))
    (if exwm--floating-frame
        (exwm-layout--show exwm--id (frame-root-window exwm--floating-frame))
      (xcb:+request exwm--connection
          (make-instance 'xcb:ConfigureWindow
                         :window exwm--id
                         :value-mask (logior xcb:ConfigWindow:Sibling
                                             xcb:ConfigWindow:StackMode)
                         :sibling exwm--guide-window
                         :stack-mode xcb:StackMode:Above))
      (let ((window (get-buffer-window nil t)))
        (when window
          (exwm-layout--show exwm--id window))))
    (xcb:+request exwm--connection
        (make-instance 'xcb:ewmh:set-_NET_WM_STATE :window exwm--id :data []))
    (xcb:flush exwm--connection)
    (set-window-dedicated-p (get-buffer-window) nil)
    (when exwm--keyboard-grabbed
      (exwm-input--grab-keyboard exwm--id))))

;;;###autoload
(cl-defun exwm-layout-toggle-fullscreen (&optional id)
  "Toggle fullscreen mode."
  (interactive (list (exwm--buffer->id (window-buffer))))
  (exwm--log "id=#x%x" (or id 0))
  (unless (or id (derived-mode-p 'exwm-mode))
    (cl-return-from exwm-layout-toggle-fullscreen))
  (when id
    (with-current-buffer (exwm--id->buffer id)
      (if (exwm-layout--fullscreen-p)
          (exwm-layout-unset-fullscreen id)
        (exwm-layout-set-fullscreen id)))))

(defun exwm-layout--other-buffer-predicate (buffer)
  "Return non-nil when the BUFFER may be displayed in selected frame.

Prevents EXWM-mode buffers already being displayed on some other window from
being selected.

Should be set as `buffer-predicate' frame parameter for all
frames.  Used by `other-buffer'.

When variable `exwm-layout--other-buffer-exclude-exwm-mode-buffers'
is t EXWM buffers are never selected by `other-buffer'.

When variable `exwm-layout--other-buffer-exclude-buffers' is a
list of buffers, EXWM buffers belonging to that list are never
selected by `other-buffer'."
  (or (not (with-current-buffer buffer (derived-mode-p 'exwm-mode)))
      (and (not exwm-layout--other-buffer-exclude-exwm-mode-buffers)
           (not (memq buffer exwm-layout--other-buffer-exclude-buffers))
           ;; Do not select if already shown in some window.
           (not (get-buffer-window buffer t)))))

(defun exwm-layout--set-client-list-stacking ()
  "Set _NET_CLIENT_LIST_STACKING."
  (exwm--log)
  (let (id clients-floating clients clients-iconic clients-other)
    (dolist (pair exwm--id-buffer-alist)
      (setq id (car pair))
      (with-current-buffer (cdr pair)
        (if (eq exwm--frame exwm-workspace--current)
            (if exwm--floating-frame
                ;; A floating X window on the current workspace.
                (setq clients-floating (cons id clients-floating))
              (if (get-buffer-window (cdr pair) exwm-workspace--current)
                  ;; A normal tilling X window on the current workspace.
                  (setq clients (cons id clients))
                ;; An iconic tilling X window on the current workspace.
                (setq clients-iconic (cons id clients-iconic))))
          ;; X window on other workspaces.
          (setq clients-other (cons id clients-other)))))
    (xcb:+request exwm--connection
        (make-instance 'xcb:ewmh:set-_NET_CLIENT_LIST_STACKING
                       :window exwm--root
                       :data (vconcat (append clients-other clients-iconic
                                              clients clients-floating))))))

(defun exwm-layout--refresh (&optional frame)
  "Refresh layout."
  ;; `window-size-change-functions' sets this argument while
  ;; `window-configuration-change-hook' makes the frame selected.
  (unless frame
    (setq frame (selected-frame)))
  (exwm--log "frame=%s" frame)
  (if (not (exwm-workspace--workspace-p frame))
      (if (frame-parameter frame 'exwm-outer-id)
          (exwm-layout--refresh-floating frame)
        (exwm-layout--refresh-other frame))
    (exwm-layout--refresh-workspace frame)))

(defun exwm-layout--refresh-floating (frame)
  "Refresh floating frame FRAME."
  (exwm--log "Refresh floating %s" frame)
  (let ((window (frame-first-window frame)))
    (with-current-buffer (window-buffer window)
      (when (and (derived-mode-p 'exwm-mode)
                 ;; It may be a buffer waiting to be killed.
                 (exwm--id->buffer exwm--id))
        (exwm--log "Refresh floating window #x%x" exwm--id)
        (if (exwm-workspace--active-p exwm--frame)
            (exwm-layout--show exwm--id window)
          (exwm-layout--hide exwm--id))))))

(defun exwm-layout--refresh-other (frame)
  "Refresh client or nox frame FRAME."
  ;; Other frames (e.g. terminal/graphical frame of emacsclient)
  ;; We shall bury all `exwm-mode' buffers in this case
  (exwm--log "Refresh other %s" frame)
  (let ((windows (window-list frame 'nomini)) ;exclude minibuffer
        (exwm-layout--other-buffer-exclude-exwm-mode-buffers t))
    (dolist (window windows)
      (with-current-buffer (window-buffer window)
        (when (derived-mode-p 'exwm-mode)
          (switch-to-prev-buffer window))))))

(defun exwm-layout--refresh-workspace (frame)
  "Refresh workspace frame FRAME."
  (exwm--log "Refresh workspace %s" frame)
  ;; Workspaces other than the active one can also be refreshed (RandR)
  (let (covered-buffers   ;EXWM-buffers covered by a new X window.
        vacated-windows)  ;Windows previously displaying EXWM-buffers.
    (dolist (pair exwm--id-buffer-alist)
      (with-current-buffer (cdr pair)
        (when (and (not exwm--floating-frame) ;exclude floating X windows
                   (or exwm-layout-show-all-buffers
                       ;; Exclude X windows on other workspaces
                       (eq frame exwm--frame)))
          (let (;; List of windows in current frame displaying the `exwm-mode'
                ;; buffers.
                (windows (get-buffer-window-list (current-buffer) 'nomini
                                                 frame)))
            (if (not windows)
                (when (eq frame exwm--frame)
                  ;; Hide it if it was being shown in this workspace.
                  (exwm-layout--hide exwm--id))
              (let ((window (car windows)))
                (if (eq frame exwm--frame)
                    (when (exwm-workspace--active-p frame)
                      ;; Show it if `frame' is active.
                      (exwm-layout--show exwm--id window))
                  ;; It was last shown in other workspace; move it here.
                  (exwm-workspace-move-window frame exwm--id))
                ;; Vacate any other windows (in any workspace) showing this
                ;; `exwm-mode' buffer.
                (setq vacated-windows
                      (append vacated-windows (remove
                                               window
                                               (get-buffer-window-list
                                                (current-buffer) 'nomini t))))
                ;; Note any `exwm-mode' buffer is being covered by another
                ;; `exwm-mode' buffer.  We want to avoid that `exwm-mode'
                ;; buffer to be reappear in any of the vacated windows.
                (let ((prev-buffer (car-safe
                                    (car-safe (window-prev-buffers window)))))
                  (and
                   prev-buffer
                   (with-current-buffer prev-buffer
                     (derived-mode-p 'exwm-mode))
                   (push prev-buffer covered-buffers)))))))))
    ;; Set some sensible buffer to vacated windows.
    (let ((exwm-layout--other-buffer-exclude-buffers covered-buffers))
      (dolist (window vacated-windows)
        (switch-to-prev-buffer window)))
    ;; Make sure windows floating / on other workspaces are excluded
    (let ((exwm-layout--other-buffer-exclude-exwm-mode-buffers t))
      (dolist (window (window-list frame 'nomini))
        (with-current-buffer (window-buffer window)
          (when (and (derived-mode-p 'exwm-mode)
                     (or exwm--floating-frame (not (eq frame exwm--frame))))
            (switch-to-prev-buffer window)))))
    (exwm-layout--set-client-list-stacking)
    (xcb:flush exwm--connection)))

(defun exwm-layout--on-minibuffer-setup ()
  "Refresh layout when minibuffer grows."
  (exwm--log)
  (unless (exwm-workspace--client-p)
    (exwm--defer 0 (lambda ()
                     (when (< 1 (window-height (minibuffer-window)))
                       (exwm-layout--refresh))))))

(defun exwm-layout--on-echo-area-change (&optional dirty)
  "Run when message arrives or in `echo-area-clear-hook' to refresh layout."
  (when (and (current-message)
             (not (exwm-workspace--client-p))
             (or (cl-position ?\n (current-message))
                 (> (length (current-message))
                    (frame-width exwm-workspace--current))))
    (exwm--log)
    (if dirty
        (exwm-layout--refresh)
      (exwm--defer 0 #'exwm-layout--refresh))))

;;;###autoload
(defun exwm-layout-enlarge-window (delta &optional horizontal)
  "Make the selected window DELTA pixels taller.

If no argument is given, make the selected window one pixel taller.  If the
optional argument HORIZONTAL is non-nil, make selected window DELTA pixels
wider.  If DELTA is negative, shrink selected window by -DELTA pixels.

Normal hints are checked and regarded if the selected window is displaying an
`exwm-mode' buffer.  However, this may violate the normal hints set on other X
windows."
  (interactive "p")
  (exwm--log)
  (cond
   ((zerop delta))                     ;no operation
   ((window-minibuffer-p))             ;avoid resize minibuffer-window
   ((not (and (derived-mode-p 'exwm-mode) exwm--floating-frame))
    ;; Resize on tiling layout
    (unless (= 0 (window-resizable nil delta horizontal nil t)) ;not resizable
      (let ((window-resize-pixelwise t))
        (window-resize nil delta horizontal nil t))))
   ;; Resize on floating layout
   (exwm--fixed-size)                   ;fixed size
   (horizontal
    (let* ((width (frame-pixel-width))
           (edges (window-inside-pixel-edges))
           (inner-width (- (elt edges 2) (elt edges 0)))
           (margin (- width inner-width)))
      (if (> delta 0)
          (if (not exwm--normal-hints-max-width)
              (cl-incf width delta)
            (if (>= inner-width exwm--normal-hints-max-width)
                (setq width nil)
              (setq width (min (+ exwm--normal-hints-max-width margin)
                               (+ width delta)))))
        (if (not exwm--normal-hints-min-width)
            (cl-incf width delta)
          (if (<= inner-width exwm--normal-hints-min-width)
              (setq width nil)
            (setq width (max (+ exwm--normal-hints-min-width margin)
                             (+ width delta))))))
      (when (and width (> width 0))
        (setf (slot-value exwm--geometry 'width) width)
        (xcb:+request exwm--connection
            (make-instance 'xcb:ConfigureWindow
                           :window (frame-parameter exwm--floating-frame
                                                    'exwm-outer-id)
                           :value-mask xcb:ConfigWindow:Width
                           :width width))
        (xcb:+request exwm--connection
            (make-instance 'xcb:ConfigureWindow
                           :window (frame-parameter exwm--floating-frame
                                                    'exwm-container)
                           :value-mask xcb:ConfigWindow:Width
                           :width width))
        (xcb:flush exwm--connection))))
   (t
    (let* ((height (frame-pixel-height))
           (edges (window-inside-pixel-edges))
           (inner-height (- (elt edges 3) (elt edges 1)))
           (margin (- height inner-height)))
      (if (> delta 0)
          (if (not exwm--normal-hints-max-height)
              (cl-incf height delta)
            (if (>= inner-height exwm--normal-hints-max-height)
                (setq height nil)
              (setq height (min (+ exwm--normal-hints-max-height margin)
                                (+ height delta)))))
        (if (not exwm--normal-hints-min-height)
            (cl-incf height delta)
          (if (<= inner-height exwm--normal-hints-min-height)
              (setq height nil)
            (setq height (max (+ exwm--normal-hints-min-height margin)
                              (+ height delta))))))
      (when (and height (> height 0))
        (setf (slot-value exwm--geometry 'height) height)
        (xcb:+request exwm--connection
            (make-instance 'xcb:ConfigureWindow
                           :window (frame-parameter exwm--floating-frame
                                                    'exwm-outer-id)
                           :value-mask xcb:ConfigWindow:Height
                           :height height))
        (xcb:+request exwm--connection
            (make-instance 'xcb:ConfigureWindow
                           :window (frame-parameter exwm--floating-frame
                                                    'exwm-container)
                           :value-mask xcb:ConfigWindow:Height
                           :height height))
        (xcb:flush exwm--connection))))))

;;;###autoload
(defun exwm-layout-enlarge-window-horizontally (delta)
  "Make the selected window DELTA pixels wider.

See also `exwm-layout-enlarge-window'."
  (interactive "p")
  (exwm-layout-enlarge-window delta t))

;;;###autoload
(defun exwm-layout-shrink-window (delta)
  "Make the selected window DELTA pixels lower.

See also `exwm-layout-enlarge-window'."
  (interactive "p")
  (exwm-layout-enlarge-window (- delta)))

;;;###autoload
(defun exwm-layout-shrink-window-horizontally (delta)
  "Make the selected window DELTA pixels narrower.

See also `exwm-layout-enlarge-window'."
  (interactive "p")
  (exwm-layout-enlarge-window (- delta) t))

;;;###autoload
(defun exwm-layout-hide-mode-line ()
  "Hide mode-line."
  (interactive)
  (exwm--log)
  (when (and (derived-mode-p 'exwm-mode) mode-line-format)
    (let (mode-line-height)
      (when exwm--floating-frame
        (setq mode-line-height (window-mode-line-height
                                (frame-root-window exwm--floating-frame))))
      (setq exwm--mode-line-format mode-line-format
            mode-line-format nil)
      (if (not exwm--floating-frame)
          (exwm-layout--show exwm--id)
        (set-frame-height exwm--floating-frame
                          (- (frame-pixel-height exwm--floating-frame)
                             mode-line-height)
                          nil t)))))

;;;###autoload
(defun exwm-layout-show-mode-line ()
  "Show mode-line."
  (interactive)
  (exwm--log)
  (when (and (derived-mode-p 'exwm-mode) (not mode-line-format))
    (setq mode-line-format exwm--mode-line-format
          exwm--mode-line-format nil)
    (if (not exwm--floating-frame)
        (exwm-layout--show exwm--id)
      (set-frame-height exwm--floating-frame
                        (+ (frame-pixel-height exwm--floating-frame)
                           (window-mode-line-height (frame-root-window
                                                     exwm--floating-frame)))
                        nil t)
      (call-interactively #'exwm-input-grab-keyboard))
    (force-mode-line-update)))

;;;###autoload
(defun exwm-layout-toggle-mode-line ()
  "Toggle the display of mode-line."
  (interactive)
  (exwm--log)
  (when (derived-mode-p 'exwm-mode)
    (if mode-line-format
        (exwm-layout-hide-mode-line)
      (exwm-layout-show-mode-line))))

(defun exwm-layout--init ()
  "Initialize layout module."
  ;; Auto refresh layout
  (exwm--log)
  (add-hook 'window-configuration-change-hook #'exwm-layout--refresh)
  ;; The behavior of `window-configuration-change-hook' will be changed.
  (when (fboundp 'window-pixel-width-before-size-change)
    (add-hook 'window-size-change-functions #'exwm-layout--refresh))
  (unless (exwm-workspace--minibuffer-own-frame-p)
    ;; Refresh when minibuffer grows
    (add-hook 'minibuffer-setup-hook #'exwm-layout--on-minibuffer-setup t)
    (setq exwm-layout--timer
          (run-with-idle-timer 0 t #'exwm-layout--on-echo-area-change t))
    (add-hook 'echo-area-clear-hook #'exwm-layout--on-echo-area-change)))

(defun exwm-layout--exit ()
  "Exit the layout module."
  (exwm--log)
  (remove-hook 'window-configuration-change-hook #'exwm-layout--refresh)
  (when (fboundp 'window-pixel-width-before-size-change)
    (remove-hook 'window-size-change-functions #'exwm-layout--refresh))
  (remove-hook 'minibuffer-setup-hook #'exwm-layout--on-minibuffer-setup)
  (when exwm-layout--timer
    (cancel-timer exwm-layout--timer)
    (setq exwm-layout--timer nil))
  (remove-hook 'echo-area-clear-hook #'exwm-layout--on-echo-area-change))



(provide 'exwm-layout)

;;; exwm-layout.el ends here