-
-
Notifications
You must be signed in to change notification settings - Fork 18
/
ef-themes.el
2584 lines (2431 loc) · 129 KB
/
ef-themes.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; ef-themes.el --- Colorful and legible themes -*- lexical-binding:t -*-
;; Copyright (C) 2022-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <[email protected]>
;; Maintainer: Protesilaos Stavrou <[email protected]>
;; URL: https://github.com/protesilaos/ef-themes
;; Version: 1.9.0
;; Package-Requires: ((emacs "28.1"))
;; Keywords: faces, theme, accessibility
;; This file is NOT part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; The `ef-themes' are a collection of light and dark themes for GNU
;; Emacs whose goal is to provide colorful ("pretty") yet legible
;; options for users who want something with a bit more flair than the
;; `modus-themes' (also designed by me).
;;
;; "Ef" is a Greek word (ευ), commonly used as a prefix to denote
;; something good, nice, and/or easy. For example, eftopia (ευτοπία)
;; is the opposite of dystopia (δυστοπία): a good place as opposed to
;; a bad place.
;;
;; The backronym of the `ef-themes' is: Eclectic Fashion in Themes
;; Hides Exaggerated Markings, Embellishments, and Sparkles.
;;; Code:
(require 'seq)
(eval-when-compile (require 'subr-x))
(defgroup ef-themes ()
"Colorful and legible themes."
:group 'faces
:link '(info-link "(ef-themes) Top")
:link '(url-link :tag "Homepage" "https://protesilaos.com/emacs/ef-themes")
:link '(url-link :tag "Sample pictures" "https://protesilaos.com/emacs/ef-themes-pictures")
:prefix "ef-themes-"
:tag "Ef Themes")
;;; User options
(defconst ef-themes-light-themes
'(ef-arbutus
ef-cyprus
ef-day
ef-deuteranopia-light
ef-duo-light
ef-eagle
ef-elea-light
ef-frost
ef-kassio
ef-light
ef-maris-light
ef-melissa-light
ef-reverie
ef-spring
ef-summer
ef-trio-light
ef-tritanopia-light)
"List of symbols with the light Ef themes.")
(defconst ef-themes-dark-themes
'(ef-autumn
ef-bio
ef-cherie
ef-dark
ef-deuteranopia-dark
ef-dream
ef-duo-dark
ef-elea-dark
ef-maris-dark
ef-melissa-dark
ef-night
ef-owl
ef-rosa
ef-symbiosis
ef-trio-dark
ef-tritanopia-dark
ef-winter)
"List of symbols with the dark Ef themes.")
(defvaralias 'ef-themes-items 'ef-themes-collection
"Alias of `ef-themes-collection'.")
(defconst ef-themes-collection
(append ef-themes-light-themes ef-themes-dark-themes)
"Symbols of all the Ef themes.")
(defvaralias 'ef-themes-after-load-theme-hook 'ef-themes-post-load-hook
"Alias for `ef-themes-post-load-hook'.")
(defcustom ef-themes-post-load-hook nil
"Hook that runs after loading an Ef theme.
This is used by the commands `ef-themes-select' and
`ef-themes-load-random'."
:type 'hook
:package-version '(ef-themes . "0.2.0")
:group 'ef-themes)
(defcustom ef-themes-disable-other-themes t
"Disable all other themes when loading a Ef theme.
When the value is non-nil, the commands `ef-themes-toggle' and
`ef-themes-select' will disable all other themes while loading
the specified Ef theme. This is done to ensure that Emacs does
not blend two or more themes: such blends lead to awkward results
that undermine the work of the designer.
When the value is nil, the aforementioned commands will only
disable other themes within the Ef collection.
This option is provided because Emacs themes are not necessarily
limited to colors/faces: they can consist of an arbitrary set of
customizations. Users who use such customization bundles must
set this variable to a nil value."
:group 'ef-themes
:package-version '(ef-themes . "0.11.0")
:type 'boolean)
(defcustom ef-themes-to-toggle nil
"Specify two `ef-themes' for `ef-themes-toggle' command.
The variable `ef-themes-collection' contains the symbols of all
themes that form part of this collection."
:type `(choice
(const :tag "No toggle (default)" nil)
(list :tag "Pick two themes to toggle between"
(choice :tag "Theme one of two"
,@(mapcar (lambda (theme)
(list 'const theme))
ef-themes-collection))
(choice :tag "Theme two of two"
,@(mapcar (lambda (theme)
(list 'const theme))
ef-themes-collection))))
:package-version '(ef-themes . "0.3.0")
:group 'ef-themes)
(defcustom ef-themes-to-rotate ef-themes-items
"List of Ef themes to rotate among, per `ef-themes-rotate'."
:type `(repeat (choice
:tag "A theme among the `ef-themes-items'"
,@(mapcar (lambda (theme) (list 'const theme)) ef-themes-items)))
:package-version '(ef-themes . "1.9.0")
:group 'ef-themes)
(defconst ef-themes-weights
'( thin ultralight extralight light semilight regular medium
semibold bold heavy extrabold ultrabold)
"List of font weights.")
(defconst ef-themes--headings-choice
'(set :tag "Properties" :greedy t
(const :tag "Proportionately spaced font (variable-pitch)" variable-pitch)
(choice :tag "Font weight (must be supported by the typeface)"
(const :tag "Bold (default)" nil)
(const :tag "Thin" thin)
(const :tag "Ultra-light" ultralight)
(const :tag "Extra-light" extralight)
(const :tag "Light" light)
(const :tag "Semi-light" semilight)
(const :tag "Regular" regular)
(const :tag "Medium" medium)
(const :tag "Semi-bold" semibold)
(const :tag "Extra-bold" extrabold)
(const :tag "Ultra-bold" ultrabold))
(radio :tag "Height"
(float :tag "Floating point to adjust height by")
(cons :tag "Cons cell of `(height . FLOAT)'"
(const :tag "The `height' key (constant)" height)
(float :tag "Floating point"))))
"Refer to the doc string of `ef-themes-headings'.
This is a helper variable intended for internal use.")
(defcustom ef-themes-headings nil
"Heading styles with optional list of values per heading level.
This is an alist that accepts a (KEY . LIST-OF-VALUES)
combination. The KEY is either a number, representing the
heading's level (0-8) or t, which pertains to the fallback style.
The named keys `agenda-date' and `agenda-structure' apply to the
Org agenda.
Level 0 is used for what counts as a document title or
equivalent, such as the #+title construct we find in Org files.
Levels 1-8 are regular headings.
The LIST-OF-VALUES covers symbols that refer to properties, as
described below. Here is a complete sample with various
stylistic combinations, followed by a presentation of all
available properties:
(setq ef-themes-headings
(quote ((1 light variable-pitch 1.5)
(2 regular 1.3)
(3 1.1)
(agenda-date 1.3)
(agenda-structure variable-pitch light 1.8)
(t variable-pitch))))
By default (a nil value for this variable), all headings have a
bold typographic weight, a font family that is the same as the
`default' face (typically monospaced), and a height that is equal
to the `default' face's height.
- A `variable-pitch' property changes the font family of the
heading to that of the `variable-pitch' face (normally a
proportionately spaced typeface). Also check the `fontaine'
package (by Protesilaos) for tweaking fonts via faces.
- The symbol of a weight attribute adjusts the font of the
heading accordingly, such as `light', `semibold', etc. Valid
symbols are defined in the variable `ef-themes-weights'. The
absence of a weight means that bold will be used by virtue of
inheriting the `bold' face.
- A number, expressed as a floating point (e.g. 1.5), adjusts the
height of the heading to that many times the base font size.
The default height is the same as 1.0, though it need not be
explicitly stated. Instead of a floating point, an acceptable
value can be in the form of a cons cell like (height . FLOAT)
or (height FLOAT), where FLOAT is the given number.
Combinations of any of those properties are expressed as a list,
like in these examples:
(semibold)
(variable-pitch semibold)
(variable-pitch semibold 1.3)
(variable-pitch semibold (height 1.3)) ; same as above
(variable-pitch semibold (height . 1.3)) ; same as above
The order in which the properties are set is not significant.
In user configuration files the form may look like this:
(setq ef-themes-headings
(quote ((1 light variable-pitch 1.5)
(2 regular 1.3)
(3 1.1)
(t variable-pitch))))
When defining the styles per heading level, it is possible to
pass a non-nil non-list value (e.g. t) instead of a list of
properties. This will retain the original aesthetic for that
level. For example:
(setq ef-themes-headings
(quote ((1 . t) ; keep the default style
(2 variable-pitch 1.2)
(t variable-pitch)))) ; style for all other headings
(setq ef-themes-headings
(quote ((1 variable-pitch 1.6)
(2 1.3)
(t . t)))) ; default style for all other levels"
:group 'ef-themes
:package-version '(ef-themes . "0.10.0")
:type `(alist
:options ,(mapcar (lambda (el)
(list el ef-themes--headings-choice))
'(0 1 2 3 4 5 6 7 8 t agenda-date agenda-structure))
:key-type symbol
:value-type ,ef-themes--headings-choice)
:link '(info-link "(ef-themes) Option for headings"))
(defcustom ef-themes-mixed-fonts nil
"Non-nil to enable inheritance from `fixed-pitch' in some faces.
This is done to allow spacing-sensitive constructs, such as Org
tables and code blocks, to remain monospaced when users opt for a
proportionately spaced font as their default or when they use
something like the command `variable-pitch-mode'.
Users may need to explicitly configure the font family of
`fixed-pitch' in order to get a consistent experience with their
typography (also check the `fontaine' package on GNU ELPA (by
Protesilaos))."
:group 'ef-themes
:package-version '(ef-themes . "0.4.0")
:type 'boolean
:link '(info-link "(ef-themes) Enable mixed fonts"))
(defcustom ef-themes-variable-pitch-ui nil
"Use proportional fonts (`variable-pitch') in UI elements.
This includes the mode line, header line, tab bar, and tab line.
Users may need to explicitly configure the font family of
`variable-pitch' in order to get a consistent experience with
their typography (also check the `fontaine' package on GNU
ELPA (by Protesilaos))."
:group 'ef-themes
:package-version '(ef-themes . "0.4.0")
:type 'boolean
:link '(info-link "(ef-themes) UI typeface"))
(make-obsolete-variable 'ef-themes-region nil "1.4.0 (use palette overrides to change region colours)")
(defcustom ef-themes-common-palette-overrides nil
"Set palette overrides for all the Ef themes.
Mirror the elements of a theme's palette, overriding their value.
The palette variables are named THEME-NAME-palette, while
individual theme overrides are THEME-NAME-palette-overrides. The
THEME-NAME is one of the symbols in `ef-themes-collection'.
Individual theme overrides take precedence over these common
overrides.
To preview the palette entries, use `ef-themes-preview-colors' or
`ef-themes-preview-colors-current' (read the documentation for
further details)."
:group 'ef-themes
:package-version '(ef-themes . "1.0.0")
:type '(repeat (list symbol (choice symbol string)))
:link '(info-link "(ef-themes) Palette overrides"))
;;; Helpers for user options
(defun ef-themes--warn (option)
"Warn that OPTION has changed."
(prog1 nil
(display-warning
'ef-themes
(format "`%s' has changed; please read the updated documentation" option)
:warning)))
(defun ef-themes--list-or-warn (option)
"Return list or nil value of OPTION, else `ef-themes--warn'."
(let* ((value (symbol-value option)))
(if (or (null value) (listp value))
value
(ef-themes--warn option))))
(defun ef-themes--fixed-pitch ()
"Conditional application of `fixed-pitch' inheritance."
(when ef-themes-mixed-fonts
(list :inherit 'fixed-pitch)))
(defun ef-themes--variable-pitch-ui ()
"Conditional application of `variable-pitch' in the UI."
(when ef-themes-variable-pitch-ui
(list :inherit 'variable-pitch)))
(defun ef-themes--property-lookup (properties alist-key list-pred default)
"Return value from property alist or list.
Check PROPERTIES for an alist value that corresponds to
ALIST-KEY. If no alist is present, search the PROPERTIES
list given LIST-PRED, using DEFAULT as a fallback."
(if-let* ((val (or (alist-get alist-key properties)
(seq-filter (lambda (x) (funcall list-pred x)) properties)
default))
((listp val)))
(car val)
val))
(defun ef-themes--weight (list)
"Search for `ef-themes--heading' weight in LIST."
(catch 'found
(dolist (elt list)
(when (memq elt ef-themes-weights)
(throw 'found elt)))))
(defun ef-themes--heading (level)
"Conditional styles for `ef-themes-headings' per LEVEL heading."
(let* ((key (alist-get level ef-themes-headings))
(style (or key (alist-get t ef-themes-headings)))
(style-listp (listp style))
(properties style)
(var (when (and style-listp (memq 'variable-pitch properties)) 'variable-pitch))
(weight (when style-listp (ef-themes--weight style))))
(list :inherit
(cond
((not style-listp) 'bold)
(weight var)
(var (append (list 'bold) (list var)))
(t 'bold))
:height
(if style-listp
(ef-themes--property-lookup properties 'height #'floatp 'unspecified)
'unspecified)
:weight
(or weight 'unspecified))))
;;; Commands and their helper functions
(defun ef-themes--retrieve-palette-value (color palette)
"Return COLOR from PALETTE.
Use recursion until COLOR is retrieved as a string. Refrain from
doing so if the value of COLOR is not a key in the PALETTE.
Return `unspecified' if the value of COLOR cannot be determined.
This symbol is accepted by faces and is thus harmless.
This function is used in the macros `ef-themes-theme',
`ef-themes-with-colors'."
(let ((value (car (alist-get color palette))))
(cond
((or (stringp value)
(eq value 'unspecified))
value)
((and (symbolp value)
(memq value (mapcar #'car palette)))
(ef-themes--retrieve-palette-value value palette))
(t
'unspecified))))
(defun ef-themes-get-color-value (color &optional overrides theme)
"Return color value of named COLOR for current Ef theme.
COLOR is a symbol that represents a named color entry in the
palette.
If the value is the name of another color entry in the
palette (so a mapping), recur until you find the underlying color
value.
With optional OVERRIDES as a non-nil value, account for palette
overrides. Else use the default palette.
With optional THEME as a symbol among `ef-themes-collection', use
the palette of that item. Else use the current Ef theme.
If COLOR is not present in the palette, return the `unspecified'
symbol, which is safe when used as a face attribute's value."
(if-let* ((palette (if theme
(ef-themes--palette-value theme overrides)
(ef-themes--current-theme-palette overrides)))
(value (ef-themes--retrieve-palette-value color palette)))
value
'unspecified))
(defun ef-themes--list-enabled-themes ()
"Return list of `custom-enabled-themes' with ef- prefix."
(seq-filter
(lambda (theme)
(string-prefix-p "ef-" (symbol-name theme)))
custom-enabled-themes))
(defun ef-themes--enable-themes (&optional subset)
"Enable all Ef themes.
With optional SUBSET as a symbol of `light' or `dark', enable only those
themes."
(let ((themes (cond
((eq subset 'dark) ef-themes-dark-themes)
((eq subset 'light) ef-themes-light-themes)
(t ef-themes-collection))))
(mapc
(lambda (theme)
(unless (memq theme custom-known-themes)
(load-theme theme :no-confirm :no-enable)))
themes)))
(defun ef-themes--list-known-themes ()
"Return list of `custom-known-themes' with ef- prefix."
(ef-themes--enable-themes)
(seq-filter
(lambda (theme)
(string-prefix-p "ef-" (symbol-name theme)))
custom-known-themes))
(defun ef-themes--current-theme ()
"Return first enabled Ef theme."
(car (or (ef-themes--list-enabled-themes)
(ef-themes--list-known-themes))))
(defun ef-themes--palette-symbol (theme &optional overrides)
"Return THEME palette as a symbol.
With optional OVERRIDES, return THEME palette overrides as a
symbol."
(when-let* ((suffix (cond
((and theme overrides)
"palette-overrides")
(theme
"palette"))))
(intern (format "%s-%s" theme suffix))))
(defun ef-themes--palette-value (theme &optional overrides)
"Return palette value of THEME with optional OVERRIDES."
(let ((base-value (symbol-value (ef-themes--palette-symbol theme))))
(if overrides
(append (symbol-value (ef-themes--palette-symbol theme :overrides))
ef-themes-common-palette-overrides
base-value)
base-value)))
(defun ef-themes--current-theme-palette (&optional overrides)
"Return palette value of active Ef theme, else produce `user-error'.
With optional OVERRIDES return palette value plus whatever
overrides."
(if-let* ((theme (ef-themes--current-theme)))
(if overrides
(ef-themes--palette-value theme :overrides)
(ef-themes--palette-value theme))
(user-error "No enabled Ef theme could be found")))
(defun ef-themes--choose-subset ()
"Use `read-multiple-choice' to return `dark' or `light' variant."
(intern
(cadr
(read-multiple-choice
"Variant"
'((?d "dark" "Load a random dark theme")
(?l "light" "Load a random light theme"))
"Limit to the dark or light subset of the Ef themes collection."))))
(defun ef-themes--annotate-theme (theme)
"Return completion annotation for THEME."
(when-let* ((symbol (intern-soft theme))
(doc-string (get symbol 'theme-documentation)))
(format " -- %s"
(propertize
(car (split-string doc-string "\\."))
'face 'completions-annotations))))
(defun ef-themes--completion-table (category candidates)
"Pass appropriate metadata CATEGORY to completion CANDIDATES."
(lambda (string pred action)
(if (eq action 'metadata)
`(metadata (category . ,category))
(complete-with-action action candidates string pred))))
(defun ef-themes--ef-p (theme)
"Return non-nil if THEME name has an ef- prefix."
(string-prefix-p "ef-" (symbol-name theme)))
(defvar ef-themes--select-theme-history nil
"Minibuffer history of `ef-themes--select-prompt'.")
(defun ef-themes--load-subset (subset)
"Return the `light' or `dark' SUBSET of the Ef themes.
If SUBSET is neither `light' nor `dark', return all the known Ef themes."
(ef-themes--completion-table 'theme (ef-themes--enable-themes subset)))
(defun ef-themes--maybe-prompt-subset (variant)
"Helper function for `ef-themes--select-prompt' VARIANT argument."
(cond
((null variant))
((or (eq variant 'light) (eq variant 'dark)) variant)
(t (ef-themes--choose-subset))))
(defun ef-themes--select-prompt (&optional prompt variant)
"Minibuffer prompt for `ef-themes-select'.
With optional PROMPT string, use it. Else use a generic prompt.
With optional VARIANT as a non-nil value, prompt for a subset of
themes divided into light and dark variants. Then limit the
completion candidates accordingly.
If VARIANT is either `light' or `dark' then use it directly
instead of prompting the user for a choice.
When VARIANT is nil, all Ef themes are candidates for completion."
(let* ((subset (ef-themes--maybe-prompt-subset variant))
(themes (ef-themes--load-subset subset))
(completion-extra-properties `(:annotation-function ,#'ef-themes--annotate-theme)))
(intern
(completing-read
(or prompt "Select Ef Theme: ")
themes
nil t nil
'ef-themes--select-theme-history))))
(defun ef-themes--disable-themes ()
"Disable themes per `ef-themes-disable-other-themes'."
(mapc #'disable-theme
(if ef-themes-disable-other-themes
custom-enabled-themes
(ef-themes--list-known-themes))))
(define-obsolete-function-alias
'ef-themes--load-theme
'ef-themes-load-theme
"1.9.0")
(defun ef-themes-load-theme (theme)
"Load THEME while disabling other Ef themes.
Which themes are disabled is determined by the user option
`ef-themes-disable-other-themes'.
Run the `ef-themes-post-load-hook' as the final step after
loading the THEME.
Return THEME."
(ef-themes--disable-themes)
(load-theme theme :no-confirm)
(run-hooks 'ef-themes-post-load-hook)
theme)
;;;; Select a theme using minibuffer completion
;;;###autoload
(defun ef-themes-select (theme &optional _variant)
"Load an Ef THEME using minibuffer completion.
With optional VARIANT as a prefix argument, prompt to limit the
set of themes to either dark or light variants.
Run `ef-themes-post-load-hook' after loading the theme.
When called from Lisp, THEME is the symbol of a theme. VARIANT
is ignored in this scenario."
(interactive (list (ef-themes--select-prompt nil current-prefix-arg)))
(ef-themes-load-theme theme))
;;;###autoload
(defun ef-themes-select-light (theme)
"Load a light Ef THEME.
Run `ef-themes-post-load-hook' after loading the theme.
Also see `ef-themes-select-dark'.
This command is the same as `ef-themes-select' except it only
prompts for light themes when called interactively. Calling it
from Lisp behaves the same as `ef-themes-select' for the THEME
argument, meaning that it loads the Ef THEME regardless of
whether it is light or dark."
(interactive
(list
(ef-themes--select-prompt "Select light Ef theme: " 'light)))
(ef-themes-load-theme theme))
;;;###autoload
(defun ef-themes-select-dark (theme)
"Load a dark Ef THEME.
Run `ef-themes-post-load-hook' after loading the theme.
Also see `ef-themes-select-light'.
This command is the same as `ef-themes-select' except it only
prompts for dark themes when called interactively. Calling it
from Lisp behaves the same as `ef-themes-select' for the THEME
argument, meaning that it loads the Ef THEME regardless of
whether it is light or dark."
(interactive
(list
(ef-themes--select-prompt "Select dark Ef theme: " 'dark)))
(ef-themes-load-theme theme))
(defun ef-themes--toggle-theme-p ()
"Return non-nil if `ef-themes-to-toggle' are valid."
(condition-case nil
(dolist (theme ef-themes-to-toggle)
(or (memq theme ef-themes-collection)
(memq theme (ef-themes--list-known-themes))
(error "`%s' is not part of `ef-themes-collection'" theme)))
(error nil)
(:success ef-themes-to-toggle)))
;;;; Toggle between two themes
;;;###autoload
(defun ef-themes-toggle ()
"Toggle between the two `ef-themes-to-toggle'.
If `ef-themes-to-toggle' does not specify two Ef themes, inform
the user about it while prompting with completion for a theme
among our collection (this is practically the same as the
`ef-themes-select' command).
Run `ef-themes-post-load-hook' after loading the theme."
(interactive)
(if-let* ((themes (ef-themes--toggle-theme-p))
(one (car themes))
(two (cadr themes)))
(if (eq (car custom-enabled-themes) one)
(ef-themes-load-theme two)
(ef-themes-load-theme one))
(ef-themes-load-theme
(ef-themes--select-prompt
(concat "Set two `ef-themes-to-toggle'; "
"switching to theme selection for now: ")))))
;;;; Load a theme at random
(defun ef-themes--minus-current (&optional variant)
"Return list of Ef themes minus the current one.
VARIANT is either `light' or `dark', which stand for
`ef-themes-light-themes' and `ef-themes-dark-themes',
respectively. Else check against the return value of
`ef-themes--list-known-themes'."
(let* ((list (when variant
(if (eq variant 'dark)
ef-themes-dark-themes
ef-themes-light-themes)))
(sequence (or list (ef-themes--list-known-themes)))
(themes (copy-sequence sequence)))
(delete (ef-themes--current-theme) themes)))
;;;###autoload
(defun ef-themes-load-random (&optional variant)
"Load an Ef theme at random, excluding the current one.
With optional VARIANT as a prefix argument, prompt to limit the
set of themes to either dark or light variants.
Run `ef-themes-post-load-hook' after loading the theme.
When called from Lisp, VARIANT is either the `dark' or `light'
symbol."
(interactive (list (when current-prefix-arg (ef-themes--choose-subset))))
(let* ((themes (ef-themes--minus-current variant))
(n (random (length themes)))
(pick (nth n themes))
(loaded (if (null pick) (car themes) pick)))
(ef-themes-load-theme loaded)
(message "Loaded `%s'" loaded)))
;;;; Rotate through a list of themes
(defun ef-themes--rotate (themes)
"Rotate THEMES rightward such that the car is moved to the end."
(if (proper-list-p themes)
(let* ((index (seq-position themes (ef-themes--current-theme)))
(offset (1+ index)))
(append (nthcdr offset themes) (take offset themes)))
(error "The `%s' is not a list" themes)))
(defun ef-themes--rotate-p (themes)
"Return a new theme among THEMES if it is possible to rotate to it."
(if-let* ((new-theme (car (ef-themes--rotate themes))))
(if (eq new-theme (ef-themes--current-theme))
(car (ef-themes--rotate-p (ef-themes--rotate themes)))
new-theme)
(error "Cannot determine a theme among `%s'" themes)))
;;;###autoload
(defun ef-themes-rotate (themes)
"Rotate to the next theme among THEMES.
When called interactively THEMES is the value of `ef-themes-to-rotate'.
If the current theme is already the next in line, then move to the one
after. Perform the rotation rightwards, such that the first element in
the list becomes the last. Do not modify THEMES in the process."
(interactive (list ef-themes-to-rotate))
(unless (proper-list-p themes)
"This is not a list of themes: `%s'" themes)
(let ((candidate (ef-themes--rotate-p themes)))
(if (ef-themes--ef-p candidate)
(progn
(message "Rotating to `%s'" (propertize (symbol-name candidate) 'face 'success))
(ef-themes-load-theme candidate))
(user-error "`%s' is not part of the Ef collection" candidate))))
;;;; Preview a theme palette
(defun ef-themes--list-colors-get-mappings (palette)
"Get the semantic palette entries in PALETTE.
PALETTE is the value of a variable like `ef-summer-palette'."
(seq-remove
(lambda (cell)
(stringp (cadr cell)))
palette))
(defun ef-themes--list-colors-tabulated (theme &optional mappings)
"Return a data structure of THEME palette or MAPPINGS for tabulated list."
(let* ((current-palette (ef-themes--palette-value theme mappings))
(palette (if mappings
(ef-themes--list-colors-get-mappings current-palette)
current-palette)))
(mapcar (lambda (cell)
(pcase-let* ((`(,name ,value) cell)
(name-string (format "%s" name))
(value-string (format "%s" value))
(value-string-padded (string-pad value-string 30))
(color (ef-themes-get-color-value name mappings theme))) ; resolve a semantic mapping
(list name
(vector
(if (and (symbolp value)
(not (eq value 'unspecified)))
"Yes"
"")
name-string
(propertize value-string 'face `( :foreground ,color))
(propertize value-string-padded 'face (list :background color
:foreground (if (string= color "unspecified")
(readable-foreground-color (ef-themes-get-color-value 'bg-main nil theme))
(readable-foreground-color color))))))))
palette)))
(defvar ef-themes-current-preview nil)
(defvar ef-themes-current-preview-show-mappings nil)
(defun ef-themes--set-tabulated-entries ()
"Set the value of `tabulated-list-entries' with palette entries."
(setq-local tabulated-list-entries
(ef-themes--list-colors-tabulated ef-themes-current-preview ef-themes-current-preview-show-mappings)))
(defun ef-themes-list-colors (theme &optional mappings)
"Preview the palette of the Ef THEME of choice.
With optional prefix argument for MAPPINGS preview only the semantic
color mappings instead of the complete palette."
(interactive
(let ((prompt (if current-prefix-arg
"Preview palette mappings of THEME: "
"Preview palette of THEME: ")))
(list
(ef-themes--select-prompt prompt)
current-prefix-arg)))
(let ((buffer (get-buffer-create (format (if mappings "*%s-list-mappings*" "*%s-list-all*") theme))))
(with-current-buffer buffer
(let ((ef-themes-current-preview theme)
(ef-themes-current-preview-show-mappings mappings))
(ef-themes-preview-mode)))
(pop-to-buffer buffer)))
(defalias 'ef-themes-preview-colors 'ef-themes-list-colors
"Alias for `ef-themes-list-colors'.")
(defun ef-themes-list-colors-current (&optional mappings)
"Like `ef-themes-list-colors' with optional MAPPINGS for the current theme."
(interactive "P")
(ef-themes-list-colors (ef-themes--current-theme) mappings))
(defalias 'ef-themes-preview-colors-current 'ef-themes-list-colors-current
"Alias for `ef-themes-list-colors-current'.")
(define-derived-mode ef-themes-preview-mode tabulated-list-mode "Ef palette"
"Major mode to display a Ef themes palette."
:interactive nil
(setq-local tabulated-list-format
[("Mapping?" 10 t)
("Symbol name" 30 t)
("As foreground" 30 t)
("As background" 0 t)])
(ef-themes--set-tabulated-entries)
(tabulated-list-init-header)
(tabulated-list-print))
;;; Faces and variables
(defgroup ef-themes-faces ()
"Faces defined by the Ef themes."
:group 'ef-themes
:link '(info-link "(ef-themes) Top")
:link '(url-link :tag "Homepage" "https://protesilaos.com/emacs/ef-themes")
:link '(url-link :tag "Sample pictures" "https://protesilaos.com/emacs/ef-themes-pictures")
:prefix "ef-themes-"
:tag "Ef Themes Faces")
;; This produces `ef-themes-height-0' and the like.
(dotimes (n 9)
(custom-declare-face
(intern (format "ef-themes-heading-%d" n))
nil (format "Used for level %d heading." n)
:package-version '(ef-themes . "0.3.0")
:group 'ef-themes-faces))
(defface ef-themes-key-binding nil
"Face for key bindings."
:package-version '(ef-themes . "0.3.0")
:group 'ef-themes-faces)
(defface ef-themes-fixed-pitch nil
"Face for `fixed-pitch' if `ef-themes-mixed-fonts' is non-nil."
:package-version '(ef-themes . "0.4.0")
:group 'ef-themes-faces)
(defface ef-themes-ui-variable-pitch nil
"Face for `variable-pitch' if `ef-themes-variable-pitch-ui' is non-nil."
:package-version '(ef-themes . "0.4.0")
:group 'ef-themes-faces)
(defface ef-themes-reset-soft nil
"Generic face to set most face properties to nil.
This is intended to be inherited by faces that should not retain
properties from their context (e.g. an overlay over an underlined
text should not be underlined as well) yet still blend in."
:package-version '(ef-themes . "1.2.0")
:group 'ef-themes-faces)
;; This produces `ef-themes-mark-delete' and the like.
(dolist (scope '(delete select other))
(custom-declare-face
(intern (format "ef-themes-mark-%s" scope))
nil (format "Face for %s marks (e.g. `dired', `trashed')." scope)
:package-version '(ef-themes . "0.9.0")
:group 'ef-themes-faces))
;; This produces `ef-themes-underline-error' and the like
(dolist (scope '(info error warning))
(custom-declare-face
(intern (format "ef-themes-underline-%s" scope))
nil (format "Face for %s underline (e.g. `flymake', `flyspell')." scope)
:package-version '(ef-themes . "0.9.0")
:group 'ef-themes-faces))
;; This produces `ef-themes-search-current' and the like
(dolist (scope '(current lazy replace match))
(custom-declare-face
(intern (format "ef-themes-search-%s" scope))
nil (format "Search of type %s." scope)
:package-version '(ef-themes . "1.8.0")
:group 'ef-themes-faces))
;; This produces `ef-themes-search-rx-group-0' and the like
(dotimes (n 4)
(custom-declare-face
(intern (format "ef-themes-search-rx-group-%s" n))
nil (format "Search regexp group number %s." n)
:package-version '(ef-themes . "1.5.0")
:group 'ef-themes-faces))
(defface ef-themes-button nil
"Face to style all graphical buttons uniformly."
:package-version '(ef-themes . "1.9.0")
:group 'ef-themes-faces)
(defconst ef-themes-faces
'(
;;;; internal faces
`(ef-themes-button ((,c :inherit variable-pitch
:box (:line-width 1 :color ,border :style released-button)
:background ,bg-active
:foreground ,fg-intense)))
`(ef-themes-fixed-pitch ((,c ,@(ef-themes--fixed-pitch))))
`(ef-themes-heading-0 ((,c ,@(ef-themes--heading 0) :foreground ,rainbow-0)))
`(ef-themes-heading-1 ((,c ,@(ef-themes--heading 1) :foreground ,rainbow-1)))
`(ef-themes-heading-2 ((,c ,@(ef-themes--heading 2) :foreground ,rainbow-2)))
`(ef-themes-heading-3 ((,c ,@(ef-themes--heading 3) :foreground ,rainbow-3)))
`(ef-themes-heading-4 ((,c ,@(ef-themes--heading 4) :foreground ,rainbow-4)))
`(ef-themes-heading-5 ((,c ,@(ef-themes--heading 5) :foreground ,rainbow-5)))
`(ef-themes-heading-6 ((,c ,@(ef-themes--heading 6) :foreground ,rainbow-6)))
`(ef-themes-heading-7 ((,c ,@(ef-themes--heading 7) :foreground ,rainbow-7)))
`(ef-themes-heading-8 ((,c ,@(ef-themes--heading 8) :foreground ,rainbow-8)))
`(ef-themes-key-binding ((,c :inherit (bold ef-themes-fixed-pitch) :foreground ,keybind)))
`(ef-themes-ui-variable-pitch ((,c ,@(ef-themes--variable-pitch-ui))))
`(ef-themes-mark-delete ((,c :inherit error :background ,bg-err)))
`(ef-themes-mark-select ((,c :inherit success :background ,bg-info)))
`(ef-themes-mark-other ((,c :inherit warning :background ,bg-warning)))
`(ef-themes-search-current ((,c :background ,bg-search-current :foreground ,fg-intense)))
`(ef-themes-search-lazy ((,c :background ,bg-search-lazy :foreground ,fg-intense)))
`(ef-themes-search-replace ((,c :background ,bg-search-replace :foreground ,fg-intense)))
`(ef-themes-search-rx-group-0 ((,c :background ,bg-search-rx-group-0 :foreground ,fg-intense)))
`(ef-themes-search-rx-group-1 ((,c :background ,bg-search-rx-group-1 :foreground ,fg-intense)))
`(ef-themes-search-rx-group-2 ((,c :background ,bg-search-rx-group-2 :foreground ,fg-intense)))
`(ef-themes-search-rx-group-3 ((,c :background ,bg-search-rx-group-3 :foreground ,fg-intense)))
`(ef-themes-search-match ((,c :background ,bg-search-match)))
`(ef-themes-underline-error ((,c :underline (:style wave :color ,underline-err))))
`(ef-themes-underline-info ((,c :underline (:style wave :color ,underline-info))))
`(ef-themes-underline-warning ((,c :underline (:style wave :color ,underline-warning))))
`(ef-themes-reset-soft ((,c :background ,bg-main :foreground ,fg-main
:weight normal :slant normal :strike-through nil
:box nil :underline nil :overline nil :extend nil)))
;;;; all basic faces
;;;;; absolute essentials
`(bold ((,c :weight bold)))
`(bold-italic ((,c :inherit (bold italic))))
`(cursor ((,c :background ,cursor)))
`(default ((,c :background ,bg-main :foreground ,fg-main)))
`(italic ((,c :slant italic)))
`(menu ((,c :background ,bg-dim :foreground ,fg-main)))
`(region ((,c :background ,bg-region :foreground ,fg-region)))
`(scroll-bar ((,c :background ,bg-dim :foreground ,fg-dim)))
`(tool-bar ((,c :background ,bg-dim :foreground ,fg-main)))
`(vertical-border ((,c :foreground ,border)))
;;;;; all other basic faces
`(appt-notification ((,c :inherit bold :foreground ,modeline-err)))
`(blink-matching-paren-offscreen ((,c :background ,bg-paren)))
`(button ((,c :foreground ,link :underline ,border)))
`(child-frame-border ((,c :background ,border)))
`(comint-highlight-input ((,c :inherit bold)))
`(comint-highlight-prompt ((,c :inherit minibuffer-prompt)))
`(edmacro-label ((,c :inherit bold :foreground ,accent-0)))
`(elisp-shorthand-font-lock-face ((,c :inherit (italic font-lock-preprocessor-face))))
`(error ((,c :inherit bold :foreground ,err)))
`(escape-glyph ((,c :foreground ,warning)))
`(fringe ((,c :background ,bg-fringe :foreground ,fg-fringe)))
`(header-line ((,c :inherit ef-themes-ui-variable-pitch :background ,bg-dim)))
`(header-line-highlight ((,c :inherit highlight)))
`(help-argument-name ((,c :foreground ,accent-0)))
`(help-key-binding ((,c :inherit (bold ef-themes-fixed-pitch) :foreground ,keybind)))
`(highlight ((,c :background ,bg-hover :foreground ,fg-intense)))
`(hl-line ((,c :background ,bg-hl-line)))
`(icon-button ((,c :inherit ef-themes-button)))
`(link ((,c :foreground ,link :underline ,border)))
`(link-visited ((,c :foreground ,link-alt :underline ,border)))
`(minibuffer-prompt ((,c :foreground ,prompt)))
`(mm-command-output ((,c :foreground ,mail-part)))
`(mm-uu-extract ((,c :foreground ,mail-part)))
`(pgtk-im-0 ((,c :inherit secondary-selection)))
`(read-multiple-choice-face ((,c :inherit warning :background ,bg-warning)))
`(rectangle-preview ((,c :inherit secondary-selection)))