/
pretty-speedbar.el
358 lines (304 loc) · 14.1 KB
/
pretty-speedbar.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
;;; pretty-speedbar.el --- Make speedbar pretty -*- lexical-binding: t -*-
;; Copyright (C) 2022 Kristle Chester, all rights reserved.
;; Author: Kristle Chester <kcyarn7@gmail.com>
;; Maintainer: Kristle Chester <kcyarn7@gmail.com>
;; Created: 2019-11-18
;; Version: 0.2
;; Last-Updated: 2022-01-17
;; URL: https://github.com/kcyarn/pretty-speedbar
;; Package-Requires: ((emacs "27.1"))
;; Keywords: file, tags, tools
;; Compatibility:
;; License: GPL-3.0-or-later
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program 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.
;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Pretty Speedbar defaults to Font Awesome 6 Free Solid, which must be
;; installed from the otf available from Font Awesome's GitHub repository --
;; https://github.com/FortAwesome/Font-Awesome.
;; To use svg icons, you must first run pretty-speedbar-generate. This
;; creates static icon files in the pretty-speedbar-icons-dir. Alternatively,
;; icons may be created by hand in the pretty-speedbar-icons-dir.
;; To customize the folder colors, set a hex color for
;; pretty-speedbar-icon-folder-fill and pretty-speedbar-icon-folder-stroke.
;; To customize the non-folder icons, set a hex color for
;; pretty-speedbar-icon-fill and pretty-speedbar-icon-stroke.
;; To customize checks and locks, set a hex color for
;; pretty-speedbar-about-fill and pretty-speedbar-about-stroke.
;; To customize the plus and minus signs used on both the folder and
;; non-folder icons, set pretty-speedbar-signs-fill.
;; To alter the icon size, set pretty--speedbar-icon-size. This sets the
;; folder and non-folder icon height in pixels. Icon width and the about
;; icons (check and lock icons) are calculated based on this value.
;; Changing the icon font requires changing the unicode setting for each icon.
;; Please see the 'Icon Reference' section in the readme file for complete
;; table of these variables matched to their unicodes and the output image.
;;; Code:
(require 'speedbar)
(require 'svg)
(defconst pretty-speedbar-icons-dir
(expand-file-name (concat user-emacs-directory "pretty-speedbar-icons/"))
"Store pretty-speedbar-icons in the pretty-speedbar-icons folder.
This is located in the user's default Emacs directory.")
(defgroup pretty-speedbar nil
"Group for pretty-speedbar."
:group 'pretty-speedbar
:prefix "pretty-speedbar-")
(defcustom pretty-speedbar-font "Font Awesome 6 Free Solid"
"Set the default icon font To Font Awesome 6 Free Solid.
This is obtainable as an otf from github."
:type '(string)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-icon-size 20
"Set default size in pixels and applies to both width and height."
:type '(integer)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-icon-fill "#DCDCDC"
"Set default non-folder fill color as hex."
:type '(string)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-icon-stroke "#000000"
"Set default non-folder stroke color as hex."
:type '(string)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-icon-folder-fill "#353839"
"Set default folder fill color as hex."
:type '(string)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-icon-folder-stroke "#333333"
"Set default folder stroke color as hex."
:type '(string)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-about-fill "#FF0000"
"Set default non-folder fill color as hex."
:type '(string)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-about-stroke "#222222"
"Set default non-folder stroke color as hex."
:type '(string)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-signs-fill "#555555"
"Set default fill color for plus and minus signs added to select icons."
:type '(string)
:group 'pretty-speedbar)
;;; Set the icon unicode and if it's folder.
(defcustom pretty-speedbar-lock '("\uf023")
"Lock icon from FontAwesome used by `pretty-lock'."
:type '(list string)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-tag '("\uf02b" nil)
"Tag from FontAwesome used by `pretty-tag'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-tags '("\uf02c" nil)
"Tags (plural) from FontAwesome.
See `pretty-tags-plus' and `pretty-tags-minus'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-info '("\uf05a" nil)
"Info-circle from FontAwesome used by `pretty-info'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-mail '("\uf0e0" nil)
"Envelope from FontAwesome used by `pretty-mail'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-book '("\uf02d" nil)
"Book from FontAwesome used by `pretty-book'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-box-closed '("\uf466" nil)
"Box from FontAwesome used by `pretty-box-closed'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-box-open '("\uf49e" nil)
"Box-open from FontAwesome used by `pretty-box-open'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-folder '("\uf07b" t)
"Folder from FontAwesome used by `pretty-folder'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-folder-open '("\uf07c" t)
"Folder-open from FontAwesome used by `pretty-folder-open'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-page '("\uf15c" nil)
"File-alt from FontAwesome used by `pretty-page'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-blank-page '("\uf15b" nil)
"File from FontAwesome used by `pretty-page-plus' and `pretty-page-minus'."
:type '(list string boolean)
:group 'pretty-speedbar)
(defcustom pretty-speedbar-check '("\uf00c")
"Check from FontAwesome used by `pretty-check'."
:type '(list string)
:group 'pretty-speedbar)
(defun pretty-speedbar-about-svg (this-name this-list)
"Create smaller informative icons, including checkmarks and locks.
THIS-NAME refers to the name used both for the svg and ezimage.
THIS-LIST draws from the icon's defcustom or a setq."
(let ((this-icon (car this-list))
(this-size (* 0.7 pretty-speedbar-icon-size)))
(let ((this-svg (svg-create this-size this-size :viewBox "0 0 512 512")))
(svg-text this-svg this-icon
:font-size "470px" ;;; changed from 507
:stroke pretty-speedbar-about-stroke
:fill pretty-speedbar-about-fill
:font-family (format "\'%s\'" pretty-speedbar-font)
:x "50%"
:y "450" ;;; changed from 90%
;; :dominant-baseline "middle"
:text-anchor "middle"
:rendering "optimizeLegibility"
:stroke-width 5)
(with-temp-file (expand-file-name (concat this-name ".svg") pretty-speedbar-icons-dir)
(set-buffer-multibyte nil)
(svg-print this-svg)))))
(defun pretty-speedbar-svg (this-name this-list &optional this-sign)
"Function to create individual icon svgs.
THIS-NAME is the icon's filename.
THIS-LIST being the individual icon's variable.
THIS-SIGN will create a plus or minus sign, if desired."
(let ((pretty-speedbar-icon-width (/ pretty-speedbar-icon-size 0.8643))
(this-icon (car this-list))
(is-folder (nth 1 this-list))
(this-pretty-icon-fill pretty-speedbar-icon-fill)
(this-pretty-icon-stroke pretty-speedbar-icon-stroke))
(let ((this-svg (svg-create pretty-speedbar-icon-width pretty-speedbar-icon-size :viewBox "0 0 512 512")))
(if is-folder
(progn
(setq this-pretty-icon-fill pretty-speedbar-icon-folder-fill)
(setq this-pretty-icon-stroke pretty-speedbar-icon-folder-stroke)))
(svg-text this-svg this-icon
:font-size "470px" ;;; changed from 507
:stroke this-pretty-icon-stroke
:fill this-pretty-icon-fill
:font-family (format "\'%s\'" pretty-speedbar-font)
:x "50%"
:y "450"
:text-anchor "middle"
:rendering "optimizeLegibility"
:stroke-width 5)
(if (equal this-sign "plus")
(progn
(svg-rectangle this-svg 224.62 270 64 204.8
:rx 12.8
:ry 12.8
:fill pretty-speedbar-signs-fill
:fill-rule "evenodd"
:rendering "optimizeLegibility")
(svg-rectangle this-svg -398 157.2 64 204.8
:transform "rotate(-90)"
:rx 12.8
:ry 12.8
:fill pretty-speedbar-signs-fill
:fill-rule "evenodd"
:rendering "optimizeLegibility")))
(if (equal this-sign "minus")
(svg-rectangle this-svg -398 157.2 64 204.8
:transform "rotate(-90)"
:rx 12.8
:ry 12.8
:fill pretty-speedbar-signs-fill
:fill-rule "evenodd"
:rendering "optimizeLegibility"))
(with-temp-file (expand-file-name (concat this-name ".svg") pretty-speedbar-icons-dir)
(set-buffer-multibyte nil)
(svg-print this-svg)))))
(defun pretty-speedbar-make-dir ()
"Create the pretty-speedbar-icons directory."
(unless (file-exists-p pretty-speedbar-icons-dir)
(make-directory pretty-speedbar-icons-dir t)))
(defun pretty-speedbar-generate()
"Generate the icon svg images."
(interactive)
(pretty-speedbar-make-dir)
;;; Create informative icons to the right of the file.
(pretty-speedbar-about-svg "pretty-check" pretty-speedbar-check)
(pretty-speedbar-about-svg "pretty-lock" pretty-speedbar-lock)
;;; Create file tree icons.
(pretty-speedbar-svg "pretty-tag" pretty-speedbar-tag)
(pretty-speedbar-svg "pretty-tags-plus" pretty-speedbar-tags "plus")
(pretty-speedbar-svg "pretty-tags-minus" pretty-speedbar-tags "minus")
(pretty-speedbar-svg "pretty-info" pretty-speedbar-info)
(pretty-speedbar-svg "pretty-mail" pretty-speedbar-mail)
(pretty-speedbar-svg "pretty-book" pretty-speedbar-book)
(pretty-speedbar-svg "pretty-box-closed" pretty-speedbar-box-closed "plus")
(pretty-speedbar-svg "pretty-box-open" pretty-speedbar-box-open "minus")
(pretty-speedbar-svg "pretty-page-plus" pretty-speedbar-blank-page "plus")
(pretty-speedbar-svg "pretty-page-minus" pretty-speedbar-blank-page "minus")
(pretty-speedbar-svg "pretty-folder" pretty-speedbar-folder)
(pretty-speedbar-svg "pretty-folder-open" pretty-speedbar-folder-open)
(pretty-speedbar-svg "pretty-page" pretty-speedbar-page))
;;; manually using pretty-page works. Now change it to variables.
(defmacro pretty-speedbar-ezimage (this-name)
"Macro for defezimage with THIS-NAME matching icon's name."
`(defezimage ,(intern (format "%s" this-name)) ((:type svg :file ,(expand-file-name (format "%s.svg" this-name) (expand-file-name (concat user-emacs-directory "pretty-speedbar-icons/"))) :ascent center)) "Documentation string replace."))
;; Manually add the correct documentation for each ezimage. Passing it to the defmacro itself causes compilation errors.
(pretty-speedbar-ezimage "pretty-check")
(put 'pretty-check 'function-documentation "Replacement for ezimage-checkout, which marks files checked out of a vc.")
(pretty-speedbar-ezimage "pretty-lock")
(put 'pretty-lock 'function-documentation "Replacement for ezimage-lock, which is described as a read only or private.")
(pretty-speedbar-ezimage "pretty-tag")
(put 'pretty-tag 'function-documentation "Replacement for ezimage-tag, which is used for the table of contents.")
(pretty-speedbar-ezimage "pretty-tags-plus")
(put 'pretty-tags-plus 'function-documentation "Replacement for ezimage-tag-gt, which is described as closed tags.")
(pretty-speedbar-ezimage "pretty-tags-minus")
(put 'pretty-tags-minus 'function-documentation "Replacement for ezimage-tag-v, which is described as open tags.")
(pretty-speedbar-ezimage "pretty-info")
(put 'pretty-info 'function-documentation "Replacement for ezimage-info.")
(pretty-speedbar-ezimage "pretty-lock")
(put 'pretty-lock 'function-documentation "Replacement for ezimage-lock, which is used for read only and private.")
(pretty-speedbar-ezimage "pretty-mail")
(put 'pretty-mail 'function-documentation "Replacement for ezimage-mail.")
(pretty-speedbar-ezimage "pretty-book")
(put 'pretty-book 'function-documentation "Replacement for ezimage-document-tag, which means documentation available.")
(pretty-speedbar-ezimage "pretty-box-closed")
(put 'pretty-box-closed 'function-documentation "Replacement for ezimage-box-plus. Used by the table of contents.")
(pretty-speedbar-ezimage "pretty-box-open")
(put 'pretty-box-open 'function-documentation "Replacement for ezimage-box-minus, which refers to an open box.")
(pretty-speedbar-ezimage "pretty-folder")
(put 'pretty-folder 'function-documentation "Replacement for ezimage-directory-plus and ezimage-directory.")
(pretty-speedbar-ezimage "pretty-folder-open")
(put 'pretty-folder-open 'function-documentation "Replacement for ezimage-directory-minus.")
(pretty-speedbar-ezimage "pretty-page")
(put 'pretty-page 'function-documentation "Replacement for ezimage-page.")
(pretty-speedbar-ezimage "pretty-page-plus")
(put 'pretty-page-plus 'function-documentation "Replacement for ezimage-page-plus.")
(pretty-speedbar-ezimage "pretty-page-minus")
(put 'pretty-page-minus 'function-documentation "Replacement for ezimage-plus-minus.")
;;;###autoload
(setq speedbar-expand-image-button-alist
'(("<+>" . pretty-folder)
("<->" . pretty-folder-open)
("< >" . pretty-folder)
("[+]" . pretty-page-plus)
("[-]" . pretty-page-minus)
("[?]" . pretty-page)
("[ ]" . pretty-page)
("{+}" . pretty-box-closed)
("{-}" . pretty-box-open)
("<M>" . pretty-mail)
("<d>" . pretty-book)
("<i>" . pretty-info)
(" =>" . pretty-tag)
(" +>" . pretty-tags-plus)
(" ->" . pretty-tags-minus)
(">" . pretty-tag)
("@" . pretty-tag)
(" @" . pretty-tag)
("*" . pretty-check)
("%" . pretty-lock)))
(provide 'pretty-speedbar)
;;; pretty-speedbar.el ends here