Use X window borders

; This commit replaces the internal borders of Emacs frames with X
; window borders.  This should make the flickering issue of floating X
; windows less serious.

* exwm-floating.el (exwm-floating--border-pixel)
(exwm-floating--border-colormap): New variables for storing border pixel
and its colormap.
(exwm-floating--set-floating): Do not set the internal border (and
background color) of floating frames; do not take
`exwm-floating-border-width' into account when calculating geometries;
set the border of floating X window containers.
(exwm-floating--unset-floating): No need to restore the position of X
windows any more; hide the border of floating X window containers.
(exwm-floating--init): Initialize the border pixel.
* exwm-layout.el (exwm-layout-set-fullscreen)
(exwm-layout-unset-fullscreen): Show/Hide container border respectively.
* exwm-manage.el (exwm-manage--manage-window): Set the border pixel and
colormap of X window containers.
* exwm-workspace.el (exwm-workspace-move-window): Do not set the
internal border and background color of floating frames.
* exwm.el (exwm--on-ClientMessage): Simplify the code for calculating
_NET_REQUEST_FRAME_EXTENTS.

5 files changed, 66 insertions, 36 deletions

diff --git a/exwm-floating.el b/exwm-floating.el
index 5b8cc89abc26..1780e5fc323b 100644
--- a/exwm-floating.el
+++ b/exwm-floating.el
@@ -32,6 +32,12 @@
 (defvar exwm-floating-border-width 1 "Border width of the floating window.")
 (defvar exwm-floating-border-color "navy"
   "Border color of the floating window.")
+(defvar exwm-floating--border-pixel nil
+  "Border pixel drawn around floating X windows.")
+(defvar exwm-floating--border-colormap nil
+  "Colormap used by the border pixel.
+
+This is also used by X window containers.")
 
 (defvar exwm-floating-setup-hook nil
   "Normal hook run when an X window has been made floating, in the
@@ -95,8 +101,6 @@ context of the corresponding buffer.")
                           (get-buffer "*scratch*")))
                   (make-frame
                    `((minibuffer . nil) ;use the default minibuffer.
-                     (background-color . ,exwm-floating-border-color)
-                     (internal-border-width . ,exwm-floating-border-width)
                      (left . 10000)
                      (top . 10000)
                      (width . ,window-min-width)
@@ -135,8 +139,7 @@ context of the corresponding buffer.")
                                 (window-pixel-height (minibuffer-window
                                                       original-frame)))
                               (* 2 (window-mode-line-height))
-                              (window-header-line-height window)
-                              (* 2 exwm-floating-border-width)))
+                              (window-header-line-height window)))
            (display-height (* 2 (/ display-height 2)))) ;round to even
       (if (> width display-width)
           ;; Too wide
@@ -229,14 +232,17 @@ context of the corresponding buffer.")
         (make-instance 'xcb:ReparentWindow
                        :window outer-id :parent frame-container :x 0 :y 0))
     ;; Place the X window container.
+    ;; Also show the floating border.
     (xcb:+request exwm--connection
         (make-instance 'xcb:ConfigureWindow
                        :window container
                        :value-mask (eval-when-compile
                                      (logior xcb:ConfigWindow:X
-                                             xcb:ConfigWindow:Y))
-                       :x (- x exwm-floating-border-width)
-                       :y (- y exwm-floating-border-width)))
+                                             xcb:ConfigWindow:Y
+                                             xcb:ConfigWindow:BorderWidth))
+                       :x x
+                       :y y
+                       :border-width exwm-floating-border-width))
     (exwm-floating--set-allowed-actions id nil)
     (xcb:flush exwm--connection)
     ;; Set window/buffer
@@ -294,14 +300,6 @@ context of the corresponding buffer.")
             (make-instance 'xcb:ChangeWindowAttributes
                            :window id :value-mask xcb:CW:EventMask
                            :event-mask exwm--client-event-mask))
