set ALL faces to one face

[Emanuel Berg]

Set all faces to one face.

Then set all faces one by one whenever that face appears.

See '?' in comments for seemingly (?) strange things.

;;; -*- lexical-binding: t -*-
;;;
;;; this file:
;;;   http://user.it.uu.se/~embe8573/emacs-init/my-faces.el
;;;   https://dataswamp.org/~incal/emacs-init/my-faces.el

(require 'erc-button) ; why needed?
(require 'erc-match)

(defun set-all-faces (fg &optional bg weight)
  (let ((faces))
    (mapatoms (lambda (s)
                (when (facep s)
                  (push (symbol-name s) faces) )))
    (dolist (f faces)
      (set-face-attribute (intern f) nil
                          :foreground fg)
                          :background (or bg "black")
                          :weight     (or weight 'normal)) ))
;; (set-all-faces "red")

(defun what-face (pos)
  (interactive "d")
  (let ((face (or (get-char-property pos 'face)
                  (get-char-property pos 'read-cf-name) )))
    (message "face: %s" (or face "no face")) ))

(defun set-face (face fg bold &optional bg)
  (let ((bld (cond ((eq bold t)   'bold)
                   ((eq bold nil) 'normal)
                   (t              bold) )))
    (set-face-attribute face nil
                        :foreground fg
                        :background bg
                        :weight     bld) ))
(defalias 'sfa #'set-face)

(defun copy-face-attributes (src dst &rest more-faces)
  (when (and (facep src)
             (facep dst) )
    (dolist (d (cons dst more-faces))
      (let ((fg (face-attribute src :foreground nil 'default))
            (bg (face-attribute src :background nil 'default))
            (wt (face-attribute src :weight     nil 'default)) )
        (sfa d fg wt bg) ))))
(defalias 'cpf #'copy-face-attributes)

(font-lock-add-keywords 'emacs-lisp-mode
 '(
   ("font-lock-builtin-face"              .  font-lock-builtin-face)
   ("font-lock-comment-delimiter-face"    .  font-lock-comment-delimiter-face)
   ("font-lock-comment-face"              .  font-lock-comment-face)
   ("font-lock-constant-face"             .  font-lock-constant-face)
   ("font-lock-doc-face"                  .  font-lock-doc-face)
   ("font-lock-function-name-face"        .  font-lock-function-name-face)
   ("font-lock-keyword-face"              .  font-lock-keyword-face)
   ("font-lock-negation-char-face"        .  font-lock-negation-char-face)
   ("font-lock-preprocessor-face"         .  font-lock-preprocessor-face)
   ("font-lock-reference-face"            .  font-lock-reference-face)
   ("font-lock-regexp-grouping-backslash" . 
'font-lock-regexp-grouping-backslash)
   ("font-lock-regexp-grouping-construct" . 
'font-lock-regexp-grouping-construct)
   ("font-lock-string-face"               .  font-lock-string-face)
   ("font-lock-type-face"                 .  font-lock-type-face)
   ("font-lock-variable-name-face"        .  font-lock-variable-name-face)
   ("font-lock-warning-face"              .  font-lock-warning-face)
   )
 t)

(sfa 'bold                                  "yellow"  t)
(sfa 'bold-italic                           "black"   t)
(sfa 'button                                "green"   t)
(sfa 'default                               "white"   nil)
(sfa 'italic                                "yellow"  nil)
(sfa 'minibuffer-prompt                     "cyan"    nil)
(sfa 'nobreak-space                         "black"   t)
(sfa 'region                                "white"   nil "blue")
(sfa 'underline                             "yellow"  nil)
(sfa 'warning                               "red"     t)

;; font-lock

(when t
  (sfa  font-lock-builtin-face              "magenta" nil)
  (sfa  font-lock-comment-face              "blue"    t)
  (sfa  font-lock-constant-face             "magenta" t)
  (sfa  font-lock-doc-face                  "black"   t)
  (sfa  font-lock-function-name-face        "cyan"    t)
  (sfa  font-lock-keyword-face              "green"   t)
  (sfa  font-lock-negation-char-face        "black"   t)
  (sfa  font-lock-preprocessor-face         "cyan"    t)
  (sfa  font-lock-string-face               "green"   nil)
  (sfa  font-lock-type-face                 "yellow"  t)
  (sfa  font-lock-variable-name-face        "cyan"    nil)
  (sfa 'font-lock-regexp-grouping-backslash "blue"    nil)
  (sfa 'font-lock-regexp-grouping-construct "red"     t)
  (cpf 'font-lock-comment-face 'font-lock-comment-delimiter-face)
  (cpf 'warning                'font-lock-warning-face)
  )

;; buffer menu
(sfa 'tabulated-list-fake-header          "black"   t)

;; markdown
(sfa 'markdown-header-delimiter-face      "green"   nil)
(sfa 'markdown-header-face-1              "white"   t)
(sfa 'markdown-header-face-2              "green"   t)
(sfa 'markdown-markup-face                "black"   t)
(sfa 'markdown-metadata-key-face          "white"   t)
(sfa 'markdown-metadata-value-face        "blue"    t)
(sfa 'markdown-plain-url-face             "blue"    t)

;; erc
(sfa 'erc-action-face                     "white"   t)
(sfa 'erc-command-indicator-face          "cyan"    nil)
(sfa 'erc-current-nick-face               "white"   t)
(sfa 'erc-direct-msg-face                 "magenta" t)
(sfa 'erc-fool-face                       "yellow"  nil)
(sfa 'erc-header-line                     "yellow"  nil "black")
(sfa 'erc-input-face                      "green"   nil)
(sfa 'erc-inverse-face                    "magenta" nil)
(sfa 'erc-keyword-face                    "white"   nil)
(sfa 'erc-nick-default-face               "magenta" t)
(sfa 'erc-nick-msg-face                   "white"   nil)
(sfa 'erc-notice-face                     "black"   t)
(sfa 'erc-pal-face                        "blue"    nil)
(sfa 'erc-prompt-face                     "white"   nil "black")
(sfa 'erc-timestamp-face                  "red"     t)

(cpf 'erc-current-nick-face 'erc-my-nick-face)

;; message / gnus
(require 'gnus-spec)

(when t
  (sfa 'message-header-cc                 "cyan"    nil)
  (cpf 'message-header-cc
       'gnus-header-cc) )

(when t
  (sfa 'message-header-name               "green"   nil)
  (cpf 'message-header-name
       'gnus-header-name) )

(when t
  (sfa 'message-header-newsgroups         "magenta" t)
  (cpf 'message-header-newsgroups
       'gnus-header-newsgroups) )

(when t
  (sfa 'message-header-subject            "yellow"  nil)
  (cpf 'message-header-subject
       'gnus-header-subject) )

(sfa 'message-separator                   "white"   nil)

(sfa 'gnus-header-from                    "blue"    t)

(when t
  (setq gnus-face-0 font-lock-comment-face)
  (setq gnus-face-1 font-lock-constant-face)
  (setq gnus-face-2 font-lock-doc-face)
  (setq gnus-face-3 font-lock-function-name-face)
  (setq gnus-face-4 font-lock-variable-name-face)
  )

(when t
  (sfa 'gnus-cite-1                       "blue"    t)
  (sfa 'gnus-cite-2                       "green"   nil)
  (sfa 'gnus-cite-3                       "magenta" nil)
  (sfa 'gnus-cite-2                       "magenta" t)
  (sfa 'gnus-cite-3                       "blue"    t)
)

(sfa 'gnus-group-mail-1                   "yellow"  nil)
(sfa 'gnus-group-mail-3                   "cyan"    nil)
(sfa 'gnus-group-news-3                   "green"   t)
(sfa 'gnus-group-news-3-empty             "white"   nil)
(sfa 'gnus-group-news-6                   "black"   t)

(cpf 'gnus-group-news-6 'gnus-group-mail-1-empty
                        'gnus-group-mail-3-empty
                        'gnus-group-mail-low
                        'gnus-group-mail-low-empty
                        'gnus-group-news-6-empty)

(sfa 'gnus-summary-selected               "white"   t "magenta")
(sfa 'gnus-summary-normal-ticked          "yellow"  nil)
(sfa 'gnus-summary-normal-read            "green"   nil)

;; mode line
(sfa 'mode-line                           "blue"    t    "white")
(sfa 'mode-line-buffer-id                 nil       t    "white")
(sfa 'mode-line-emphasis                  "red"     t)
(sfa 'mode-line-highlight                 "red"     t)
(sfa 'mode-line-inactive                  "green"   t    "white")

;; paren
(sfa 'show-paren-match                    "white"   t    "green")
(sfa 'show-paren-mismatch                 "white"   t    "red")

;; dired
(sfa 'dired-directory                     "blue"    t)
(sfa 'dired-header                        "green"   nil)
(sfa 'dired-ignored                       "black"   t)
(sfa 'dired-mark                          "yellow"  nil)
(sfa 'dired-symlink                       "cyan"    nil)

(cpf 'dired-mark 'dired-flagged 'dired-marked)

;; w3m
(sfa 'w3m-current-anchor                  "yellow"  nil)
(sfa 'w3m-form-button                     "magenta" t)
(sfa 'w3m-image                           "black"   nil  "white")
(sfa 'w3m-image-anchor                    "black"   nil  "green")

(let ((w3m-bg "black"))
  (sfa 'w3m-tab-background                 w3m-bg   nil)
  (sfa 'w3m-tab-selected                   w3m-bg   nil  "cyan") ; backwards?
  (sfa 'w3m-tab-selected-retrieving        w3m-bg   t    "white")
  (sfa 'w3m-tab-unselected                 w3m-bg   t    "black") )

(cpf 'w3m-tab-unselected 'w3m-tab-unselected-unseen
                         'w3m-tab-unselected-retrieving)

;; comint
(sfa 'comint-highlight-input              "white"   nil)
(sfa 'comint-highlight-prompt             "white"   nil)

;; compilation
(sfa 'compilation-info                    "yellow"  t)

;; info
(sfa 'info-header-node                    "yellow"  nil)
(sfa 'info-menu-header                    "magenta" t)
(sfa 'info-menu-star                      "white"   nil)
(sfa 'info-title-1                        "green"   t)
(sfa 'info-title-2                        "blue"    t)
(sfa 'info-xref                           "cyan"    nil)

(cpf 'info-xref 'info-xref-visited 'info-header-xref)

(cpf 'bold        'erc-bold-face
                  'markdown-bold-face
                  'w3m-bold)

(cpf 'bold-italic 'gnus-emphasis-bold)

(cpf 'button      'erc-button
                  'gnus-button
                  'markdown-link-face
                  'w3m-anchor)

(cpf 'default     'erc-default-face)

(cpf 'italic      'markdown-italic-face)

(cpf 'underline   'gnus-emphasis-underline
                  'erc-underline-face)

(cpf 'warning     'dired-perm-write
                  'erc-dangerous-host-face
                  'erc-error-face)

(cpf 'w3m-anchor  'w3m-arrived-anchor)

-- 
underground experts united
http://user.it.uu.se/~embe8573
https://dataswamp.org/~incal