[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- a
From: |
Keith David Bershatsky |
Subject: |
bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- add argument WINDOW-OR-BUFFER |
Date: |
Mon, 22 Feb 2016 11:46:39 -0800 |
Here is the custom function that I came up with, derived in part from
`faces.el`, `color.el` and from Drew's color libraries.
(defun color-vector-calc (buffer-or-window pos fg-or-bg)
"Calculate the color vector of either :foreground or :background for the face
at POS.
Sample usage: (color-vector-calc (selected-window) (point) 'foreground)
The first argument BUFFER-OR-WINDOW is used in the context of
`get-char-property'.
The second argument POS is a user specified `point' somewhere in the
buffer/window.
The third argument FG-OR-BG is a symbol of either 'foreground or 'background"
(let* (
(frame (selected-frame))
(+-default-face-fg
(face-attribute-specified-or (face-attribute 'default :foreground frame
'default) nil))
(+-default-face-bg
(face-attribute-specified-or (face-attribute 'default :background frame
'default) nil))
(faceprop
(or
(get-char-property pos 'read-face-name buffer-or-window)
(get-char-property pos 'face buffer-or-window)
'default))
(face
(cond
((symbolp faceprop) faceprop)
((and (consp faceprop) (not (keywordp (car faceprop)))
(not (memq (car faceprop) '(foreground-color
background-color))))
(car faceprop))
(t ;; e.g., (:foreground yellow)
faceprop)))
(color
(cond
((and face (symbolp face))
(if (eq 'foreground fg-or-bg)
(face-attribute-specified-or (face-attribute face :foreground
frame 'default) nil)
(face-attribute-specified-or (face-attribute face :background
frame 'default) nil)))
((and (eq 'foreground fg-or-bg) (consp face))
(cond
((memq 'foreground-color face)
(cdr (memq 'foreground-color face)))
((memq ':foreground face)
(cadr (memq ':foreground face)))
(t +-default-face-fg)))
((and (eq 'background fg-or-bg) (consp face))
(cond
((memq 'background-color face)
(cdr (memq 'background-color face)))
((memq ':background face)
(cadr (memq ':background face)))
(t +-default-face-bg)))
(t
(if (eq 'foreground fg-or-bg)
+-default-face-fg
+-default-face-bg))))
(color-values
(cond
((member color '(unspecified "unspecified-fg" "unspecified-bg"))
nil)
((memq (framep (or frame (selected-frame))) '(x w32 ns))
(xw-color-values color frame))
(t
(tty-color-values color frame))))
(value
(mapcar
(lambda (x)
(let* (
(valmax
(cond
((memq (framep (or frame (selected-frame))) '(x w32 ns))
(xw-color-values "#ffffff" frame))
(t
(tty-color-values "#ffffff" frame))))
(+-valmax (float (car valmax))))
(/ x +-valmax)))
color-values)) )
(vconcat value)))
- bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- add argument WINDOW-OR-BUFFER, Keith David Bershatsky, 2016/02/21
- bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- add argument WINDOW-OR-BUFFER, Eli Zaretskii, 2016/02/21
- bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- add argument WINDOW-OR-BUFFER, Keith David Bershatsky, 2016/02/21
- bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- add argument WINDOW-OR-BUFFER, Keith David Bershatsky, 2016/02/21
- bug#22757: Reply to correspondence dated February 22, 2016., Keith David Bershatsky, 2016/02/22
- bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- add argument WINDOW-OR-BUFFER, Keith David Bershatsky, 2016/02/22
- bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- add argument WINDOW-OR-BUFFER,
Keith David Bershatsky <=