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
|
;;; build-nerd-icons-legend.el --- emit nerd-icons legend + gallery for theme-studio -*- lexical-binding: t -*-
;;; Commentary:
;; A library of capture functions plus one entry point, cj/nerd-icons-write-legend,
;; that writes nerd-icons-legend.json next to this file. Invoke it from a running
;; Emacs (where nerd-icons is loaded):
;;
;; emacsclient -e '(progn (load ".../build-nerd-icons-legend.el") (cj/nerd-icons-write-legend))'
;;
;; The JSON is an object with two keys:
;; "legend" -- the curated v1 filetype legend (a representative row set drawn
;; from a diverse subset of the nerd-icons color faces).
;; "gallery" -- the full colored catalog (vNext): every distinct face-bearing
;; nerd-icons icon, grouped by owner color face, one group per face,
;; the groups ordered by hue so color families cluster.
;; Each legend row and gallery glyph resolves its glyph + owner face from the live
;; nerd-icons alists at capture time, so the artifact tracks the installed
;; nerd-icons version. A curated legend key absent from the alist is skipped and
;; logged; a gallery entry whose glyph or face won't resolve is skipped.
;; generate.py embeds the JSON; see docs/specs/theme-studio-nerd-icons-colors-spec.org.
;;
;; nerd-icons is required only at write time (inside cj/nerd-icons-write-legend),
;; not at load, so the pure capture functions load and unit-test without it (the
;; alist vars are declared special below and injected by the test).
;;; Code:
(require 'json)
(require 'color)
;; Declared, not required: nerd-icons supplies these at write time; the declarations
;; keep the byte-compiler quiet and let tests bind synthetic values without nerd-icons.
(defvar nerd-icons-extension-icon-alist)
(defvar nerd-icons-regexp-icon-alist)
(defvar nerd-icons-mode-icon-alist)
(defvar nerd-icons-completion-category-icons)
(declare-function nerd-icons-icon-for-dir "nerd-icons")
;; ---- v1 legend (curated representative rows) ------------------------------
;; Curated v1 rows: (KEY LABEL CATEGORY LOOKUP). CATEGORY selects the source
;; alist and its face shape; LOOKUP is the alist key (nil for the dir row, which
;; has a fixed owner face per the spec's dir-precedence decision).
(defconst cj/--nerd-icons-legend-spec
'(("ext:el" "init.el" extension "el")
("ext:py" "app.py" extension "py")
("ext:org" "notes.org" extension "org")
("ext:md" "README.md" extension "md")
("ext:ts" "main.ts" extension "ts")
("ext:html" "index.html" extension "html")
("ext:rs" "lib.rs" extension "rs")
("ext:js" "app.js" extension "js")
("ext:yml" "ci.yml" extension "yml")
("ext:c" "main.c" extension "c")
("dir" "src/" dir nil)
("cmd" "M-x command" command command)
("buf" "*scratch*" buffer emacs-lisp-mode))
"The v1 legend rows: (KEY LABEL CATEGORY LOOKUP), spanning a representative
set of the nerd-icons color faces rather than all 34.")
(defun cj/--nerd-icons-legend-glyph (fn name)
"Return the bare glyph string for icon NAME drawn by FN, or nil."
(when (and (fboundp fn) (stringp name))
(let ((s (ignore-errors (funcall fn name))))
(and (stringp s)
(> (length (string-trim s)) 0)
(string-trim (substring-no-properties s))))))
(defun cj/--nerd-icons-legend-make (key label category glyph face)
"Build the JSON alist for one legend row, or nil (logged) if GLYPH/FACE absent."
(if (and glyph face)
(list (cons "key" key)
(cons "label" label)
(cons "face" (symbol-name face))
(cons "category" (symbol-name category))
(cons "glyph" glyph))
(message "nerd-icons-legend: skipping %s (glyph=%S face=%S)" key glyph face)
nil))
(defun cj/--nerd-icons-legend-row (key label category lookup)
"Resolve one curated row from the live nerd-icons alists, or nil if absent."
(pcase category
('extension
(let ((e (assoc lookup nerd-icons-extension-icon-alist)))
(when e
(cj/--nerd-icons-legend-make
key label category
(cj/--nerd-icons-legend-glyph (nth 1 e) (nth 2 e))
(plist-get (nthcdr 3 e) :face)))))
('buffer
(let ((e (assq lookup nerd-icons-mode-icon-alist)))
(when e
(cj/--nerd-icons-legend-make
key label category
(cj/--nerd-icons-legend-glyph (nth 1 e) (nth 2 e))
(plist-get (nthcdr 3 e) :face)))))
('command
(let ((e (assq lookup nerd-icons-completion-category-icons)))
(when e
(cj/--nerd-icons-legend-make
key label category
(cj/--nerd-icons-legend-glyph (nth 1 e) (nth 2 e))
(nth 3 e)))))
('dir
(cj/--nerd-icons-legend-make
key label category
(let ((s (ignore-errors (nerd-icons-icon-for-dir "src"))))
(and (stringp s) (string-trim (substring-no-properties s))))
'nerd-icons-yellow))))
(defun cj/--nerd-icons-legend-rows ()
"Resolve the curated v1 legend rows as a list of JSON alists."
(delq nil (mapcar (lambda (r) (apply #'cj/--nerd-icons-legend-row r))
cj/--nerd-icons-legend-spec)))
;; ---- gallery (full colored catalog, a grid of distinct icons by color) -----
(defconst cj/--nerd-icons-gallery-alists
'(nerd-icons-extension-icon-alist
nerd-icons-regexp-icon-alist
nerd-icons-mode-icon-alist)
"Source alists for the gallery. Entries are shaped (KEY FN NAME :face FACE ...);
NAME is the nerd-font icon name (e.g. \"nf-dev-terminal\"). The dir alist carries
no :face (directory icons are colored by advice, not a per-entry face) and is
intentionally absent.")
(defun cj/--nerd-icons-spec-foreground (spec)
"Return the :foreground of the default (t) display clause in SPEC, or nil.
The clause is (t . PLIST), so the foreground is plist-get of its cdr. A
display-conditional spec (no t clause, as the real nerd-icons faces use) returns
nil here and falls back to the live, frame-resolved face foreground."
(plist-get (cdr (assoc t spec)) :foreground))
(defun cj/--nerd-icons-face-hsl (face)
"Return (HUE SAT LIGHT) for FACE's foreground: hue 0-360, sat and light 0-100.
Use the t-clause defface color when there is one (deterministic), else the live
frame-resolved foreground. nil if no color resolves."
(let* ((fg (or (cj/--nerd-icons-spec-foreground (face-default-spec face))
(face-foreground face nil 'default)))
(rgb (and (stringp fg) (ignore-errors (color-name-to-rgb fg))))
(hsl (and rgb (apply #'color-rgb-to-hsl rgb))))
(when hsl
(list (round (* 360 (nth 0 hsl)))
(round (* 100 (nth 1 hsl)))
(round (* 100 (nth 2 hsl)))))))
(defun cj/--nerd-icons-gallery-groups ()
"Build the gallery grid: a list of JSON group alists, one per owner color face,
ordered by hue (ascending, ties by descending lightness) so families cluster.
Each group is ((\"face\" . NAME) (\"hue\" . DEG) (\"glyphs\" . VECTOR)) where each
glyph is ((\"glyph\" . G) (\"name\" . ICON-NAME)). Within a face, icons are
deduplicated by name and sorted by name. An entry without a :face, an
unresolvable glyph, or a face with no native color is skipped."
(let ((table (make-hash-table :test 'eq))
(seen (make-hash-table :test 'equal))
(order nil))
(dolist (sym cj/--nerd-icons-gallery-alists)
(dolist (e (and (boundp sym) (symbol-value sym)))
(let* ((face (plist-get (nthcdr 3 e) :face))
(name (nth 2 e))
(glyph (cj/--nerd-icons-legend-glyph (nth 1 e) name)))
(when (and face glyph (stringp name))
(let ((dk (concat (symbol-name face) "\0" name)))
(unless (gethash dk seen)
(puthash dk t seen)
(unless (gethash face table) (push face order))
(puthash face
(cons (list (cons "glyph" glyph) (cons "name" name))
(gethash face table))
table)))))))
(let ((groups
(delq nil
(mapcar (lambda (face)
(let ((hsl (cj/--nerd-icons-face-hsl face))
(glyphs (sort (gethash face table)
(lambda (a b) (string< (cdr (assoc "name" a))
(cdr (assoc "name" b)))))))
(when hsl (list face (nth 0 hsl) (nth 2 hsl) glyphs))))
(nreverse order)))))
(setq groups (sort groups (lambda (a b)
(if (/= (nth 1 a) (nth 1 b))
(< (nth 1 a) (nth 1 b))
(> (nth 2 a) (nth 2 b))))))
(mapcar (lambda (g)
(list (cons "face" (symbol-name (nth 0 g)))
(cons "hue" (nth 1 g))
(cons "glyphs" (apply #'vector (nth 3 g)))))
groups))))
;; ---- entry point ----------------------------------------------------------
(defun cj/nerd-icons-write-legend ()
"Resolve the legend + gallery from the live nerd-icons alists and write
nerd-icons-legend.json next to this file. Requires nerd-icons (loaded here, not
at file load, so the capture functions stay unit-testable without it)."
(require 'nerd-icons)
(let ((legend (cj/--nerd-icons-legend-rows))
(gallery (cj/--nerd-icons-gallery-groups)))
(with-temp-file (expand-file-name
"nerd-icons-legend.json"
(file-name-directory (or load-file-name buffer-file-name
"~/.emacs.d/scripts/theme-studio/")))
(let ((json-encoding-pretty-print t))
(insert (json-encode (list (cons "legend" (apply #'vector legend))
(cons "gallery" (apply #'vector gallery))))
"\n")))
(message "nerd-icons-legend: wrote %d legend rows, %d gallery groups (%d glyphs)"
(length legend) (length gallery)
(apply #'+ (mapcar (lambda (g) (length (cdr (assoc "glyphs" g)))) gallery)))))
(provide 'build-nerd-icons-legend)
;;; build-nerd-icons-legend.el ends here
|
