[Top][All Lists]

[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 
The second argument POS is a user specified `point' somewhere in the 
The third argument FG-OR-BG is a symbol of either 'foreground or 'background"
  (let* (
      (frame (selected-frame))
        (face-attribute-specified-or (face-attribute 'default :foreground frame 
'default) nil))
        (face-attribute-specified-or (face-attribute 'default :background frame 
'default) nil))
          (get-char-property pos 'read-face-name buffer-or-window)
          (get-char-property pos 'face buffer-or-window)
          ((symbolp faceprop) faceprop)
          ((and (consp faceprop) (not (keywordp (car faceprop)))
                (not (memq (car faceprop) '(foreground-color 
           (car faceprop))
          (t ;; e.g., (:foreground yellow)
            ((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))
              ((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))
              ((memq 'background-color face)
                (cdr (memq 'background-color face)))
              ((memq ':background face)
                (cadr (memq ':background face)))
              (t +-default-face-bg)))
            (if (eq 'foreground fg-or-bg)
         ((member color '(unspecified "unspecified-fg" "unspecified-bg"))
         ((memq (framep (or frame (selected-frame))) '(x w32 ns))
          (xw-color-values color frame))
          (tty-color-values color frame))))
          (lambda (x)
            (let* (
                 ((memq (framep (or frame (selected-frame))) '(x w32 ns))
                  (xw-color-values "#ffffff" frame))
                  (tty-color-values "#ffffff" frame))))
              (+-valmax (float (car valmax))))
              (/ x +-valmax)))
          color-values)) )
    (vconcat value)))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]