all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
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)))





      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

* 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 external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.