;;; case-theme -*- lexical-binding: t; -*-
;; a little theme (framework)
;; named after me, Case Duckworth <acdw@acdw.net>

(deftheme case
  "a little theme (framework)"
  :background-mode 'light)

;;; Customization

(defgroup case-theme nil
  "a little theme (framework) customization")

(defun case-update (sym val)
  "Update the theme `case' with new values.
Stolen from `modus-themes--set-option', which see."
  (set-default sym val)
  (unless (null (bound-and-true-p custom--inhibit-theme-enable))
    (load-theme 'case t)))

(defcustom case-foreground "black"
  "Default face text color"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-background "white"
  "Default face background color"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-highlight-1 "yellow"
  "Main highlight background color"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-highlight-2 "gray"
  "Secondary highlight background color"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-link "navy"
  "Link foreground color"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-success "green"
  "Success foreground color"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-error "red"
  "Error background color"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-warning "dark orange"
  "Warning background color"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-shadow "gray"
  "Foreground color for less-important information"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-string "gray95"
  "Background color for strings"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-region "gray85"
  "Bacground color for the region"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-mode-line-active "cyan"
  "Active modeline background"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defcustom case-mode-line-inactive "gray"
  "Inactive modeline background"
  :type 'string
  :set #'case-update
  :initialize #'custom-initialize-default)

(defface case-prompt '((t (:weight bold)))
  "Face for prompts")

;;; Set the colors

;; (custom-theme-set-variables 'case)

(defun fclear (face)
  "Return a `custom-theme-set-faces' spec clearing FACE of all properties."
  ;; TODO: Allow interactive use that will call .. that function that sets the
  ;; face on the fly
  (list face '((t ()))))

(custom-theme-set-faces
 'case
 ;; Default
 `(default ((t ( :foreground ,case-foreground
                 :background ,case-background))))

 ;; Font lock -- clear
 (fclear 'font-lock-bracket-face)
 (fclear 'font-lock-builtin-face)
 (fclear 'font-lock-constant-face)
 (fclear 'font-lock-delimiter-face)
 (fclear 'font-lock-doc-markup-face)
 (fclear 'font-lock-escape-face)
 (fclear 'font-lock-function-call-face)
 (fclear 'font-lock-function-name-face)
 (fclear 'font-lock-keyword-face)
 (fclear 'font-lock-misc-punctuation-face)
 (fclear 'font-lock-negation-char-face)
 (fclear 'font-lock-number-face)
 (fclear 'font-lock-operator-face)
 (fclear 'font-lock-preprocessor-face)
 (fclear 'font-lock-property-name-face)
 (fclear 'font-lock-property-use-face)
 (fclear 'font-lock-punctuation-face)
 (fclear 'font-lock-regexp-face)
 (fclear 'font-lock-regexp-grouping-backslash)
 (fclear 'font-lock-regexp-grouping-construct)
 (fclear 'font-lock-type-face)
 (fclear 'font-lock-variable-name-face)
 (fclear 'font-lock-variable-use-face)
 (fclear 'font-lock-warning-face)

 ;; Font lock
 `(font-lock-comment-delimiter-face ((t (:slant italic))))
 `(font-lock-comment-face ((t (:slant italic))))
 `(font-lock-string-face ((t ( :underline nil :bold nil
                               :background ,case-string))))
 `(font-lock-doc-face ((t (:inherit (font-lock-string-face
                                     font-lock-comment-face)))))

 ;; Propertized text
 `(bold ((t (:weight bold))))
 `(error ((t (:foreground ,case-error :slant italic))))
 `(highlight ((t (:background ,case-highlight-2))))
 `(isearch ((t (:background ,case-highlight-1))))
 `(isearch-fail ((t (:background ,case-error))))
 `(italic ((t (:slant italic))))
 `(lazy-highlight ((t (:background ,case-highlight-2))))
 `(link ((t (:foreground ,case-link :underline t))))
 `(match ((t (:background ,case-highlight-2))))
 `(pulse-highlight-start-face ((t (:background ,case-highlight-1))))
 `(query-replace ((t (:background ,case-highlight-2))))
 `(region ((t (:background ,case-region))))
 `(shadow ((t (:foreground ,case-shadow))))
 `(show-paren-match ((t (:background ,case-highlight-2))))
 `(show-paren-mismatch ((t (:foreground ,case-error :slant italic))))
 `(success ((t (:foreground ,case-success :slant italic))))
 `(trailing-whitespace ((t (:background ,case-error))))
 `(underline ((t (:underline t))))
 `(warning ((t (:foreground ,case-warning :slant italic))))

 ;; User interface
 `(completions-annotations ((t (:inherit 'italic))))
 `(completions-highlight ((t (:background ,case-highlight-1))))
 `(header-line ((t (:inherit (mode-line-inactive)))))
 `(minibuffer-prompt ((t (:inherit case-prompt))))
 `(mode-line ((t (:background ,case-shadow :inherit variable-pitch))))
 `(mode-line-active ((t ( :box ,case-foreground :background ,case-mode-line-active
                          :inherit mode-line))))
 `(mode-line-inactive ((t ( :box ,case-mode-line-inactive
                            :background ,case-mode-line-inactive
                            :inherit mode-line))))
 `(tab-bar ((t (:inherit mode-line-inactive))))
 `(tab-bar-tab ((t ( :weight bold :underline t
                     :inherit variable-pitch))))
 `(tab-bar-tab-inactive ((t ( :background ,case-mode-line-inactive
                              :inherit variable-pitch))))
 `(vertical-border ((t (:foreground ,case-shadow))))

 ;;; Specific modes &c
 ;; Outline --- these go first b/c so many other headlines inherit from them
 `(outline-1 ((t (:inherit (bold underline italic) :extend t))))
 `(outline-2 ((t (:inherit (bold underline)))))
 `(outline-3 ((t (:inherit (italic underline)))))
 `(outline-3 ((t (:inherit (italic underline)))))
 `(outline-4 ((t (:inherit (italic underline)))))
 `(outline-5 ((t (:inherit (italic underline)))))
 `(outline-6 ((t (:inherit (italic underline)))))
 `(outline-7 ((t (:inherit (italic underline)))))
 `(outline-8 ((t (:inherit (italic underline)))))
 ;; Avy
 `(avy-lead-face ((t (:inherit isearch :box t))))
 `(avy-lead-face-0 ((t (:inherit avy-lead-face))))
 `(avy-lead-face-1 ((t (:inherit avy-lead-face))))
 `(avy-lead-face-2 ((t (:inherit avy-lead-face))))
 ;; Dired
 `(dired-header ((t (:underline t :extend t))))
 ;; Dired-Subtree
 (fclear 'dired-subtree-depth-1-face)
 (fclear 'dired-subtree-depth-2-face)
 (fclear 'dired-subtree-depth-3-face)
 (fclear 'dired-subtree-depth-4-face)
 (fclear 'dired-subtree-depth-5-face)
 (fclear 'dired-subtree-depth-6-face)
 ;; Elastic indent
 `(elastic-indent ((t ())))
 ;; Eshell
 `(eshell-prompt ((t (:inherit case-prompt))))
 ;; Eww
 `(eww-form-text ((t (:inherit alice-input-field))))
 ;; Gemtext mode
 `(gemtext-face-heading1 ((t (:inherit outline-1))))
 `(gemtext-face-heading2 ((t (:inherit outline-2))))
 `(gemtext-face-heading3 ((t (:inherit outline-3))))
 `(gemtext-face-markup ((t (:inherit font-lock-comment-face))))
 `(gemtext-face-pre-text ((t (:extend t :inherit font-lock-string-face))))
 ;; Info
 `(info-title-1 ((t (:inherit outline-1))))
 `(info-title-2 ((t (:inherit outline-2))))
 `(info-title-3 ((t (:inherit outline-3))))
 `(info-title-4 ((t (:inherit outline-4))))
 ;; Jabber
 `(jabber-activity-face ((t (:inherit italic))))
 `(jabber-activity-personal-face ((t (:inherit rcirc-track-nick))))
 `(jabber-chat-error ((t (:inherit error))))
 `(jabber-chat-prompt-foreign ((t (:inherit case-prompt))))
 `(jabber-chat-prompt-local ((t (:inherit case-prompt))))
 `(jabber-chat-prompt-system ((t (:inherit case-prompt))))
 `(jabber-chat-text-foreign ((t (:inherit default))))
 `(jabber-chat-text-local ((t (:inherit default))))
 `(jabber-muc-presence-dim ((t (:inherit shadow))))
 `(jabber-rare-time-face ((t (:inherit shadow))))
 `(jabber-title-large ((t (:inherit outline-1))))
 `(jabber-title-medium ((t (:inherit outline-2))))
 `(jabber-title-small ((t (:inherit outline-3))))
 (fclear 'markdown-markup-face)
 ;; Org
 `(org-document-info-keyword ((t (:inherit (bold)))))
 `(org-document-info ((t (:inherit (italic)))))
 `(org-document-title ((t (:inherit (bold italic underline)))))
 `(org-drawer ((t (:inherit (font-lock-comment-face)))))
 `(org-verbatim ((t (:background ,case-string))))
 ;; RCIRC
 `(rcirc-my-nick ((t (:weight bold :slant italic))))
 `(rcirc-nick-in-message ((t (:weight bold :slant italic))))
 `(rcirc-other-nick ((t (:slant italic))))
 `(rcirc-prompt ((t (:inherit case-prompt))))
 `(rcirc-timestamp ((t (:inherit shadow))))
 `(rcirc-server ((t (:inherit shadow))))
 `(rcirc-track-nick ((t (:weight bold :slant italic :inverse-video nil))))
 ;; Sh
 `(sh-heredoc ((t ( :inherit font-lock-string-face :extend t ))))
 (fclear 'sh-quoted-exec)
 ;; Widgets
 `(widget-field ((t (:inherit alice-input-field))))
 `(widget-single-line-field ((t (:inherit alice-input-field))))
 ;; Whitespace-mode
 `(whitespace-tab ((t (:foreground ,case-shadow))))
 )