defface with less redundancy - emacs

Question

I want to define a bunch of faces for different characters like below:
(defface char-face-a
'((((type tty) (class color)) (:background "yellow" :foreground "black"))
(((type tty) (class mono)) (:inverse-video t))
(((class color) (background dark)) (:background "yellow" :foreground "black"))
(((class color) (background light)) (:background "yellow" :foreground "black"))
(t (:background "gray")))
"Face for marking up A's"
:group 'char-faces)
(defface char-face-b
'((((type tty) (class color)) (:background "red" :foreground "black"))
(((type tty) (class mono)) (:inverse-video t))
(((class color) (background dark)) (:background "red" :foreground "black"))
(((class color) (background light)) (:background "red" :foreground "black"))
(t (:background "gray")))
"Face for marking up B's"
:group 'char-faces)
...
...
Is there anyway to avoid explicitly write all the defface definitions and make the code less redundant? (I know make-face, but it seems deprecated and can't set attributes according to different terminal types as defface does.)

Answer 1

make-face is not at all deprecated, AFAICT.
defface can make use of inheritance -- see face attribute :inherit.
Dunno whether that helps in your particular context.

Answer 2

How about a macro and a loop that operates on a mapping of suffixes <-> colors:
(defmacro brian-def-char-face (letter backgrnd foregrnd)
`(defface ,(intern (concat "brian-char-face-"
letter))
'((((type tty) (class color))
(:background
,backgrnd
:foreground
,foregrnd))
(((type tty) (class color)) (:inverse-video t))
(((class color) (background dark))
(:foreground
,foregrnd
:background
,backgrnd))
(((class color) (background light))
(:foreground
,foregrnd
:background
,backgrnd))
(t (:background "gray")))
,(concat "Face for marking up " (upcase letter) "'s")))
(let ((letcol-alist '((s . (white black))
(t . (black yellow))
(u . (green pink)))))
(loop for elem in letcol-alist
for l = (format "%s" (car elem))
for back = (format "%s" (cadr elem))
for fore = (format "%s" (caddr elem))
do
(eval (macroexpand `(brian-def-char-face ,l ,back ,fore)))))
Gives you new faces:
brian-char-face-s, brian-char-face-t, and brian-char-face-u
Now you just need to maintain the list of letter<->color mappings, and possibly extend the macro to support other face properties (if desired).