-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsinolor-themes.el
2360 lines (2227 loc) · 122 KB
/
sinolor-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
;;; sinolor-themes.el --- Themes using traditional Chinese colors -*- lexical-binding: t -*-
;; Author: dalu <mou.tong@qq.com>
;; Maintainer: dalu <mou.tong@qq.com>
;; URL: https://github.com/dalugm/sinolor-themes
;; Version: 0.2.0
;; Package-Requires: ((emacs "27.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 `sinolor-themes' is a collection of light and dark themes whose
;; goal is to provide colorful ("pretty") yet legible options for
;; users who want something with some traditional Chinese feelings.
;;
;; "Sinolor" is a combined word (sino + color), to denote this package
;; mainly use Chinese colors as the color reference.
;;; Code:
(require 'seq)
(eval-when-compile (require 'subr-x))
(defgroup sinolor-themes ()
"Colorful and legible themes."
:group 'faces
:link '(info-link "(sinolor-themes) Top")
:link '(url-link :tag "Website" "https://github.com/dalugm/sinolor-themes")
:prefix "sinolor-themes-"
:tag "Sinolor Themes")
;;; User options
(defconst sinolor-themes-light-themes
'(sinolor-light)
"List of symbols with the light Sinolor themes.")
(defconst sinolor-themes-dark-themes
'(sinolor-black
sinolor-elysia
sinolor-eva
sinolor-green
sinolor-palce)
"List of symbols with the dark Sinolor themes.")
(defconst sinolor-themes-collection
(append sinolor-themes-light-themes sinolor-themes-dark-themes)
"Symbols of all the Sinolor themes.")
(defcustom sinolor-themes-post-load-hook nil
"Hook that runs after loading an Sinolor theme.
This is used by the commands `sinolor-themes-select' and
`sinolor-themes-load-random'."
:type 'hook
:package-version '(sinolor-themes . "0.2.0")
:group 'sinolor-themes)
(defcustom sinolor-themes-disable-other-themes t
"Disable all other themes when loading a Sinolor theme.
When the value is non-nil, the commands `sinolor-themes-toggle' and
`sinolor-themes-select' will disable all other themes while loading
the specified Sinolor 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 Sinolor 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 'sinolor-themes
:package-version '(sinolor-themes . "0.2.0")
:type 'boolean)
(defcustom sinolor-themes-to-toggle nil
"Specify two `sinolor-themes' for `sinolor-themes-toggle' command.
The variable `sinolor-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))
sinolor-themes-collection))
(choice :tag "Theme two of two"
,@(mapcar (lambda (theme)
(list 'const theme))
sinolor-themes-collection))))
:package-version '(sinolor-themes . "0.2.0")
:group 'sinolor-themes)
(defconst sinolor-themes-weights
'( thin ultralight extralight light semilight regular medium
semibold bold heavy extrabold ultrabold)
"List of font weights.")
(defconst sinolor-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 `sinolor-themes-headings'.
This is a helper variable intended for internal use.")
(defcustom sinolor-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 sinolor-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 `sinolor-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 sinolor-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 sinolor-themes-headings
(quote ((1 . t) ; keep the default style
(2 variable-pitch 1.2)
(t variable-pitch)))) ; style for all other headings
(setq sinolor-themes-headings
(quote ((1 variable-pitch 1.6)
(2 1.3)
(t . t)))) ; default style for all other levels"
:group 'sinolor-themes
:package-version '(sinolor-themes . "0.2.0")
:type `(alist
:options ,(mapcar (lambda (el)
(list el sinolor-themes--headings-choice))
'(0 1 2 3 4 5 6 7 8 t agenda-date agenda-structure))
:key-type symbol
:value-type ,sinolor-themes--headings-choice)
:link '(info-link "(sinolor-themes) Option for headings"))
(defcustom sinolor-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 'sinolor-themes
:package-version '(sinolor-themes . "0.2.0")
:type 'boolean
:link '(info-link "(sinolor-themes) Enable mixed fonts"))
(defcustom sinolor-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 'sinolor-themes
:package-version '(sinolor-themes . "0.2.0")
:type 'boolean
:link '(info-link "(sinolor-themes) UI typeface"))
(make-obsolete-variable 'sinolor-themes-region nil "1.4.0 (use palette overrides to change region colours)")
(defcustom sinolor-themes-common-palette-overrides nil
"Set palette overrides for all the Sinolor 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 `sinolor-themes-collection'.
Individual theme overrides take precedence over these common
overrides.
To preview the palette entries, use `sinolor-themes-preview-colors' or
`sinolor-themes-preview-colors-current' (read the documentation for
further details)."
:group 'sinolor-themes
:package-version '(sinolor-themes . "0.2.0")
:type '(repeat (list symbol (choice symbol string)))
:link '(info-link "(sinolor-themes) Palette overrides"))
;;; Helpers for user options
(defun sinolor-themes--warn (option)
"Warn that OPTION has changed."
(prog1 nil
(display-warning
'sinolor-themes
(format "`%s' has changed; please read the updated documentation" option)
:warning)))
(defun sinolor-themes--list-or-warn (option)
"Return list or nil value of OPTION, else `sinolor-themes--warn'."
(let* ((value (symbol-value option)))
(if (or (null value) (listp value))
value
(sinolor-themes--warn option))))
(defun sinolor-themes--fixed-pitch ()
"Conditional application of `fixed-pitch' inheritance."
(when sinolor-themes-mixed-fonts
(list :inherit 'fixed-pitch)))
(defun sinolor-themes--variable-pitch-ui ()
"Conditional application of `variable-pitch' in the UI."
(when sinolor-themes-variable-pitch-ui
(list :inherit 'variable-pitch)))
(defun sinolor-themes--alist-or-seq (properties alist-key seq-pred seq-default)
"Return value from alist or sequence.
Check PROPERTIES for an alist value that corresponds to
ALIST-KEY. If no alist is present, search the PROPERTIES
sequence given SEQ-PRED, using SEQ-DEFAULT as a fallback."
(if-let* ((val (or (alist-get alist-key properties)
(seq-find seq-pred properties seq-default)))
((listp val)))
(car val)
val))
(defun sinolor-themes--weight (list)
"Search for `sinolor-themes--heading' weight in LIST."
(catch 'found
(dolist (elt list)
(when (memq elt sinolor-themes-weights)
(throw 'found elt)))))
(defun sinolor-themes--heading (level)
"Conditional styles for `sinolor-themes-headings' per LEVEL heading."
(let* ((key (alist-get level sinolor-themes-headings))
(style (or key (alist-get t sinolor-themes-headings)))
(style-listp (listp style))
(properties style)
(var (when (memq 'variable-pitch properties) 'variable-pitch))
(weight (when style-listp (sinolor-themes--weight style))))
(list :inherit
(cond
(weight var)
(var (append (list 'bold) (list var)))
('bold))
:height
(sinolor-themes--alist-or-seq properties 'height #'floatp 'unspecified)
:weight
(or weight 'unspecified))))
;;; Commands and their helper functions
(defun sinolor-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 `sinolor-themes-theme',
`sinolor-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)))
(sinolor-themes--retrieve-palette-value value palette))
(t
'unspecified))))
(defun sinolor-themes-get-color-value (color &optional overrides theme)
"Return color value of named COLOR for current Sinolor 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 `sinolor-themes-collection', use
the palette of that item. Else use the current Sinolor 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
(sinolor-themes--palette-value theme overrides)
(sinolor-themes--current-theme-palette overrides)))
(value (sinolor-themes--retrieve-palette-value color palette)))
value
'unspecified))
(defun sinolor-themes--list-enabled-themes ()
"Return list of `custom-enabled-themes' with sinolor- prefix."
(seq-filter
(lambda (theme)
(string-prefix-p "sinolor-" (symbol-name theme)))
custom-enabled-themes))
(defun sinolor-themes--enable-themes ()
"Enable all Sinolor themes."
(mapc (lambda (theme)
(unless (memq theme custom-known-themes)
(load-theme theme :no-confirm :no-enable)))
sinolor-themes-collection))
(defun sinolor-themes--list-known-themes ()
"Return list of `custom-known-themes' with sinolor- prefix."
(sinolor-themes--enable-themes)
(seq-filter
(lambda (theme)
(string-prefix-p "sinolor-" (symbol-name theme)))
custom-known-themes))
(defun sinolor-themes--current-theme ()
"Return first enabled Sinolor theme."
(car (or (sinolor-themes--list-enabled-themes)
(sinolor-themes--list-known-themes))))
(defun sinolor-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 sinolor-themes--palette-value (theme &optional overrides)
"Return palette value of THEME with optional OVERRIDES."
(let ((base-value (symbol-value (sinolor-themes--palette-symbol theme))))
(if overrides
(append (symbol-value (sinolor-themes--palette-symbol theme :overrides))
sinolor-themes-common-palette-overrides
base-value)
base-value)))
(defun sinolor-themes--current-theme-palette (&optional overrides)
"Return palette value of active Sinolor theme, else produce `user-error'.
With optional OVERRIDES return palette value plus whatever
overrides."
(if-let ((theme (sinolor-themes--current-theme)))
(if overrides
(sinolor-themes--palette-value theme :overrides)
(sinolor-themes--palette-value theme))
(user-error "No enabled Sinolor theme could be found")))
(defun sinolor-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 Sinolor themes collection."))))
(defun sinolor-themes--annotate-theme (theme)
"Return completion annotation for THEME."
(when-let ((symbol (intern-soft theme))
(doc-string (get symbol 'theme-documentation)))
(format " -- %s" (car (split-string doc-string "\\.")))))
(defun sinolor-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))))
(defvar sinolor-themes--select-theme-history nil
"Minibuffer history of `sinolor-themes--select-prompt'.")
(defun sinolor-themes--load-subset (subset)
"Return the `light' or `dark' SUBSET of the Sinolor themes.
If SUBSET is neither `light' nor `dark', return all the known Sinolor themes."
(sinolor-themes--completion-table
'theme
(pcase subset
('dark sinolor-themes-dark-themes)
('light sinolor-themes-light-themes)
(_ (sinolor-themes--list-known-themes)))))
(defun sinolor-themes--maybe-prompt-subset (variant)
"Helper function for `sinolor-themes--select-prompt' VARIANT argument."
(cond
((null variant))
((or (eq variant 'light) (eq variant 'dark)) variant)
(t (sinolor-themes--choose-subset))))
(defun sinolor-themes--select-prompt (&optional prompt variant)
"Minibuffer prompt for `sinolor-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 Sinolor themes are candidates for completion."
(let* ((subset (sinolor-themes--maybe-prompt-subset variant))
(themes (sinolor-themes--load-subset subset))
(completion-extra-properties `(:annotation-function ,#'sinolor-themes--annotate-theme)))
(intern
(completing-read
(or prompt "Select Sinolor Theme: ")
themes
nil t nil
'sinolor-themes--select-theme-history))))
(defun sinolor-themes--disable-themes ()
"Disable themes per `sinolor-themes-disable-other-themes'."
(mapc #'disable-theme
(if sinolor-themes-disable-other-themes
custom-enabled-themes
(sinolor-themes--list-known-themes))))
(defun sinolor-themes--load-theme (theme)
"Load THEME while disabling other Sinolor themes.
Which themes are disabled is determined by the user option
`sinolor-themes-disable-other-themes'.
Run the `sinolor-themes-post-load-hook' as the final step after
loading the THEME.
Return THEME."
(sinolor-themes--disable-themes)
(load-theme theme :no-confirm)
(run-hooks 'sinolor-themes-post-load-hook)
theme)
;;;###autoload
(defun sinolor-themes-select (theme &optional _variant)
"Load an Sinolor 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 `sinolor-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 (sinolor-themes--select-prompt nil current-prefix-arg)))
(sinolor-themes--load-theme theme))
;;;###autoload
(defun sinolor-themes-select-light (theme)
"Load a light Sinolor THEME.
Run `sinolor-themes-post-load-hook' after loading the theme.
Also see `sinolor-themes-select-dark'.
This command is the same as `sinolor-themes-select' except it only
prompts for light themes when called interactively. Calling it
from Lisp behaves the same as `sinolor-themes-select' for the THEME
argument, meaning that it loads the Sinolor THEME regardless of
whether it is light or dark."
(interactive
(list
(sinolor-themes--select-prompt "Select light Sinolor theme: " 'light)))
(sinolor-themes--load-theme theme))
;;;###autoload
(defun sinolor-themes-select-dark (theme)
"Load a dark Sinolor THEME.
Run `sinolor-themes-post-load-hook' after loading the theme.
Also see `sinolor-themes-select-light'.
This command is the same as `sinolor-themes-select' except it only
prompts for dark themes when called interactively. Calling it
from Lisp behaves the same as `sinolor-themes-select' for the THEME
argument, meaning that it loads the Sinolor THEME regardless of
whether it is light or dark."
(interactive
(list
(sinolor-themes--select-prompt "Select dark Sinolor theme: " 'dark)))
(sinolor-themes--load-theme theme))
(defun sinolor-themes--toggle-theme-p ()
"Return non-nil if `sinolor-themes-to-toggle' are valid."
(mapc (lambda (theme)
(if (or (memq theme sinolor-themes-collection)
(memq theme (sinolor-themes--list-known-themes)))
theme
(user-error "`%s' is not part of `sinolor-themes-collection'" theme)))
sinolor-themes-to-toggle))
;;;###autoload
(defun sinolor-themes-toggle ()
"Toggle between the two `sinolor-themes-to-toggle'.
If `sinolor-themes-to-toggle' does not specify two Sinolor themes, inform
the user about it while prompting with completion for a theme
among our collection (this is practically the same as the
`sinolor-themes-select' command).
Run `sinolor-themes-post-load-hook' after loading the theme."
(interactive)
(if-let* ((themes (sinolor-themes--toggle-theme-p))
(one (car themes))
(two (cadr themes)))
(if (eq (car custom-enabled-themes) one)
(sinolor-themes--load-theme two)
(sinolor-themes--load-theme one))
(sinolor-themes--load-theme
(sinolor-themes--select-prompt
(concat "Set two `sinolor-themes-to-toggle'; "
"switching to theme selection for now: ")))))
(defun sinolor-themes--minus-current (&optional variant)
"Return list of Sinolor themes minus the current one.
VARIANT is either `light' or `dark', which stand for
`sinolor-themes-light-themes' and `sinolor-themes-dark-themes',
respectively. Else check against the return value of
`sinolor-themes--list-known-themes'."
(let* ((list (when variant
(if (eq variant 'dark)
sinolor-themes-dark-themes
sinolor-themes-light-themes)))
(sequence (or list (sinolor-themes--list-known-themes)))
(themes (copy-sequence sequence)))
(delete (sinolor-themes--current-theme) themes)))
;;;###autoload
(defun sinolor-themes-load-random (&optional variant)
"Load an Sinolor 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 `sinolor-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 (sinolor-themes--choose-subset))))
(let* ((themes (sinolor-themes--minus-current variant))
(n (random (length themes)))
(pick (nth n themes))
(loaded (if (null pick) (car themes) pick)))
(sinolor-themes--load-theme loaded)
(message "Loaded `%s'" loaded)))
(defun sinolor-themes--preview-colors-render (buffer theme &optional mappings &rest _)
"Render colors in BUFFER from THEME for `sinolor-themes-preview-colors'.
Optional MAPPINGS changes the output to only list the semantic
color mappings of the palette, instead of its named colors."
(let* ((current-palette (sinolor-themes--palette-value theme mappings))
(palette (if mappings
(seq-remove (lambda (cell)
(stringp (cadr cell)))
current-palette)
current-palette))
(current-buffer buffer)
(current-theme theme))
(with-help-window buffer
(with-current-buffer standard-output
(erase-buffer)
(when (<= (display-color-cells) 256)
(insert (concat "Your display terminal may not render all color previews!\n"
"It seems to only support <= 256 colors.\n\n"))
(put-text-property (point-min) (point) 'face 'warning))
;; We need this to properly render the first line.
(insert " ")
(dolist (cell palette)
(let* ((name (car cell))
(color (sinolor-themes-get-color-value name mappings theme))
(pad (make-string 10 ?\s))
(fg (if (eq color 'unspecified)
(progn
(readable-foreground-color (sinolor-themes-get-color-value 'bg-main nil theme))
(setq pad (make-string 6 ?\s)))
(readable-foreground-color color))))
(let ((old-point (point)))
(insert (format "%s %s" color pad))
(put-text-property old-point (point) 'face `( :foreground ,color)))
(let ((old-point (point)))
(insert (format " %s %s %s\n" color pad name))
(put-text-property old-point (point)
'face `( :background ,color
:foreground ,fg
:extend t)))
;; We need this to properly render the last line.
(insert " ")))
(setq-local revert-buffer-function
(lambda (_ignore-auto _noconfirm)
(sinolor-themes--preview-colors-render current-buffer current-theme mappings)))))))
(defvar sinolor-themes--preview-colors-prompt-history '()
"Minibuffer history for `sinolor-themes--preview-colors-prompt'.")
(defun sinolor-themes--preview-colors-prompt ()
"Prompt for Sinolor theme.
Helper function for `sinolor-themes-preview-colors'."
(let ((def (format "%s" (sinolor-themes--current-theme)))
(completion-extra-properties `(:annotation-function ,#'sinolor-themes--annotate-theme)))
(completing-read
(format "Use palette from theme [%s]: " def)
(sinolor-themes--load-subset :all-themes)
nil t nil
'sinolor-themes--preview-colors-prompt-history def)))
(defun sinolor-themes-preview-colors (theme &optional mappings)
"Preview named colors of the Sinolor THEME of choice.
With optional prefix argument for MAPPINGS preview the semantic
color mappings instead of the named colors."
(interactive (list (intern (sinolor-themes--preview-colors-prompt)) current-prefix-arg))
(sinolor-themes--preview-colors-render
(format (if mappings "*%s-preview-mappings*" "*%s-preview-colors*") theme)
theme
mappings))
(defalias 'sinolor-themes-list-colors 'sinolor-themes-preview-colors
"Alias of `sinolor-themes-preview-colors'.")
(defun sinolor-themes-preview-colors-current (&optional mappings)
"Call `sinolor-themes-list-colors' for the current Sinolor theme.
Optional prefix argument MAPPINGS has the same meaning as for
`sinolor-themes-list-colors'."
(interactive "P")
(sinolor-themes-list-colors (sinolor-themes--current-theme) mappings))
(defalias 'sinolor-themes-list-colors-current 'sinolor-themes-preview-colors-current
"Alias of `sinolor-themes-preview-colors-current'.")
;;; Faces and variables
(defgroup sinolor-themes-faces ()
"Faces defined by the Sinolor themes."
:group 'sinolor-themes
:link '(info-link "(sinolor-themes) Top")
:link '(url-link :tag "Homepage" "https://protesilaos.com/emacs/sinolor-themes")
:link '(url-link :tag "Sample pictures" "https://protesilaos.com/emacs/sinolor-themes-pictures")
:prefix "sinolor-themes-"
:tag "Sinolor Themes Faces")
;; This produces `sinolor-themes-height-0' and the like.
(dotimes (n 9)
(custom-declare-face
(intern (format "sinolor-themes-heading-%d" n))
nil (format "Used for level %d heading." n)
:package-version '(sinolor-themes . "0.2.0")
:group 'sinolor-themes-faces))
(defface sinolor-themes-key-binding nil
"Face for key bindings."
:package-version '(sinolor-themes . "0.2.0")
:group 'sinolor-themes-faces)
(defface sinolor-themes-fixed-pitch nil
"Face for `fixed-pitch' if `sinolor-themes-mixed-fonts' is non-nil."
:package-version '(sinolor-themes . "0.2.0")
:group 'sinolor-themes-faces)
(defface sinolor-themes-ui-variable-pitch nil
"Face for `variable-pitch' if `sinolor-themes-variable-pitch-ui' is non-nil."
:package-version '(sinolor-themes . "0.2.0")
:group 'sinolor-themes-faces)
(defface sinolor-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 '(sinolor-themes . "0.2.0")
:group 'sinolor-themes-faces)
;; This produces `sinolor-themes-mark-delete' and the like.
(dolist (scope '(delete select other))
(custom-declare-face
(intern (format "sinolor-themes-mark-%s" scope))
nil (format "Face for %s marks (e.g. `dired', `trashed')." scope)
:package-version '(sinolor-themes . "0.2.0")
:group 'sinolor-themes-faces))
;; This produces `sinolor-themes-underline-error' and the like
(dolist (scope '(info error warning))
(custom-declare-face
(intern (format "sinolor-themes-underline-%s" scope))
nil (format "Face for %s underline (e.g. `flymake', `flyspell')." scope)
:package-version '(sinolor-themes . "0.2.0")
:group 'sinolor-themes-faces))
(defconst sinolor-themes-faces
'(
;;;; internal faces
`(sinolor-themes-fixed-pitch ((,c ,@(sinolor-themes--fixed-pitch))))
`(sinolor-themes-heading-0 ((,c ,@(sinolor-themes--heading 0) :foreground ,rainbow-0)))
`(sinolor-themes-heading-1 ((,c ,@(sinolor-themes--heading 1) :foreground ,rainbow-1)))
`(sinolor-themes-heading-2 ((,c ,@(sinolor-themes--heading 2) :foreground ,rainbow-2)))
`(sinolor-themes-heading-3 ((,c ,@(sinolor-themes--heading 3) :foreground ,rainbow-3)))
`(sinolor-themes-heading-4 ((,c ,@(sinolor-themes--heading 4) :foreground ,rainbow-4)))
`(sinolor-themes-heading-5 ((,c ,@(sinolor-themes--heading 5) :foreground ,rainbow-5)))
`(sinolor-themes-heading-6 ((,c ,@(sinolor-themes--heading 6) :foreground ,rainbow-6)))
`(sinolor-themes-heading-7 ((,c ,@(sinolor-themes--heading 7) :foreground ,rainbow-7)))
`(sinolor-themes-heading-8 ((,c ,@(sinolor-themes--heading 8) :foreground ,rainbow-8)))
`(sinolor-themes-key-binding ((,c :inherit (bold sinolor-themes-fixed-pitch) :foreground ,keybind)))
`(sinolor-themes-ui-variable-pitch ((,c ,@(sinolor-themes--variable-pitch-ui))))
`(sinolor-themes-mark-delete ((,c :inherit error :background ,bg-err)))
`(sinolor-themes-mark-select ((,c :inherit success :background ,bg-info)))
`(sinolor-themes-mark-other ((,c :inherit warning :background ,bg-warning)))
`(sinolor-themes-underline-error ((,c :underline (:style wave :color ,underline-err))))
`(sinolor-themes-underline-info ((,c :underline (:style wave :color ,underline-info))))
`(sinolor-themes-underline-warning ((,c :underline (:style wave :color ,underline-warning))))
`(sinolor-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)))
`(error ((,c :inherit bold :foreground ,err)))
`(escape-glyph ((,c :foreground ,warning)))
`(fringe ((,c :background ,fringe)))
`(header-line ((,c :inherit sinolor-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 sinolor-themes-fixed-pitch) :foreground ,keybind)))
`(highlight ((,c :background ,bg-hover :foreground ,fg-intense)))
`(hl-line ((,c :background ,bg-hl-line)))
`(icon-button ((,c :box ,fg-dim :background ,bg-active :foreground ,fg-intense))) ; same as `custom-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)))
`(secondary-selection ((,c :background ,bg-hover-secondary :foreground ,fg-intense)))
`(shadow ((,c :foreground ,fg-dim)))
`(success ((,c :inherit bold :foreground ,info)))
`(tooltip ((,c :background ,bg-alt :foreground ,fg-intense)))
`(trailing-whitespace ((,c :background ,bg-red-intense :foreground ,fg-intense)))
`(warning ((,c :inherit bold :foreground ,warning)))
;;;; all-the-icons
`(all-the-icons-blue ((,c :foreground ,blue-cooler)))
`(all-the-icons-blue-alt ((,c :foreground ,blue-warmer)))
`(all-the-icons-cyan ((,c :foreground ,cyan)))
`(all-the-icons-cyan-alt ((,c :foreground ,cyan-warmer)))
`(all-the-icons-dblue ((,c :foreground ,blue-faint)))
`(all-the-icons-dcyan ((,c :foreground ,cyan-faint)))
`(all-the-icons-dgreen ((,c :foreground ,green-faint)))
`(all-the-icons-dmaroon ((,c :foreground ,magenta-faint)))
`(all-the-icons-dorange ((,c :foreground ,red-faint)))
`(all-the-icons-dpink ((,c :foreground ,magenta-faint)))
`(all-the-icons-dpurple ((,c :foreground ,magenta-cooler)))
`(all-the-icons-dred ((,c :foreground ,red)))
`(all-the-icons-dsilver ((,c :foreground ,cyan-faint)))
`(all-the-icons-dyellow ((,c :foreground ,yellow-faint)))
`(all-the-icons-green ((,c :foreground ,green)))
`(all-the-icons-lblue ((,c :foreground ,blue-cooler)))
`(all-the-icons-lcyan ((,c :foreground ,cyan)))
`(all-the-icons-lgreen ((,c :foreground ,green-warmer)))
`(all-the-icons-lmaroon ((,c :foreground ,magenta-warmer)))
`(all-the-icons-lorange ((,c :foreground ,red-warmer)))
`(all-the-icons-lpink ((,c :foreground ,magenta)))
`(all-the-icons-lpurple ((,c :foreground ,magenta-faint)))
`(all-the-icons-lred ((,c :foreground ,red-faint)))
`(all-the-icons-lsilver ((,c :foreground "gray50")))
`(all-the-icons-lyellow ((,c :foreground ,yellow-warmer)))
`(all-the-icons-maroon ((,c :foreground ,magenta)))
`(all-the-icons-orange ((,c :foreground ,yellow-warmer)))
`(all-the-icons-pink ((,c :foreground ,magenta-warmer)))
`(all-the-icons-purple ((,c :foreground ,magenta-cooler)))
`(all-the-icons-purple-alt ((,c :foreground ,blue-warmer)))
`(all-the-icons-red ((,c :foreground ,red)))
`(all-the-icons-red-alt ((,c :foreground ,red-cooler)))
`(all-the-icons-silver ((,c :foreground "gray50")))
`(all-the-icons-yellow ((,c :foreground ,yellow)))
;;;; all-the-icons-dired
`(all-the-icons-dired-dir-face ((,c :foreground ,accent-0)))
;;;; all-the-icons-ibuffer
`(all-the-icons-ibuffer-dir-face ((,c :foreground ,accent-0)))
`(all-the-icons-ibuffer-file-face ((,c :foreground ,name)))
`(all-the-icons-ibuffer-mode-face ((,c :foreground ,constant)))
`(all-the-icons-ibuffer-size-face ((,c :foreground ,variable)))
;;;; ansi-color
`(ansi-color-black ((,c :background "black" :foreground "black")))
`(ansi-color-blue ((,c :background ,blue :foreground ,blue)))
`(ansi-color-bold ((,c :inherit bold)))
`(ansi-color-bright-black ((,c :background "gray35" :foreground "gray35")))
`(ansi-color-bright-blue ((,c :background ,blue-warmer :foreground ,blue-warmer)))
`(ansi-color-bright-cyan ((,c :background ,cyan-cooler :foreground ,cyan-cooler)))
`(ansi-color-bright-green ((,c :background ,green-cooler :foreground ,green-cooler)))
`(ansi-color-bright-magenta ((,c :background ,magenta-cooler :foreground ,magenta-cooler)))
`(ansi-color-bright-red ((,c :background ,red-warmer :foreground ,red-warmer)))
`(ansi-color-bright-white ((,c :background "white" :foreground "white")))
`(ansi-color-bright-yellow ((,c :background ,yellow-warmer :foreground ,yellow-warmer)))
`(ansi-color-cyan ((,c :background ,cyan :foreground ,cyan)))
`(ansi-color-green ((,c :background ,green :foreground ,green)))
`(ansi-color-magenta ((,c :background ,magenta :foreground ,magenta)))
`(ansi-color-red ((,c :background ,red :foreground ,red)))
`(ansi-color-white ((,c :background "gray65" :foreground "gray65")))
`(ansi-color-yellow ((,c :background ,yellow :foreground ,yellow)))
;;;; auctex and tex
`(font-latex-bold-face ((,c :inherit bold)))
`(font-latex-doctex-documentation-face ((,c :inherit font-lock-doc-face)))
`(font-latex-doctex-preprocessor-face ((,c :inherit font-lock-preprocessor-face)))
`(font-latex-italic-face ((,c :inherit italic)))
`(font-latex-math-face ((,c :inherit font-lock-constant-face)))
`(font-latex-script-char-face ((,c :inherit font-lock-builtin-face)))
`(font-latex-sectioning-5-face ((,c :inherit (bold sinolor-themes-variable-pitch) :foreground ,fg-alt)))
`(font-latex-sedate-face ((,c :inherit font-lock-keyword-face)))
`(font-latex-slide-title-face ((,c :inherit sinolor-themes-heading-0)))
`(font-latex-string-face ((,c :inherit font-lock-string-face)))
`(font-latex-underline-face ((,c :inherit underline)))
`(font-latex-verbatim-face ((,c :inherit sinolor-themes-fixed-pitch :foreground ,prose-verbatim)))
`(font-latex-warning-face ((,c :inherit font-lock-warning-face)))
`(tex-verbatim ((,c :inherit sinolor-themes-fixed-pitch :foreground ,prose-verbatim)))
;; `(texinfo-heading ((,c :foreground ,magenta)))
`(TeX-error-description-error ((,c :inherit error)))
`(TeX-error-description-help ((,c :inherit success)))
`(TeX-error-description-tex-said ((,c :inherit success)))
`(TeX-error-description-warning ((,c :inherit warning)))
;;;; auto-dim-other-buffers
`(auto-dim-other-buffers-face ((,c :background ,bg-inactive)))
;;;; avy
`(avy-background-face ((,c :background ,bg-dim :foreground ,fg-dim :extend t)))
`(avy-goto-char-timer-face ((,c :inherit bold :background ,bg-active)))
`(avy-lead-face ((,c :inherit (bold sinolor-themes-reset-soft) :background ,bg-char-0)))
`(avy-lead-face-0 ((,c :inherit (bold sinolor-themes-reset-soft) :background ,bg-char-1)))
`(avy-lead-face-1 ((,c :inherit sinolor-themes-reset-soft :background ,bg-inactive)))
`(avy-lead-face-2 ((,c :inherit (bold sinolor-themes-reset-soft) :background ,bg-char-2)))
;;;; aw (ace-window)
`(aw-background-face ((,c :foreground ,fg-dim)))
`(aw-key-face ((,c :inherit sinolor-themes-key-binding)))
`(aw-leading-char-face ((,c :inherit (bold sinolor-themes-reset-soft) :height 1.5 :foreground ,keybind)))
`(aw-minibuffer-leading-char-face ((,c :inherit sinolor-themes-key-binding)))
`(aw-mode-line-face ((,c :inherit bold)))
;;;; breadcrumb
`(breadcrumb-face (( )))
`(breadcrumb-imenu-leaf-face ((,c :inherit bold :foreground ,fg-intense))) ; same as `which-func'
`(breadcrumb-project-leaf-face ((,c :inherit bold)))
;;;; bongo
`(bongo-album-title (( )))
`(bongo-artist ((,c :foreground ,rainbow-0)))
`(bongo-currently-playing-track ((,c :inherit bold)))
`(bongo-elapsed-track-part ((,c :background ,bg-alt :underline t)))
`(bongo-filled-seek-bar ((,c :background ,bg-hover)))
`(bongo-marked-track ((,c :inherit sinolor-themes-mark-other)))
`(bongo-marked-track-line ((,c :background ,bg-dim)))
`(bongo-played-track ((,c :inherit shadow :strike-through t)))
`(bongo-track-length ((,c :inherit shadow)))
`(bongo-track-title ((,c :foreground ,rainbow-1)))
`(bongo-unfilled-seek-bar ((,c :background ,bg-dim)))
;;;; bookmark
`(bookmark-face ((,c :foreground ,info)))
`(bookmark-menu-bookmark ((,c :inherit bold)))
;;;; calendar and diary
`(calendar-month-header ((,c :inherit bold)))
`(calendar-today ((,c :inherit bold :underline t)))
`(calendar-weekday-header ((,c :foreground ,date-weekday)))
`(calendar-weekend-header ((,c :foreground ,date-weekend)))
`(diary ((,c :foreground ,date-common)))
`(diary-anniversary ((,c :foreground ,date-holiday)))
`(diary-time ((,c :foreground ,date-common)))
`(holiday ((,c :foreground ,date-holiday)))
;;;; centaur-tabs
`(centaur-tabs-active-bar-face ((,c :background ,keybind)))
`(centaur-tabs-close-mouse-face ((,c :inherit bold :foreground ,err :underline t)))
`(centaur-tabs-close-selected ((,c :inherit centaur-tabs-selected)))
`(centaur-tabs-close-unselected ((,c :inherit centaur-tabs-unselected)))
`(centaur-tabs-modified-marker-selected ((,c :inherit centaur-tabs-selected)))
`(centaur-tabs-modified-marker-unselected ((,c :inherit centaur-tabs-unselected)))
`(centaur-tabs-default ((,c :background ,bg-main)))
`(centaur-tabs-selected ((,c :inherit bold :box (:line-width -2 :color ,bg-tab-current) :background ,bg-tab-current)))
`(centaur-tabs-selected-modified ((,c :inherit (italic centaur-tabs-selected))))
`(centaur-tabs-unselected ((,c :box (:line-width -2 :color ,bg-tab-other) :background ,bg-tab-other)))
`(centaur-tabs-unselected-modified ((,c :inherit (italic centaur-tabs-unselected))))
;;;; cider
`(cider-deprecated-face ((,c :background ,bg-warning :foreground ,warning)))
`(cider-enlightened-face ((,c :box ,warning)))
`(cider-enlightened-local-face ((,c :inherit warning)))
`(cider-error-highlight-face ((,c :inherit sinolor-themes-underline-error)))
`(cider-fringe-good-face ((,c :inherit sinolor-themes-mark-select)))
`(cider-instrumented-face ((,c :box ,err)))
`(cider-reader-conditional-face ((,c :inherit font-lock-type-face)))