Refactor color-related code

* exwm-core.el (exwm--color->pixel): New function for converting color
to TrueColor pixel.
* exwm-floating.el (exwm-floating--border-pixel)
(exwm-floating--border-colormap, exwm-floating--init-border): Removed.
(exwm-floating-border-color, exwm-floating--set-floating): Use
`exwm--color->pixel' and only support TrueColor.

2 files changed, 28 insertions, 59 deletions

diff --git a/exwm-core.el b/exwm-core.el
index 7e37a71b6c0e..553fb4b4e3a7 100644
--- a/exwm-core.el
+++ b/exwm-core.el
@@ -184,6 +184,15 @@ least SECS seconds later."
           (if mouse-autoselect-window
               xcb:EventMask:EnterWindow 0)))
 
+(defun exwm--color->pixel (color)
+  "Convert COLOR to PIXEL (index in TrueColor colormap)."
+  (when (and color
+             (eq (x-display-visual-class) 'true-color))
+    (let ((rgb (x-color-values color)))
+      (logior (lsh (lsh (pop rgb) -8) 16)
+              (lsh (lsh (pop rgb) -8) 8)
+              (lsh (pop rgb) -8)))))
+
 ;; Internal variables
 (defvar-local exwm--id nil)               ;window ID
 (defvar-local exwm--configurations nil)   ;initial configurations.
diff --git a/exwm-floating.el b/exwm-floating.el
index 115dd3b17b25..d1882cf74615 100644
--- a/exwm-floating.el
+++ b/exwm-floating.el
@@ -44,9 +44,6 @@ context of the corresponding buffer."
 context of the corresponding buffer."
   :type 'hook)
 
-(defvar exwm-floating--border-pixel nil
-  "Border pixel drawn around floating X windows.")
-
 (defcustom exwm-floating-border-color "navy"
   "Border color of floating windows."
   :type 'color
@@ -54,20 +51,20 @@ context of the corresponding buffer."
   :set (lambda (symbol value)
          (set-default symbol value)
          ;; Change border color for all floating X windows.
-         (exwm-floating--init-border)
-         (dolist (pair exwm--id-buffer-alist)
-           (with-current-buffer (cdr pair)
-             (when exwm--floating-frame
-               (xcb:+request exwm--connection
-                   (make-instance 'xcb:ChangeWindowAttributes
-                                  :window
-                                  (frame-parameter exwm--floating-frame
-                                                   'exwm-container)
-                                  :value-mask xcb:CW:BorderPixel
-                                  :border-pixel
-                                  exwm-floating--border-pixel)))))
          (when exwm--connection
-           (xcb:flush exwm--connection))))
+           (let ((border-pixel (exwm--color->pixel value)))
+             (when border-pixel
+               (dolist (pair exwm--id-buffer-alist)
+                 (with-current-buffer (cdr pair)
+                   (when exwm--floating-frame
+                     (xcb:+request exwm--connection
+                         (make-instance 'xcb:ChangeWindowAttributes
+                                        :window
+                                        (frame-parameter exwm--floating-frame
+                                                         'exwm-container)
+                                        :value-mask xcb:CW:BorderPixel
+                                        :border-pixel border-pixel)))))
+               (xcb:flush exwm--connection))))))
 
 (defcustom exwm-floating-border-width 1
   "Border width of floating windows."
@@ -104,11 +101,6 @@ context of the corresponding buffer."
            (when exwm--connection
              (xcb:flush exwm--connection)))))
 
-(defvar exwm-floating--border-colormap nil
-  "Colormap used by the border pixel.
-
-This is also used by X window containers.")
-
 ;; Cursors for moving/resizing a window
 (defvar exwm-floating--cursor-move nil)
 (defvar exwm-floating--cursor-top-left nil)
@@ -276,7 +268,8 @@ This is also used by X window containers.")
            (floating-mode-line (plist-get exwm--configurations
                                           'floating-mode-line))
            (floating-header-line (plist-get exwm--configurations
-                                            'floating-header-line)))
+                                            'floating-header-line))
+           (border-pixel (exwm--color->pixel exwm-floating-border-color)))
       (if floating-mode-line
           (setq exwm--mode-line-format (or exwm--mode-line-format
                                            mode-line-format)
@@ -323,15 +316,12 @@ This is also used by X window containers.")
                          :class xcb:WindowClass:InputOutput
                          :visual 0
                          :value-mask (logior xcb:CW:BackPixmap
-                                             (if exwm-floating--border-pixel
+                                             (if border-pixel
                                                  xcb:CW:BorderPixel 0)
-                                             xcb:CW:OverrideRedirect
-                                             (if exwm-floating--border-colormap
-                                                 xcb:CW:Colormap 0))
+                                             xcb:CW:OverrideRedirect)
                          :background-pixmap xcb:BackPixmap:ParentRelative
-                         :border-pixel exwm-floating--border-pixel
-                         :override-redirect 1
-                         :colormap exwm-floating--border-colormap))
+                         :border-pixel border-pixel
+                         :override-redirect 1))
       (xcb:+request exwm--connection
           (make-instance 'xcb:ewmh:set-_NET_WM_NAME
                          :window frame-container
@@ -758,39 +748,9 @@ Both DELTA-X and DELTA-Y default to 1.  This command should be bound locally."
                           nil nil))
     (xcb:flush exwm--connection)))
 
-(defun exwm-floating--init-border ()
-  "Initialize border colormap and pixel."
-  (exwm--log)
-  ;; Use the default colormap.
-  (unless exwm-floating--border-colormap
-    (with-slots (roots) (xcb:get-setup exwm--connection)
-      (with-slots (default-colormap) (car roots)
-        (setq exwm-floating--border-colormap default-colormap))))
-  ;; Free any previously allocated pixel.
-  (when exwm-floating--border-pixel
-    (xcb:+request exwm--connection
-        (make-instance 'xcb:FreeColors
-                       :cmap exwm-floating--border-colormap
-                       :plane-mask 0
-                       :pixels (vector exwm-floating--border-pixel)))
-    (setq exwm-floating--border-pixel nil))
-  ;; Allocate new pixel.
-  (let ((color (x-color-values (or 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))))))
-
 (defun exwm-floating--init ()
   "Initialize floating module."
   (exwm--log)
-  (exwm-floating--init-border)
   ;; Initialize cursors for moving/resizing a window
   (xcb:cursor:init exwm--connection)
   (setq exwm-floating--cursor-move