;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/emacs-init/face.el
;;
;; (prog1 t (set-all-faces "red") (eval-buffer))
;;
;; (re-search-forward "^;; faces")

(require 'apropos)
(require 'apt-sources-list)
(require 'compile)
(require 'css-mode)
(require 'diff-mode)
(require 'erc-button)
(require 'erc-goodies)
(require 'erc-match)
(require 'ffap)
(require 'gnus-cite)
(require 'man)
(require 'markdown-mode)
(require 'org)
(require 'sh-script)
(require 'slime)
(require 'slime-presentations)
(require 'slime-repl)
(require 'time)
(require 'w3m-form)

(defalias 'df #'describe-face)

(defun set-all-faces (fg &optional bg weight)
  (or bg (setq bg "black"))
  (or weight (setq weight 'normal))
  (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 bg
                          :weight     weight
                          :italic     nil) )))

;; (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) )))
    (if face
        (let ((face-str (format "%s" face)))
          (kill-new face-str)
          (message face-str) )
      (message "no face!") )))

(defalias 'wf #'what-face)

(defun set-face (face fg &optional bold bg)
  (setq bold (if bold 'bold 'normal))
  (or bg (setq bg "black"))
  (set-face-attribute face nil
                      :foreground fg
                      :background bg
                      :weight     bold) )
(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))
            (bld (face-attribute src :weight     nil 'default)) )
        (set-face-attribute d nil
                            :foreground fg
                            :background bg
                            :weight     bld) ))))
(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-lcok-operator-face"             . 'font-lock-operator-face)
   ("font-lock-preprocessor-face"         .  font-lock-preprocessor-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              "blue"   t)
(sfa 'bold-italic       "magenta")
(sfa 'button            "green"  t)
(sfa 'default           "white")
(sfa 'ffap              "black"  nil "white")
(sfa 'homoglyph         "magenta")
(sfa 'icon-button       "green"  t)
(sfa 'italic            "blue"   t)
(sfa 'match             "black"  nil "white")
(sfa 'minibuffer-prompt "cyan")
(sfa 'nobreak-space     "black"  t)
(sfa 'region            "white"  t   "white")
(sfa 'shadow            "magenta")
(sfa 'underline         "yellow" t)
(sfa 'warning           "red"    t)

(sfa  font-lock-builtin-face              "cyan")
(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        "yellow")
(sfa  font-lock-keyword-face              "green"   t)
(sfa  font-lock-negation-char-face        "black"   t)
(sfa 'font-lock-operator-face             "white"   t)
(sfa  font-lock-preprocessor-face         "cyan"    t)
(sfa  font-lock-string-face               "green")
(sfa  font-lock-type-face                 "magenta")
(sfa  font-lock-variable-name-face        "yellow"  t)
(sfa 'font-lock-regexp-grouping-backslash "blue")
(sfa 'font-lock-regexp-grouping-construct "red"     t)

(cpf font-lock-comment-face font-lock-comment-delimiter-face)
(cpf 'warning font-lock-warning-face)

;; faces

(sfa 'world-clock-label  "white" t)
(sfa 'escape-glyph       "yellow")
(sfa 'mm-uu-extract      "green" nil "black")
(sfa 'sh-escaped-newline "red"   t)

;; markdown-mode

(sfa 'markdown-bold-face             "cyan")
(sfa 'markdown-footnote-marker-face  "green"   t)
(sfa 'markdown-header-delimiter-face "green")
(sfa 'markdown-header-face-1         "white"   t)
(sfa 'markdown-header-face-2         "yellow")
(sfa 'markdown-hr-face               "white")
(sfa 'markdown-inline-code-face      "green"   t)
(sfa 'markdown-italic-face           "yellow"  t)
(sfa 'markdown-link-face             "magenta" t)
(sfa 'markdown-list-face             "white")
(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)
(sfa 'markdown-pre-face              "black"   t)
(sfa 'markdown-url-face              "green"   t)

;; Makefile

(sfa 'makefile-shell   "green" t)
(sfa 'makefile-targets "cyan"  nil)

;; org

(sfa 'org-block            "white"  nil)
(sfa 'org-block-begin-line "blue"   t)
(sfa 'org-block-end-line   "blue"   t)
(sfa 'org-meta-line        "white"  t)

;; slime

(sfa 'slime-inspector-value-face "white" t)
(sfa 'slime-inspector-label-face "cyan"  nil)

;; slime repl

(sfa 'slime-repl-input-face          "white" t)
(sfa 'slime-repl-inputed-output-face "white" nil)
(sfa 'slime-repl-output-face         "white" nil)
(sfa 'slime-repl-prompt-face         "green" t)
(sfa 'slime-repl-result-face         "blue"  t)

;; sldb

(sfa 'sldb-condition-face              "green"  t)
(sfa 'sldb-frame-label-face            "black"  t)
(sfa 'sldb-frame-line-face             "black"  t)
(sfa 'sldb-restart-face                "black"  t)
(sfa 'sldb-restart-number-face         "yellow" nil)
(sfa 'sldb-restart-type-face           "green"  t)
(sfa 'sldb-restartable-frame-line-face "white"  nil)
(sfa 'sldb-section-face                "cyan"   nil "black")
(sfa 'sldb-topline-face                "white"  t)

;; diff

(sfa 'diff-refine-added   "black" nil "green")
(sfa 'diff-refine-removed "black" nil "red")
(sfa 'diff-removed        "black" t)

;; apropos

(sfa 'apropos-function-button "green"   t)
(sfa 'apropos-misc-button     "yellow")
(sfa 'apropos-property        "white"   t)
(sfa 'apropos-symbol          "blue"    t)
(sfa 'apropos-variable-button "magenta" t)

(cpf 'apropos-variable-button 'apropos-user-option-button)

;; apt-sources-list-mode
(sfa 'apt-sources-list-components "magenta" t)
(sfa 'apt-sources-list-options    "yellow"  t)
(sfa 'apt-sources-list-suite      "blue"    t)
(sfa 'apt-sources-list-type       "cyan"    t)
(sfa 'apt-sources-list-uri        "green"   t)

;; ispell / isearch
(sfa 'isearch        "black" nil "yellow")
(sfa 'lazy-highlight "black" nil "yellow")

;; man(1)
(sfa 'Man-overstrike "cyan")
(sfa 'Man-underline  "yellow" t)

;; compilation
(sfa 'compilation-error "red"   t)
(sfa 'compilation-info  "green" t)

;; help
(sfa 'help-argument-name   "magenta" nil)
(sfa 'help-for-help-header "green"   t)
(sfa 'help-key-binding     "cyan"    nil)

(cpf 'help-key-binding 'apropos-keybinding)

;; outline
(sfa 'outline-1 "yellow")
(sfa 'outline-2 "green" t)
(sfa 'outline-3 "cyan")
(sfa 'outline-4 "yellow")

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

;; isearch
(sfa 'isearch "yellow" nil "black")

;; CSS
 (sfa 'css-selector "yellow")
 (sfa 'css-property "green" t)

;; completion
(sfa 'completions-highlight        "white" t)
(sfa 'completions-common-part      "green")
(sfa 'completions-first-difference "yellow")

;; package
(sfa 'package-description       "white")
(sfa 'package-help-section-name "blue"   t)
(sfa 'package-name              "white"  t)
(sfa 'package-status-available  "yellow" t)
(sfa 'package-status-built-in   "yellow")
(sfa 'package-status-dependency "black"  t)
(sfa 'package-status-installed  "green"  t)
(sfa 'package-status-new        "cyan")

;; erc

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

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

;; message / gnus
(sfa 'separator-line "white")
(cpf 'separator-line
       'message-separator
       'message-signature-separator)

(sfa 'message-header-cc         "cyan")
(sfa 'message-header-name       "green")
(sfa 'message-header-newsgroups "magenta" t)
(sfa 'message-header-other      "black"   t)
(sfa 'message-header-subject    "yellow")
(sfa 'message-header-to         "white"   t)
(sfa 'message-header-xheader    "black"   t)

(cpf 'message-header-cc         'gnus-header-cc)
(cpf 'message-header-name       'gnus-header-name)
(cpf 'message-header-newsgroups 'gnus-header-newsgroups)
(cpf 'message-header-subject    'gnus-header-subject)

(sfa 'message-cited-text-1 "blue"    t)
(sfa 'message-cited-text-2 "green"   t)
(sfa 'message-cited-text-3 "magenta" t)
(sfa 'message-cited-text-4 "magenta")

(cpf 'message-cited-text-1 'gnus-cite-1)
(cpf 'message-cited-text-2 'gnus-cite-2)
(cpf 'message-cited-text-3 'gnus-cite-3)
(cpf 'message-cited-text-4 'gnus-cite-4)

(sfa 'gnus-cite-5 "white"   t)
(sfa 'gnus-cite-6 "yellow"  t)
(sfa 'gnus-cite-7 "blue"    t)
(sfa 'gnus-cite-8 "green")
(sfa 'gnus-cite-9 "yellow")

(sfa 'gnus-emphasis-italic "yellow")

(sfa 'gnus-header-content "black" t) ; DNC ?
(sfa 'gnus-header-from    "blue"  t)

(sfa 'gnus-server-closed "black"  t)
(sfa 'gnus-server-opened "green")

(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)

(sfa 'gnus-cite-attribution "blue"    t) ; DNC ?

(sfa 'gnus-group-mail-1       "yellow")
(sfa 'gnus-group-mail-3       "cyan")
(sfa 'gnus-group-news-3       "green" t)
(sfa 'gnus-group-news-3-empty "white")
(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
       'gnus-group-news-low-empty)

(sfa 'gnus-summary-cancelled      "black"   t)
(sfa 'gnus-summary-low-ancient    "magenta" t)
(sfa 'gnus-summary-low-read       "magenta" t)
(sfa 'gnus-summary-low-ticked     "yellow")
(sfa 'gnus-summary-normal-ancient "magenta" t)
(sfa 'gnus-summary-normal-read    "green")
(sfa 'gnus-summary-normal-ticked  "yellow")
(sfa 'gnus-summary-normal-unread  "white")
(sfa 'gnus-summary-selected       "black"   nil "white")

;; mode line
(sfa 'mode-line           "blue"       t "white")
(sfa 'mode-line-active    "blue"       t "white")
(sfa 'mode-line-buffer-id 'unspecified 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-perm-write "cyan"   t)
(sfa 'dired-directory  "blue"   t)
(sfa 'dired-header     "green")
(sfa 'dired-ignored    "black"  t)
(sfa 'dired-mark       "yellow" t)
(sfa 'dired-perm-write "red"    t)
(sfa 'dired-set-id     "black"  nil "yellow")
(sfa 'dired-symlink    "cyan")

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

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

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

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

;; comint
(sfa 'comint-highlight-input  "magenta" t)
(sfa 'comint-highlight-prompt "green"   t)

;; Info
(sfa 'Info-quoted "magenta" t)

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

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

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

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

(cpf 'button
       'apropos-button
       'browse-url-button
       'erc-button
       'gnus-button
       'link
       'w3m-anchor
       )

(cpf 'italic 'w3m-italic)

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

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

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

(provide 'face)