-        ;; The X window might have been moved due to the floating border.
-        (xcb:+request exwm--connection
-            (make-instance 'xcb:ConfigureWindow
-                           :window id
-                           :value-mask (logior xcb:ConfigWindow:X
-                                               xcb:ConfigWindow:Y)
-                           :x 0
-                           :y 0))
         ;; Reparent the floating frame back to the root window.
         (let ((frame-id (frame-parameter exwm--floating-frame 'exwm-outer-id))
               (frame-container (frame-parameter exwm--floating-frame
@@ -318,11 +316,14 @@ context of the corresponding buffer.")
               (make-instance 'xcb:DestroyWindow :window frame-container))))
       ;; Put the X window container just above the Emacs frame container
       ;; (the stacking order won't change from now on).
+      ;; Also hide the possible floating border.
       (xcb:+request exwm--connection
           (make-instance 'xcb:ConfigureWindow
                          :window exwm--container
-                         :value-mask (logior xcb:ConfigWindow:Sibling
+                         :value-mask (logior xcb:ConfigWindow:BorderWidth
+                                             xcb:ConfigWindow:Sibling
                                              xcb:ConfigWindow:StackMode)
+                         :border-width 0
                          :sibling (frame-parameter exwm-workspace--current
                                                    'exwm-container)
                          :stack-mode xcb:StackMode:Above)))
@@ -681,6 +682,29 @@ Both DELTA-X and DELTA-Y default to 1.  This command should be bound locally."
 
 (defun exwm-floating--init ()
   "Initialize floating module."
+  ;; Check border width.
+  (unless (and (integerp exwm-floating-border-width)
+               (> exwm-floating-border-width 0))
+    (setq exwm-floating-border-width 0))
+  ;; Initialize border pixel.
+  (when (> exwm-floating-border-width 0)
+    (setq exwm-floating--border-colormap
+          (slot-value (car (slot-value
+                            (xcb:get-setup exwm--connection) 'roots))
+                      'default-colormap))
+    (unless (stringp exwm-floating-border-color)
+      (setq exwm-floating-border-color ""))
+    (let* ((color (x-color-values exwm-floating-border-color))
+           reply)
+      (when color
+        (setq reply (xcb:+request-unchecked+reply exwm--connection
+                        (make-instance 'xcb:AllocColor
+                                       :cmap exwm-floating--border-colormap
+                                       :red (pop color)
+                                       :green (pop color)
+                                       :blue (pop color))))
+        (when reply
+          (setq exwm-floating--border-pixel (slot-value reply 'pixel))))))
   ;; Initialize cursors for moving/resizing a window
   (xcb:cursor:init exwm--connection)
   (setq exwm-floating--cursor-move
diff --git a/exwm-layout.el b/exwm-layout.el
index 5a31c947c1bb..79728bb7c49d 100644
--- a/exwm-layout.el
+++ b/exwm-layout.el
@@ -214,7 +214,9 @@
     (xcb:+request exwm--connection
         (make-instance 'xcb:ConfigureWindow
                        :window exwm--container
-                       :value-mask xcb:ConfigWindow:StackMode
+                       :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
@@ -240,9 +242,11 @@
                            :window exwm--container
                            :value-mask (eval-when-compile
                                          (logior xcb:ConfigWindow:X
-                                                 xcb:ConfigWindow:Y))
+                                                 xcb:ConfigWindow:Y
+                                                 xcb:ConfigWindow:BorderWidth))
                            :x (elt exwm--floating-frame-position 0)
-                           :y (elt exwm--floating-frame-position 1)))
+                           :y (elt exwm--floating-frame-position 1)
+                           :border-width exwm-floating-border-width))
       ;; Put the X window just above the Emacs frame.
       (xcb:+request exwm--connection
           (make-instance 'xcb:ConfigureWindow
diff --git a/exwm-manage.el b/exwm-manage.el
index 0f1a80b72946..f1deda0759f1 100644
--- a/exwm-manage.el
+++ b/exwm-manage.el
@@ -92,6 +92,8 @@ corresponding buffer.")
                      :window exwm--root
                      :data (vconcat (mapcar #'car exwm--id-buffer-alist)))))
 
+(defvar exwm-floating--border-colormap)
+(defvar exwm-floating--border-pixel)
 (defvar exwm-workspace--current)
 (defvar exwm-workspace--switch-history-outdated)
 (defvar exwm-workspace-current-index)
@@ -243,11 +245,16 @@ corresponding buffer.")
                          :class xcb:WindowClass:InputOutput
                          :visual 0
                          :value-mask (logior xcb:CW:BackPixmap
+                                             (if exwm-floating--border-pixel
+                                                 xcb:CW:BorderPixel 0)
                                              xcb:CW:OverrideRedirect
-                                             xcb:CW:EventMask)
+                                             xcb:CW:EventMask
+                                             xcb:CW:Colormap)
                          :background-pixmap xcb:BackPixmap:ParentRelative
+                         :border-pixel exwm-floating--border-pixel
                          :override-redirect 1
-                         :event-mask xcb:EventMask:SubstructureRedirect))
+                         :event-mask xcb:EventMask:SubstructureRedirect
+                         :colormap exwm-floating--border-colormap))
       (exwm--debug
        (xcb:+request exwm--connection
            (make-instance 'xcb:ewmh:set-_NET_WM_NAME
diff --git a/exwm-workspace.el b/exwm-workspace.el
index 24a59f9fab07..9034c1133701 100644
--- a/exwm-workspace.el
+++ b/exwm-workspace.el
@@ -636,9 +636,6 @@ INDEX must not exceed the current number of workspaces."
                        :window id
                        :data (exwm-workspace--position exwm--frame)))))
 
-(defvar exwm-floating-border-width)
-(defvar exwm-floating-border-color)
-
 (declare-function exwm-layout--show "exwm-layout.el" (id &optional window))
 (declare-function exwm-layout--hide "exwm-layout.el" (id))
 (declare-function exwm-layout--refresh "exwm-layout.el")
@@ -691,9 +688,6 @@ INDEX must not exceed the current number of workspaces."
                                   (get-buffer "*scratch*")))
                           (make-frame
                            `((minibuffer . ,(minibuffer-window frame))
-                             (background-color . ,exwm-floating-border-color)
-                             (internal-border-width
-                              . ,exwm-floating-border-width)
                              (left . 10000)
                              (top . 10000)
                              (width . ,window-min-width)
diff --git a/exwm.el b/exwm.el
index cb7fd80aa136..850becfd9eaf 100644
--- a/exwm.el
+++ b/exwm.el
@@ -399,19 +399,20 @@
      ;; _NET_REQUEST_FRAME_EXTENTS
      ((= type xcb:Atom:_NET_REQUEST_FRAME_EXTENTS)
       (let ((buffer (exwm--id->buffer id))
-            left right top btm)
+            top btm)
         (if (or (not buffer)
                 (not (buffer-local-value 'exwm--floating-frame buffer)))
-            (setq left 0 right 0 top 0 btm 0)
-          (setq left exwm-floating-border-width
-                right exwm-floating-border-width
-                top (+ exwm-floating-border-width (window-header-line-height))
-                btm (+ exwm-floating-border-width
-                       (window-mode-line-height))))
+            (setq top 0
+                  btm 0)
+          (setq top (window-header-line-height)
+                btm (window-mode-line-height)))
         (xcb:+request exwm--connection
             (make-instance 'xcb:ewmh:set-_NET_FRAME_EXTENTS
-                           :window id :left left :right right
-                           :top top :bottom btm)))
+                           :window id
+                           :left 0
+                           :right 0
+                           :top top
+                           :bottom btm)))
       (xcb:flush exwm--connection))
      ;; _NET_WM_DESKTOP.
      ((= type xcb:Atom:_NET_WM_DESKTOP)