bug-gnu-emacs
[Top][All Lists]
Advanced

[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)))





reply via email to

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