emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/engrave-faces 4ef39b1 10/36: Improve handling of face i


From: ELPA Syncer
Subject: [elpa] externals/engrave-faces 4ef39b1 10/36: Improve handling of face inheritance.
Date: Tue, 31 Aug 2021 01:57:25 -0400 (EDT)

branch: externals/engrave-faces
commit 4ef39b1a06d96695e6824b14517eadb67fbce462
Author: TEC <tec@tecosaur.com>
Commit: TEC <tec@tecosaur.com>

    Improve handling of face inheritance.
    
    Now if a face inherits from a face with explicit styling, that explicit
    styling is used instead of the current styling of the inherited face.
---
 engrave-faces.el | 40 ++++++++++++++++++++++++++++------------
 1 file changed, 28 insertions(+), 12 deletions(-)

diff --git a/engrave-faces.el b/engrave-faces.el
index f64d81c..e51f079 100644
--- a/engrave-faces.el
+++ b/engrave-faces.el
@@ -121,20 +121,36 @@ output.")
           (run-hooks (intern (concat "engrave-faces-" backend "-after-hook"))))
         engraved-buf))))
 
-(defun engrave-faces-merge-attributes (faces)
+(defun engrave-faces-merge-attributes (faces &optional attributes)
+  "Find the final ATTRIBUTES for text with FACES."
+  (setq faces (engrave-faces-explicit-inheritance faces))
   (apply #'append
          (mapcar (lambda (attr)
-                   (list attr
-                         (car
-                          (delq nil
-                                (delq 'unspecified
-                                      (mapcar (lambda (face)
-                                                (or (plist-get (cdr (assoc 
face engrave-faces-preset-styles)) attr)
-                                                    (cond
-                                                     ((symbolp face) 
(face-attribute face attr nil t))
-                                                     ((listp face) (plist-get 
face attr)))))
-                                              (delq 'default (if (listp faces) 
faces (list faces)))))))))
-                 engrave-faces-attributes-of-interest)))
+                   (list attr (car (engrave-faces-attribute-values faces 
attr))))
+                 (or attributes engrave-faces-attributes-of-interest))))
+
+(defun engrave-faces-explicit-inheritance (faces)
+  "Expand :inherit for each face in FACES.
+I.e. ([facea :inherit faceb] facec) results in (facea faceb facec)"
+  (apply #'append (mapcar
+                   (lambda (face)
+                     (cons face
+                           (let ((inherit (face-attribute face :inherit nil 
nil)))
+                             (when (and inherit (not (eq inherit 
'unspecified)))
+                               (engrave-faces-explicit-inheritance (list 
inherit))))))
+                   faces)))
+
+(defun engrave-faces-attribute-values (faces attribute)
+  "Fetch all specified instances of ATTRIBUTE for FACES, ignoring inheritence.
+To consider inheritence, use `engrave-faces-explicit-inheritance' first."
+  (delq nil (delq 'unspecified
+                  (mapcar
+                   (lambda (face)
+                     (or (plist-get (cdr (assoc face 
engrave-faces-preset-styles)) attribute)
+                         (cond
+                          ((symbolp face) (face-attribute face attribute nil 
nil))
+                          ((listp face) (plist-get face attribute)))))
+                   (delq 'default (if (listp faces) faces (list faces)))))))
 
 (defun engrave-faces-next-face-change (pos &optional limit)
   ;; (engrave-faces-next-change pos 'face limit) would skip over entire



reply via email to

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