blob: 218bdeacad253a14c33d0a82b1d9dea8a4051938 (
plain)
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
|
(setq no-byte-compile t)
(require 'cl-lib)
(require 'package)
(defvar +excluded-package-names+
'(tramp-theme color-theme airline-themes))
(defun fussy-string-ends-with (str suffix)
(and (< (length suffix) (length str))
(string= suffix
(cl-subseq str (- (length str) (length suffix))))))
(defun fussy-is-theme-p (pkg-entry)
(let ((name (symbol-name (cl-first pkg-entry))))
(and (or (fussy-string-ends-with name "-theme")
(fussy-string-ends-with name "-themes"))
(not (cl-member (cl-first pkg-entry) +excluded-package-names+)))))
(defun fussy-themes-packages ()
"Setting FUSSY-THEME-PACKAGES-TO-LOAD at the command line will
restrict the package installation step to just these
packages. This function checks that FUSSY-THEME-PACKAGES-TO-LOAD
is bound and if it is, returns it, otherwise, it filters all
theme packages from the PACKAGE-ARCHIVE-CONTENTS and returns
those."
(if (boundp 'fussy-theme-packages-to-load)
fussy-theme-packages-to-load
(cl-remove-if-not 'fussy-is-theme-p package-archive-contents)))
(defun fussy-themes-to-exclude-from-image-generation ()
"Setting FUSSY-EXCLUDED-THEMES from the command line will tell
the script not to load those themes. This function simply checks
that the variable is bound and returns its value, a list of
symbols, returning nil if not."
(when (boundp 'fussy-excluded-themes)
fussy-excluded-themes))
(defun fussy-screenshot-svg (filename)
"Save a screenshot of the current frame as an SVG image to a file
called filename."
(let* ((tmpfile (make-temp-file "Emacs" nil ".svg"))
(data (x-export-frames nil 'svg)))
(with-temp-file tmpfile
(insert data))
(copy-file tmpfile filename t)))
(defun install-all-themes ()
(let ((failed-to-install nil))
(cl-dolist (theme (fussy-themes-packages))
(let ((package-name (if (symbolp theme) theme (cl-first theme))))
(condition-case nil
(package-install package-name)
(error (push package-name failed-to-install)))))
failed-to-install))
(defun locate-theme-package (theme)
"Given a symbol naming a theme, find the name of the package that
the theme came from."
(let ((theme-file
(locate-file (concat (symbol-name theme) "-theme.el")
(custom-theme--load-path)
'("" "c"))))
(string-join
(butlast
(split-string
(cadr
(reverse
(file-name-split
(file-name-directory
theme-file))))
"-"))
"-")))
(defun fussy-generate-all-theme-images (&rest files)
(let ((failed-to-load nil)
(failed-to-generate-image nil)
(failed-to-install (install-all-themes)))
(message "All themes have been loaded")
(cl-dolist (theme (custom-available-themes))
(unless (member theme (fussy-themes-to-exclude-from-image-generation))
(message (format "Generating for theme: %s" theme))
(unwind-protect
(when (condition-case nil
(progn (load-theme theme t)
t)
(error (push theme failed-to-load)
(message "... failed to load!")
nil))
(dolist (file files)
(let* ((theme-package
(locate-theme-package theme))
(svg-file
(concat
(getenv "HOME") "/"
theme-package "/"
(symbol-name theme) "/"
(file-name-base file)
"."
(file-name-extension file)
".svg")))
(make-directory (file-name-directory svg-file) t)
(condition-case nil
(progn
(find-file file)
(delete-other-windows)
(fussy-screenshot-svg svg-file))
(error (push (cons theme file) failed-to-generate-image))))))))
(disable-theme theme))
(with-temp-file (concat (getenv "HOME") "/" "errors.el")
(insert (prin1-to-string
(list :load-errors failed-to-load
:generation-errors failed-to-generate-image
:install-errors failed-to-install))))
(message "FINISHED GENERATING THEME IMAGES")))
(add-to-list 'package-archives
'("melpa" . "https://melpa.org/packages/") t)
(add-to-list 'default-frame-alist
'(font . "DejaVu Sans Mono-10"))
(package-initialize)
(package-refresh-contents)
(package-install 'compat)
(require 'compat)
(set-frame-height (frame-focus) 50)
(set-frame-width (frame-focus) 100)
(defun rel-to-home (file)
(concat (getenv "HOME") "/" file))
(fussy-generate-all-theme-images
(rel-to-home "../fussy.lisp")
(rel-to-home "../bandleader.py")
(rel-to-home"../conway.cpp"))
(kill-emacs)
|
