Get foreground color of face at point

Question

I am writing a function to get the foreground color of the face at point and am thinking that Emacs may already provide a better method than the one I'm composing?

I am going to be using this function about 50 times every redisplay (i.e., once for every visible horizontal line, going down a column vertically from window-start to window-end), so I want it to be as efficient as possible.

With the proposed function get-face, I would use: (when (eq (car (text-properties-at (point))) 'face) (nth 23 (get-face (nth 1 (text-properties-at (point)))))).

I'm not certain under what circumstances more than one face will exist, or whether the car of text-properties-at will always contain the symbol face if a face is present?

I still have not dealt with handling an inherit situation.

(defun get-face (face)
"Doc-string."
  (let* (
      (attributes (face-all-attributes face (selected-frame)))
      (family-car (car (nth 0 attributes)))
      (family-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 0 attributes))))
          "Courier"
          (cdr (nth 0 attributes))))
      (foundry-car (car (nth 1 attributes)))
      (foundry-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 1 attributes))))
          nil
          (cdr (nth 1 attributes))))
      (width-car (car (nth 2 attributes)))
      (width-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 2 attributes))))
          'normal
          (cdr (nth 2 attributes))))
      (height-car (car (nth 3 attributes)))
      (height-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 3 attributes))))
          180
          (cdr (nth 3 attributes))))
      (weight-car (car (nth 4 attributes)))
      (weight-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 4 attributes))))
          'normal
          (cdr (nth 4 attributes))))
      (slant-car (car (nth 5 attributes)))
      (slant-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 5 attributes))))
          'normal
          (cdr (nth 5 attributes))))
      (underline-car (car (nth 6 attributes)))
      (underline-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 6 attributes))))
          nil
          (cdr (nth 6 attributes))))
      (overline-car (car (nth 7 attributes)))
      (overline-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 7 attributes))))
          nil
          (cdr (nth 7 attributes))))
      (strike-through-car (car (nth 8 attributes)))
      (strike-through-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 8 attributes))))
          nil
          (cdr (nth 8 attributes))))
      (box-car (car (nth 9 attributes)))
      (box-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 9 attributes))))
          nil
          (cdr (nth 9 attributes))))
      (inverse-video-car (car (nth 10 attributes)))
      (inverse-video-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 10 attributes))))
          nil
          (cdr (nth 10 attributes))))
      (foreground-car (car (nth 11 attributes)))
      (foreground-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 11 attributes))))
          'unspecified
          (cdr (nth 11 attributes))))
      (background-car (car (nth 12 attributes)))
      (background-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 12 attributes))))
          'unspecified
          (cdr (nth 12 attributes))))
      (stipple-car (car (nth 13 attributes)))
      (stipple-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 13 attributes))))
          nil
          (cdr (nth 13 attributes))))
      (inherit-car (car (nth 14 attributes)))
      (inherit-cdr
        (if (equal "unspecified" (format "%s" (cdr (nth 14 attributes))))
          nil
          (cdr (nth 14 attributes)))))
    (list
      family-car family-cdr
      foundry-car foundry-cdr
      width-car width-cdr
      height-car height-cdr
      weight-car weight-cdr
      slant-car slant-cdr
      underline-car underline-cdr
      overline-car overline-cdr
      strike-through-car strike-through-cdr
      box-car box-cdr
      inverse-video-car inverse-video-cdr
      foreground-car foreground-cdr
      background-car background-cdr
      stipple-car stipple-cdr
      inherit-car inherit-cdr)))

Answer 1

This is what I use, from library eyedropper.el. (Note the comment about the foreground not being specified by a named face.)

(defun eyedrop-foreground-at-point (&optional msg-p)
  "Return the foreground color under the text cursor.
Non-nil optional arg MSG-P means display an informative message."
  (interactive "p")
  ;; `eyedrop-face-at-point' alone is not sufficient.  It only gets named faces.
  ;; Need also pick up any face properties that are not associated with named faces.
  (let* ((face  (or (eyedrop-face-at-point)
                    (get-char-property (point) 'read-face-name)
                    (get-char-property (point) 'face)))
         (fg    (cond ((and face (symbolp face))
                       (condition-case nil
                           (face-foreground face nil 'default) ; Emacs 22+.
                         (error (or (face-foreground face) ; Emacs 20
                                    (cdr (assq 'foreground-color (frame-parameters)))))))
                      ((consp face)
                       (cond ((memq 'foreground-color face)
                              (cdr (memq 'foreground-color face)))
                             ((memq ':foreground face)
                              (cadr (memq ':foreground face)))))
                      (t nil)))         ; Invalid face value.
         (fg    (and (not (member fg '("unspecified-fg" "unspecified-bg")))  fg)))
    (when msg-p
      (if fg (eyedrop-color-message fg) (message "No foreground color here")))
    fg))

And this, slightly better, is the version from library palette.el (Color Palette).

(defun palette-foreground-at-point (&optional msg-p)
  "Return the foreground color under the text cursor.
Display it in a message, respecting option `palette-hex-rgb-digits'.
Return the full value, however, ignoring `palette-hex-rgb-digits'.

There need be no defined face at the cursor position (point).

Non-interactively, non-nil optional arg MSG-P means display an
informative message."
  (interactive "p")
  ;; Outside the palette, we need to check both for a named face (via `palette-face-at-point')
  ;; and face properties that are not associated with named faces.
  ;; Inside the palette, there is no need to check for a named face.
  (let* ((face  (or (and (not (eq major-mode 'palette-mode))
                         (palette-face-at-point))
                    (get-char-property (point) 'read-face-name)
                    (get-char-property (point) 'face)
                    'default))
         (fg    (cond ((and face (symbolp face))
                       (condition-case nil
                           (face-foreground face nil 'default) ; Emacs 22.
                         (error (or (face-foreground face) ; Emacs 20
                                    (cdr (assq 'foreground-color (frame-parameters)))))))
                      ((consp face)
                       (cond ((eq 'foreground-color (car face)) (cdr face))
                             ((and (consp (cdr face)) (memq 'foreground-color face))
                              (cdr (memq 'foreground-color face)))
                             ((and (consp (cdr face)) (memq ':foreground face))
                              (cadr (memq ':foreground face)))
                             (t (cdr (assq 'foreground-color (frame-parameters)))))) ; No fg.
                      (t nil)))         ; Invalid face value.
         (fg    (and (not (member fg '("unspecified-fg" "unspecified-bg")))  fg)))
    (when msg-p (if fg (palette-color-message fg t) (message "No foreground color here")))
    fg))

Answer 2

There is a function foreground-color-at-point in faces.el. It plays badly with overlays, but that's also the case for the functions mentioned by Drew.