From: Keith David Bershatsky <esq@lawlist.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 22757@debbugs.gnu.org
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 [thread overview]
Message-ID: <m2wppwjzog.wl%esq@lawlist.com> (raw)
In-Reply-To: <m2egc67xci.wl%esq@lawlist.com>
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)))
prev parent reply other threads:[~2016-02-22 19:46 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-02-21 18:05 bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- add argument WINDOW-OR-BUFFER Keith David Bershatsky
2016-02-21 20:54 ` Eli Zaretskii
2016-02-21 21:23 ` Keith David Bershatsky
2016-02-22 15:58 ` Eli Zaretskii
2016-02-21 21:23 ` Keith David Bershatsky
2016-02-22 18:15 ` bug#22757: Reply to correspondence dated February 22, 2016 Keith David Bershatsky
2016-02-22 19:25 ` Eli Zaretskii
2022-02-03 20:51 ` bug#22757: 25.1.50; `face-at-point` and `faces--attribute-at-point` -- add argument WINDOW-OR-BUFFER Lars Ingebrigtsen
2016-02-22 18:17 ` Keith David Bershatsky
2016-02-22 19:46 ` Keith David Bershatsky [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m2wppwjzog.wl%esq@lawlist.com \
--to=esq@lawlist.com \
--cc=22757@debbugs.gnu.org \
--cc=eliz@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).