diff options
Diffstat (limited to 'scripts/theme-studio/build-nerd-icons-legend.el')
| -rw-r--r-- | scripts/theme-studio/build-nerd-icons-legend.el | 210 |
1 files changed, 210 insertions, 0 deletions
diff --git a/scripts/theme-studio/build-nerd-icons-legend.el b/scripts/theme-studio/build-nerd-icons-legend.el new file mode 100644 index 000000000..fce63f161 --- /dev/null +++ b/scripts/theme-studio/build-nerd-icons-legend.el @@ -0,0 +1,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 |