/ almost-mono-themes.el
almost-mono-themes.el
  1  ;;; almost-mono-themes.el --- Almost monochromatic color themes -*- lexical-binding: t; -*-
  2  
  3  ;; Copyright (C) 2019 - 2025 John Olsson
  4  
  5  ;; Author: John Olsson <john@cryon.se>
  6  ;; Maintainer: John Olsson <john@cryon.se>
  7  ;; URL: https://github.com/cryon/almost-mono-themes
  8  ;; Created: 9th May 2019
  9  ;; Version: 1.0.0
 10  ;; Keywords: faces
 11  ;; Package-Requires: ((emacs "24"))
 12  
 13  ;; This file is free software: you can redistribute it and/or modify
 14  ;; it under the terms of the GNU General Public License as published
 15  ;; by the Free Software Foundation, either version 3 of the License,
 16  ;; or (at your option) any later version.
 17  
 18  ;; This file is distributed in the hope that it will be useful, but
 19  ;; WITHOUT ANY WARRANTY; without even the implied warranty of
 20  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 21  ;; General Public License for more details.
 22  
 23  ;; You should have received a copy of the GNU General Public License
 24  ;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
 25  
 26  ;;; Commentary:
 27  
 28  ;; A suite of almost monochrome Emacs themes
 29  
 30  ;;; Code:
 31  
 32  (defconst almost-mono-themes-colors
 33    '((white . ((background . "#ffffff")
 34  	      (foreground . "#000000")
 35  	      (weak	  . "#888888")
 36  	      (weaker	  . "#dddddd")
 37  	      (weakest    . "#efefef")
 38  	      (highlight  . "#fda50f")
 39  	      (warning	  . "#ff0000")
 40  	      (success	  . "#00ff00")
 41  	      (string     . "#3c5e2b")))
 42  
 43      (black . ((background . "#000000")
 44  	      (foreground . "#ffffff")
 45  	      (weak	  . "#aaaaaa")
 46  	      (weaker	  . "#666666")
 47  	      (weakest	  . "#222222")
 48  	      (highlight  . "#fda50f")
 49  	      (warning	  . "#ff0000")
 50  	      (success	  . "#00ff00")
 51  	      (string     . "#a7bca4")))
 52  
 53      (gray .  ((background . "#2b2b2b")
 54  	      (foreground . "#ffffff")
 55  	      (weak	  . "#aaaaaa")
 56  	      (weaker	  . "#666666")
 57  	      (weakest	  . "#222222")
 58  	      (highlight  . "#fda50f")
 59  	      (warning	  . "#ff0000")
 60  	      (success	  . "#00ff00")
 61  	      (string     . "#a7bca4")))
 62  
 63      (cream . ((background . "#f0e5da")
 64  	      (foreground . "#000000")
 65  	      (weak	  . "#7d7165")
 66  	      (weaker	  . "#c4baaf")
 67  	      (weakest    . "#dbd0c5")
 68  	      (highlight  . "#fda50f")
 69  	      (warning	  . "#ff0000")
 70  	      (success	  . "#00ff00")
 71  	      (string     . "#3c5e2b")))))
 72  
 73  (defmacro almost-mono-themes--variant-with-colors (variant &rest body)
 74    "Execute BODY in a scope where the different colors for given VARIANT is bound."
 75    `(let* ((colors (or (cdr (assoc ,variant almost-mono-themes-colors))
 76  		      (error "No such theme variant")))
 77  	  (background (cdr (assoc 'background colors)))
 78  	  (foreground (cdr (assoc 'foreground colors)))
 79  	  (weak	      (cdr (assoc 'weak colors)))
 80  	  (weaker     (cdr (assoc 'weaker colors)))
 81  	  (weakest    (cdr (assoc 'weakest colors)))
 82  	  (highlight  (cdr (assoc 'highlight colors)))
 83  	  (warning    (cdr (assoc 'warning colors)))
 84  	  (success    (cdr (assoc 'success colors)))
 85  	  (string     (cdr (assoc 'string colors))))
 86       ,@body))
 87  
 88  (defmacro almost-mono-themes--faces-spec ()
 89    "Provide the faces specification."
 90    (quote
 91     (mapcar
 92      (lambda (entry) (list (car entry) `((t ,@(cdr entry)))))
 93      `(
 94  
 95        ;; default
 96        (default (:background ,background :foreground ,foreground))
 97        (fringe  (:background ,background))
 98        (region  (:background ,highlight  :foreground ,foreground))
 99        (show-paren-match (:background ,background :foreground ,success :bold t))
100        (show-paren-mismatch (:background ,background :foreground ,warning :bold t))
101        (minibuffer-prompt (:weight bold :foreground ,foreground))
102        (isearch (:background ,weak :foreground ,foreground :bold t))
103        (lazy-highlight (:background ,weaker :foreground ,foreground))
104        (link (:underline t))
105  
106        ;; mode line
107        (mode-line (:box (:line-width -1 :color ,weaker)
108  		       :background ,weakest :foreground ,foreground))
109  
110        (mode-line-inactive (:box (:line-width -1 :color ,weaker)
111  				:background ,background :foreground ,weaker))
112  
113        ;; font lock
114        (font-lock-keyword-face (:bold t))
115        (font-lock-function-name-face (:bold t))
116        (font-lock-variable-name-face (:foreground ,foreground))
117        (font-lock-warning-face (:foreground ,foreground :underline (:color ,warning :style wave)))
118        (font-lock-builtin-face (:bold t))
119        (font-lock-variable-name-face (:foreground ,foreground :italic t))
120        (font-lock-constant-face (:bold t :italic t))
121        (font-lock-type-face (:italic t))
122        (font-lock-preprocessor-face (:italic t))
123        (font-lock-comment-face (:foreground ,weak :italic t))
124        (font-lock-string-face (:foreground ,string))
125        (font-lock-doc-face (:inherit font-lock-comment-face))
126        (line-number (:foreground ,weaker))
127        (linum (:inherit line-number))
128        (vertical-border (:foreground ,weaker))
129  
130        ;; eshell
131        (eshell-prompt (:foreground ,foreground :bold t))
132        (eshell-ls-directory (:foreground ,foreground :bold t))
133        (eshell-ls-archive (:inherit eshell-ls-unreadable))
134        (eshell-ls-backup (:inherit eshell-ls-unreadable))
135        (eshell-ls-clutter (:inherit eshell-ls-unreadable))
136        (eshell-ls-executable (:inherit eshell-ls-unreadable))
137        (eshell-ls-missing (:inherit eshell-ls-unreadable))
138        (eshell-ls-product (:inherit eshell-ls-unreadable))
139        (eshell-ls-readonly (:inherit eshell-ls-unreadable))
140        (eshell-ls-special (:inherit eshell-ls-unreadable))
141        (eshell-ls-symlink (:inherit eshell-ls-unreadable))
142  
143        ;; company mode
144        (company-tooltip (:background ,weakest :foreground ,foreground))
145        (company-tooltip-selection (:background ,weaker :foreground ,foreground))
146        ;;(company-tooltip-search (:background "#ff0000" :foreground "#00ff00"))
147        (company-tooltip-common (:bold t))
148        (company-tooltip-common-selection (:bold t))
149        (company-scrollbar-bg (:background ,weaker))
150        (company-scrollbar-fg (:background ,weak))
151        (company-tooltip-annotation-selection (:background ,weaker :foreground ,foreground :italic t))
152        (company-tooltip-annotation (:background ,weakest :foreground ,weak :italic t))
153  
154        ;; git gutter
155        (git-gutter:modified (:background ,highlight :foreground ,highlight))
156        (git-gutter:added (:background ,success :foreground ,success))
157        (git-gutter:deleted (:background ,warning :foreground ,warning))
158  
159        ;; diff hl
160        (diff-hl-change (:background ,highlight :foreground ,highlight))
161        (diff-hl-insert (:background ,success :foreground ,success))
162        (diff-hl-delete (:background ,warning :foreground ,warning))
163  
164        ;; hl line
165        (hl-line (:background ,weakest))
166        (highlight-current-line-face (:inherit hl-line))
167  
168        ;; ido
169        (ido-first-match (:bold t))
170        (ido-only-match (:bold t))
171        (ido-subdir (:italic t))
172        (ido-virtual (:foreground ,weak))
173        (ido-vertical-match-face (:bold t :italic nil))
174  
175        ;; org mode
176        (org-document-title (:foreground ,foreground))
177        (org-drawer (:foreground ,weak))
178        (org-special-keyword (:bold t :foreground ,weak))
179        (org-property-value (:italic t :foreground ,weak))
180        (org-table (:foreground ,weak))
181  
182        (org-todo (:bold t :foreground ,highlight))
183        (org-done (:bold t :foreground ,success))
184        (org-headline-done (:bold t :foreground ,foreground))
185  
186        ;; various completion matches
187        (vertico-current (:bold t :foreground ,foreground :background ,highlight))
188  
189        (completions-common-part (:bold t :underline t))
190        (orderless-match-face-0 (:bold t :underline t))
191        (orderless-match-face-1 (:bold t :underline t))
192        (orderless-match-face-2 (:bold t :underline t))
193        (orderless-match-face-3 (:bold t :underline t))
194        ))))
195  
196  
197  (defun almost-mono-themes--variant-name (variant)
198    "Create symbol for color theme variant VARIANT."
199    (intern (format "almost-mono-%s" (symbol-name variant))))
200  
201  (defmacro almost-mono-themes--define-theme (variant)
202    "Define a theme for the almost-mono variant VARIANT."
203    (let ((name (almost-mono-themes--variant-name variant))
204          (doc (format "almost mono theme (%s version)" variant)))
205      `(progn
206         (deftheme ,name ,doc)
207         (put ',name 'theme-immediate t)
208         (almost-mono-themes--variant-with-colors
209          ',variant
210          (apply 'custom-theme-set-faces ',name
211                 (almost-mono-themes--faces-spec)))
212         (provide-theme ',name))))
213  
214  ;;;###autoload
215  (when (and (boundp 'custom-theme-load-path) load-file-name)
216    (add-to-list 'custom-theme-load-path
217  	       (file-name-as-directory (file-name-directory load-file-name))))
218  
219  (provide 'almost-mono-themes)
220  
221  ;;; almost-mono-themes.el ends here