diff --git a/lisp/faces.el b/lisp/faces.el
index 8f93f9b2c0c..dd1d60407cd 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2109,50 +2109,107 @@ face-at-point
         (delete-dups (nreverse faces))
       (car (last faces)))))
 
-(defun faces--attribute-at-point (attribute &optional attribute-unnamed)
+(defconst face--unnamed-attributes
+  '((foreground-color . :foreground)
+    (background-color . :background))
+  "Alist of unnamed face attribute with keyword equivalent.
+Used for backward compatibility.")
+
+(defsubst face--attribute-unspecified-p (value)
+  "Return non-nil if face attribute VALUE means unspecified."
+  (member value '(nil unspecified "unspecified-fg" "unspecified-bg")))
+
+(defun face-attribute-lookup (face attribute &optional frame default)
+  "Lookup the value of FACE's ATTRIBUTE on FRAME.
+FACE is a valid face specification:
+
+FACE-SPEC   := FACE-NAME | ANONYM-FACE | COLOR | FACE-LIST
+FACE-NAME   := SYMBOL | STRING
+ANONYM-FACE := (ATTRIBUTE-1 VALUE-1 ... ATTRIBUTE-N VALUE-N)
+COLOR       := FOREGROUND | BACKGROUND
+FOREGROUND  := (`foreground-color' . COLOR-NAME)
+BACKGROUND  := (`background-color' . COLOR-NAME)
+FACE-LIST   := (FACE-SPEC-1 ... FACE-SPEC-N)
+
+If the optional argument FRAME is given, report on FACE in that frame.
+If FRAME is t, report on the defaults for FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame.
+
+Optional argument DEFAULT is a face specification appended to FACE.
+If DEFAULT includes the `default' face, the return value is always
+specified and absolute.
+
+Return the first specified value found for ATTRIBUTE, or nil if
+ATTRIBUTE is unspecified."
+  (catch 'found
+    (let ((faces (append (ensure-list face) (ensure-list default)))
+          (rest nil))
+      (while t
+        (cond
+         ;; End of a face-spec.
+         ((null faces)
+          (if rest
+              (setq faces (car rest) rest (cdr rest))
+            (throw 'found nil)))
+         ;; Malformed face-spec.
+         ((atom faces)
+          (throw 'found nil))
+         ;; Face name.
+         ((facep (car faces))
+          (let* ((face (car faces))
+                 (attr (face-attribute (if (stringp face)
+                                           (intern face)
+                                         face)
+                                       attribute frame t)))
+            (if (face--attribute-unspecified-p attr)
+                (setq faces (cdr faces))
+              (throw 'found attr))))
+         ;; Anonymous face (plist).
+         ((keywordp (car faces))
+          (let ((attr (plist-get faces attribute)))
+            (if (face--attribute-unspecified-p attr)
+                (setq faces nil)
+              (throw 'found attr))))
+         ;; Color.
+         ((when-let ((sym (assq (car faces) face--unnamed-attributes)))
+            (if (or (not (eq attribute (cdr sym)))
+                    (face--attribute-unspecified-p (cdr faces)))
+                (setq faces nil)
+              (throw 'found (cdr faces)))))
+         ;; Nested face-list.
+         ((consp (car faces))
+          (setq rest (cons (cdr faces) (if (cdr faces)
+                                           (cons (cdr faces) rest)
+                                         rest))
+                faces (car faces)))
+         ;; Skip unknow value.
+         ((setq faces (cdr faces))))))))
+
+(defun faces--attribute-at-point (attribute)
   "Return the face ATTRIBUTE at point.
-ATTRIBUTE is a keyword.
-If ATTRIBUTE-UNNAMED is non-nil, it is a symbol to look for in
-unnamed faces (e.g, `foreground-color')."
+ATTRIBUTE is a keyword."
   ;; `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 ((faces (or (get-char-property (point) 'read-face-name)
                    ;; If `font-lock-mode' is on, `font-lock-face' takes precedence.
                    (and font-lock-mode
                         (get-char-property (point) 'font-lock-face))
-                   (get-char-property (point) 'face)))
-        (found nil))
-    (dolist (face (if (face-list-p faces)
-                      faces
-                    (list faces)))
-      (cond (found)
-            ((and face (symbolp face))
-             (let ((value (face-attribute-specified-or
-                           (face-attribute face attribute nil t)
-                           nil)))
-               (unless (member value '(nil "unspecified-fg" "unspecified-bg"))
-                 (setq found value))))
-            ((consp face)
-             (setq found (cond ((and attribute-unnamed
-                                     (memq attribute-unnamed face))
-                                (cdr (memq attribute-unnamed face)))
-                               ((memq attribute face) (cadr (memq attribute face))))))))
-    (or found
-        (face-attribute 'default attribute))))
+                   (get-char-property (point) 'face))))
+    (face-attribute-lookup faces attribute nil 'default)))
 
 (defun foreground-color-at-point ()
   "Return the foreground color of the character after point.
 On TTY frames, the returned color name can be \"unspecified-fg\",
 which stands for the unknown default foreground color of the
 display where the frame is displayed."
-  (faces--attribute-at-point :foreground 'foreground-color))
+  (faces--attribute-at-point :foreground))
 
 (defun background-color-at-point ()
   "Return the background color of the character after point.
 On TTY frames, the returned color name can be \"unspecified-bg\",
 which stands for the unknown default background color of the
 display where the frame is displayed."
-  (faces--attribute-at-point :background 'background-color))
+  (faces--attribute-at-point :background))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;