-
Notifications
You must be signed in to change notification settings - Fork 0
/
pretty-magit.el
341 lines (298 loc) · 13.1 KB
/
pretty-magit.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
;;; -*- lexical-binding: t; -*-
;;; pretty-magit.el --- Prettify Git messages in a magit buffer
;; Copyright (C) 2022 Arif Er <arifer612@proton.me>
;; This file is not part of GNU Emacs.
;;
;; 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 <http://www.gnu.org/licenses/>.
;; Author: Arif Er <arifer612@proton.me>
;; Created: 29 May 2022
;; URL: https://github.com/arifer612/pretty-magit
;; Package-Requires: (dash)
;; Keywords: faces, vc
;;; Commentary:
;; This package brings in the functionality to replace important keywords in a
;; Git message's header with icons specified by text properties of your choice.
;; This package is meant to work in line with the Git message conventions as
;; laid out in "Conventional Commits" https://www.conventionalcommits.org/
;; A typical Git message should be of the form where the text in angled brackets
;; are the default names for sections of the Git message:
;; <type>(<scope>): <subject>
;; --BLANK LINE--
;; <body>
;; --BLANK LINE--
;; <footer>
;;; Code:
(require 'dash)
;; Custom variables
(defcustom pretty-magit-rules
'((test :icon 63027
:props (:foreground "#FAAED2" :height 1.2)
:target type
:rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(test!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(style :icon 63119
:props (:foreground "#FFFF3D" :height 1.2)
:target type
:rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(style!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(revert :icon 62830
:props (:foreground "#FDFD96" :height 1.2)
:target type
:rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(revert!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(refactor :icon 64324
:props (:foreground "#F5F5F5" :height 1.2)
:target type
:rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(refactor!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(perf :icon 61847
:props (:foreground "#607D8B" :height 1.2)
:target type
:rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(perf!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(fix :icon 61832
:props (:foreground "#FB6542" :height 1.2)
:target type
:rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(fix!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(feat :icon 58014 :props
(:foreground "#8D012F" :height 1.2)
:target type :rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(feat!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(docs :icon 62072 :props
(:foreground "#A1f757" :height 1.2)
:target type :rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(docs!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(ci :icon 59239 :props
(:foreground "#008080" :height 1.2)
:target type :rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(ci!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(chore :icon 62945 :props
(:foreground "#F5F5DC" :height 1.2)
:target type :rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(chore!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)")
(build :icon 58022 :props
(:foreground "#00008B" :height 1.2)
:target type :rgx "\\(?:^[^ ]* \\(?:[^ ]*\\* \\)?\\(?:[^ ]* \\)?\\(build!?\\)\\(\\(?:([^ ):]*)\\)?\\): \\(.*\\)$\\)"))
"List containing magit replacing rules.")
(defcustom pretty-magit-text-prop '()
"Default text properties for pretty-magit.")
;; Variables:
(defvar pretty-magit--headers '((type . 1) (scope . 2) (subject . 3))
"Alist of symbols and their group position in a Git message header.")
(defvar pretty-magit--git-ref-rx
'((zero-or-more (not (any " "))))
"Default rx sequence for the git-ref.")
(defvar pretty-magit--git-log-rx
'((optional (zero-or-more (not (any " ")))
"* "))
"Default rx sequence for markup used when viewing magit log.")
(defvar pretty-magit--git-branch-name-rx
'((optional (zero-or-more (not (any " ")))
" "))
"Default rx sequence for branch or tag names in a magit log with the 'decorate
flag on.")
(defvar pretty-magit--type-rx
'((group (zero-or-more (not (any "("
":"
" ")))))
"Default rx sequence for the 'type component of a Git message header.")
(defvar pretty-magit--scope-rx
'((group (optional "("
(zero-or-more (not (any ")"
":"
" ")))
")")))
"Default rx sequence for the 'scope component of a Git message header.")
(defvar pretty-magit--subject-rx
'((group (zero-or-more not-newline)))
"Default rx sequence for the 'subject component of a Git message header.")
;; Functions:
(defun pretty-magit--ensure-target (target)
"Ensure TARGET exists in pretty-magit--headers.
Return TARGET if it is a valid header, otherwise return the default 'type."
(cond ((unless target)
'type)
((assoc target pretty-magit--headers)
target)
(t
(progn
(message (concat (symbol-name target)
" is not a valid header. Defaulting to 'type."))
'type))))
(defun pretty-magit--new-breaking-type-rx (word)
"Prepare an rx sequence with a single WORD in the 'type component."
`((group ,word)))
(defun pretty-magit--new-type-rx (word)
"Prepare an rx sequence with a single WORD in the 'type component for breaking
changes identified by a '!' at the end."
`((group ,word
(optional "!"))))
(defun pretty-magit--new-scope-rx (word)
"Prepare an rx sequence with a single WORD in the 'scope component."
`("("
(group ,word)
")"))
(defun pretty-magit--rx-list (word &optional target)
"Prepare the final rx sequence list with WORD in TARGET."
(let* ((target (pretty-magit--ensure-target target))
(pretty-magit--type-rx (cond ((equal target 'type)
(pretty-magit--new-type-rx
(symbol-name word)))
(t
pretty-magit--type-rx)))
(pretty-magit--scope-rx (cond ((equal target 'scope)
(pretty-magit--new-scope-rx
(symbol-name word)))
(t
pretty-magit--scope-rx))))
(append '(bol)
pretty-magit--git-ref-rx
'(" ")
pretty-magit--git-log-rx
pretty-magit--git-branch-name-rx
pretty-magit--type-rx
pretty-magit--scope-rx
'(": ")
pretty-magit--subject-rx
'(eol))))
(defun pretty-magit--rx-string (rx-list)
"Convert RX-LIST to a regexp string."
(rx-to-string `(: ,@rx-list)))
;;;###autoload
(defmacro pretty-magit-rx (word &optional target)
"Return a regexp string to search for WORD in TARGET."
(pretty-magit--rx-string (pretty-magit--rx-list word target)))
(defun pretty-magit--rule-exist-p (rule)
"Check if RULE exists in pretty-magit-rules.
The WORD and SCOPE of rules are used to check for existence. If RULE exists,
the ICON and PROPS are compared. If all are equal, return 't, otherwise return
the index number of the rule in pretty-magit-rules. If the rules does not exist,
return 'nil."
(catch 'exist
(unless pretty-magit-rules
(throw 'exist 'nil))
(-let* (((r-word . (&plist :icon r-icon :props r-props :target r-target))
rule)
(r-target (cond (r-target)
(t 'type))))
(--each pretty-magit-rules
(-let (((word . (&plist :icon :props :target)) it))
(when (and (string= word r-word)
(equal target r-target))
(when (and (equal icon r-icon)
(equal props r-props))
(throw 'exist t))
(throw 'exist it-index)))))))
(defun pretty-magit--rulep (rule)
"Return 't if RULE is a proper rule.
Rules are alists where the car is the word to be replaced. Its cdr is a plist
with keyword-value pairs of the icon, props, and target. Proper rules need to
have a car and a value for the icon property.
e.g.
'(docs
:icon ?
:props (:foreground \"#3F681C\" :height 1.2)
:target type)"
(cond ((not (car rule))
'nil)
((not (plist-get (cdr rule) :icon))
'nil)
(t)))
(defun pretty-magit--add-rule (rule)
"Add a single rule for replacing WORD to ICON with PROPS in TYPE."
(when (pretty-magit--rulep rule)
(-let* (((word . (&plist :icon :props :target)) rule)
(target (pretty-magit--ensure-target target))
(rx-list (pretty-magit--rx-list word target))
(rgx (pretty-magit--rx-string rx-list))
(props (cond (props)
(t pretty-magit-text-prop)))
(rule `(,word :icon ,icon :props ,props :target ,target :rgx ,rgx))
(elt (pretty-magit--rule-exist-p rule)))
(cond ((integerp elt)
(setf (nth elt pretty-magit-rules) rule))
((not elt)
(progn
(push rule pretty-magit-rules)
rule))
(t
rule)))))
;;;###autoload
(defun pretty-magit-add-rule (rule-list)
"Add a list of rules specified in RULE-LIST for replacing WORD to ICON with
PROPS into TYPE.
e.g. a single rule
(pretty-magit-add-rule '(docs
:icon ?
:props (:foreground \"#3F681C\" :height 1.2)
:target type))
e.g. 2 rules
(pretty-magit-add-rule '((docs
:icon ?
:props (:foreground \"#3F681C\" :height 1.2)
:target type)
(fix
:icon ?
:props (:foreground \"#FB6542\" :height 1.2)
:target type)))"
(cond ((when (pretty-magit--rulep rule-list)
(pretty-magit--add-rule rule-list)))
(t
(--each rule-list
(when (pretty-magit--rulep it)
(pretty-magit--add-rule it))))))
(defun pretty-magit-reload-rules ()
"Rebuild pretty-magit-rules with the default regexp strings.
Useful if it is edited by hand and the regexp string needs to be fixed. Improper
rules will be deleted."
(interactive)
(let* ((tmp (copy-alist pretty-magit-rules)))
(setq pretty-magit-rules 'nil)
(pretty-magit-add-rule tmp)))
;;;###autoload
(defun pretty-magit-prettify ()
"Clean up the magit buffer using pretty-magit-rules."
(interactive)
(with-silent-modifications
(--each pretty-magit-rules
(-let (((_ . (&plist :icon :props :target :rgx)) it))
(save-excursion
(goto-char (point-min))
(let ((match-index (cdr (assoc target pretty-magit--headers)))
(scope-index (cdr (assoc 'scope pretty-magit--headers))))
(while (search-forward-regexp rgx nil t)
(let* ((scope (> (match-end scope-index)
(match-beginning scope-index)))
(match (match-string match-index))
(beg (match-beginning match-index))
(end (if (and (equal target 'type)
scope)
(match-end match-index)
(+ 1 (match-end match-index))))
(icon-length (length (string icon)))
(icon (if (and (equal target 'type)
scope)
(concat (string icon) " ")
(string icon)))
(breaking (and (equal target 'type)
(string=
(substring match -1)
"!"))))
(replace-region-contents beg end (lambda () icon))
(add-face-text-property beg (+ beg icon-length) props)
(when breaking
(add-face-text-property beg (+ beg icon-length)
'(:underline "#FF0000") t))))))))))
;; Minor mode:
;;;###autoload
(define-minor-mode pretty-magit-mode
"Prettify Git messages on Magit with icons."
:init-value nil :lighter nil :keymap nil
(dolist (target '(magit-status magit-refresh-buffer))
(if (bound-and-true-p pretty-magit-mode)
(advice-add target :after #'pretty-magit-prettify)
(advice-remove target #'pretty-magit-prettify))))
(provide 'pretty-magit)
;;; pretty-magit.el ends here