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.
This commit is contained in:
Chris Feng 2020-02-02 00:00:00 +00:00
parent 27a884e947
commit 36d2f0056e
2 changed files with 28 additions and 59 deletions

View file

@ -184,6 +184,15 @@ least SECS seconds later."
(if mouse-autoselect-window (if mouse-autoselect-window
xcb:EventMask:EnterWindow 0))) 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 ;; Internal variables
(defvar-local exwm--id nil) ;window ID (defvar-local exwm--id nil) ;window ID
(defvar-local exwm--configurations nil) ;initial configurations. (defvar-local exwm--configurations nil) ;initial configurations.

View file

@ -44,9 +44,6 @@ context of the corresponding buffer."
context of the corresponding buffer." context of the corresponding buffer."
:type 'hook) :type 'hook)
(defvar exwm-floating--border-pixel nil
"Border pixel drawn around floating X windows.")
(defcustom exwm-floating-border-color "navy" (defcustom exwm-floating-border-color "navy"
"Border color of floating windows." "Border color of floating windows."
:type 'color :type 'color
@ -54,20 +51,20 @@ context of the corresponding buffer."
:set (lambda (symbol value) :set (lambda (symbol value)
(set-default symbol value) (set-default symbol value)
;; Change border color for all floating X windows. ;; 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 (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 (defcustom exwm-floating-border-width 1
"Border width of floating windows." "Border width of floating windows."
@ -104,11 +101,6 @@ context of the corresponding buffer."
(when exwm--connection (when exwm--connection
(xcb:flush 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 ;; Cursors for moving/resizing a window
(defvar exwm-floating--cursor-move nil) (defvar exwm-floating--cursor-move nil)
(defvar exwm-floating--cursor-top-left 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 (plist-get exwm--configurations
'floating-mode-line)) 'floating-mode-line))
(floating-header-line (plist-get exwm--configurations (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 (if floating-mode-line
(setq exwm--mode-line-format (or exwm--mode-line-format (setq exwm--mode-line-format (or exwm--mode-line-format
mode-line-format) mode-line-format)
@ -323,15 +316,12 @@ This is also used by X window containers.")
:class xcb:WindowClass:InputOutput :class xcb:WindowClass:InputOutput
:visual 0 :visual 0
:value-mask (logior xcb:CW:BackPixmap :value-mask (logior xcb:CW:BackPixmap
(if exwm-floating--border-pixel (if border-pixel
xcb:CW:BorderPixel 0) xcb:CW:BorderPixel 0)
xcb:CW:OverrideRedirect xcb:CW:OverrideRedirect)
(if exwm-floating--border-colormap
xcb:CW:Colormap 0))
:background-pixmap xcb:BackPixmap:ParentRelative :background-pixmap xcb:BackPixmap:ParentRelative
:border-pixel exwm-floating--border-pixel :border-pixel border-pixel
:override-redirect 1 :override-redirect 1))
:colormap exwm-floating--border-colormap))
(xcb:+request exwm--connection (xcb:+request exwm--connection
(make-instance 'xcb:ewmh:set-_NET_WM_NAME (make-instance 'xcb:ewmh:set-_NET_WM_NAME
:window frame-container :window frame-container
@ -758,39 +748,9 @@ Both DELTA-X and DELTA-Y default to 1. This command should be bound locally."
nil nil)) nil nil))
(xcb:flush exwm--connection))) (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 () (defun exwm-floating--init ()
"Initialize floating module." "Initialize floating module."
(exwm--log) (exwm--log)
(exwm-floating--init-border)
;; Initialize cursors for moving/resizing a window ;; Initialize cursors for moving/resizing a window
(xcb:cursor:init exwm--connection) (xcb:cursor:init exwm--connection)
(setq exwm-floating--cursor-move (setq exwm-floating--cursor-move