mirror of
https://github.com/ch11ng/exwm.git
synced 2024-11-23 19:47:58 +01:00
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:
parent
27a884e947
commit
36d2f0056e
2 changed files with 28 additions and 59 deletions
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue