~yoctocell/git-email

ref: eec990937a7fc2fdad8dd3e1041f7d397c98c8b7 git-email/git-email.el -rw-r--r-- 19.1 KiB
eec99093Xinglu Chen README: Link to online manual. 5 months ago
                                                                                
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
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
;;; git-email.el --- Work with git and email -*- lexical-binding: t; -*-

;; Copyright (C) 2021  all contributors <~yoctocell/git-email-deve@lists.sr.ht>

;; Author: Xinglu Chen <public@yoctocell.xyz>
;; URL: https://git.sr.ht/~yoctocell/git-email
;; Version: 0.2.0
;; Package-Requires: ((emacs "27.1") (project "0.5.0"))
;; Keywords: git mail
;; License: GNU General Public License >= 3

;; 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:

;; This package integrates with git and email and offers two main functions
;;
;; * `git-email-send-email' sends an email based on a patch file generated by
;; 'git format-patch'.  It inserts the relevant headers and the diff into the
;; message buffer.
;;
;; * `git-email-format-patch' is a wrapper for 'git format-patch' and it
;; automatically composes an email for each generated patch, in the same way
;; as `git-email-send-email'.

;;; Code:

(require 'project)
(require 'message)
(require 'cl-lib)


;;;; Customization options

(defgroup git-email nil
  "Work with git and email."
  :group 'convenience)

(defcustom git-email-compose-email-function #'message-mail
  "The function used to compose patch mail."
  :type 'function
  :group 'git-email
  :package-version '(git-email . "0.1.0"))

(defcustom git-email-send-email-function #'message-send-and-exit
  "The function used to send mail."
  :type 'function
  :group 'git-email
  :package-version '(git-email . "0.1.0"))

(defcustom git-email-pre-compose-email-hook nil
  "A list of functions called before running `git-email--compose-email'."
  :type 'hook
  :group 'git-email
  :package-version '(git-email . "0.1.0"))

(defcustom git-email-post-compose-email-hook nil
  "A list of functions called after running `git-email--compose-email'."
  :type 'hook
  :group 'git-email
  :package-version '(git-email . "0.1.0"))

(defcustom git-email-headers
  '(subject from cc in-reply-to message-id references)
  "List of headers that should get inserted into the message buffer.

The 'to' address will always be inserted by calling
`git-email-get-to-address-functions'."
  :type '(symbol)
  :group 'git-email
  :package-version '(git-email . "0.2.0"))

(defcustom git-email-get-current-project-functions
  '(git-email--get-current-project)
  "Hooks to run to get the path to the current project.
The path should end with a trailing \"/\"."
  :type 'hook
  :group 'git-email
  :package-version '(git-email . "0.2.0"))

(defcustom git-email-get-files-functions
  '(git-email--dired-files
    git-email--ibuffer-files
    git-email--vc-dir-files)
  "An list of functions to for getting a list of patches to send."
  :type 'hook
  :group 'git-email
  :package-version '(git-email . "0.1.0"))

(defcustom git-email-get-to-address-functions
  '(git-email--get-to-address)
  "Functions to run to get the \"to\" address of a message."
  :type 'hook
  :group 'git-email
  :package-version '(git-email . "0.1.0"))

(defcustom git-email-format-patch-default-args ""
  "Default arguments to give to 'git format-patch'."
  :type 'string
  :group 'git-email
  :package-version '(git-email . "0.1.0"))

(defcustom git-email-format-patch-extra-args
  '("--cover-letter"
    "--rfc"
    "--signoff"
    "--range-diff="
    "--interdiff="
    "--base="
    "--no-base"
    "--subject-prefix="
    "--thread="
    "--output-directory="
    "--to="
    "--reroll-count="
    "--in-reply-to=")
  "List of arguments to display in `git-email-format-patch'."
  :type '(string)
  :group 'git-email
  :package-version '(git-email . "0.2.0"))

(defcustom git-email-revision-limit 100
  "How many revisions to show when in `git-email-format-patch'."
  :type 'int
  :group 'git-email
  :package-version '(git-email . "0.1.0"))

(defcustom git-email-revision-command
  "git log --no-color --pretty='format:%h %d %s' --abbrev-commit -n "
  "Command to run to get a list of revisions."
  :type 'string
  :group 'git-email
  :package-version '(git-email . "0.1.0"))

(defcustom git-email-revision-parser #'git-email--parse-revision
  "Function for parsing the output of ‘git-email-revision-command’."
  :type 'hook
  :group 'git-email
  :package-version '(git-email . "0.2.0"))

(defcustom git-email-get-revision-functions '(git-email--log-get-revision)
  "List of functions to get the base commit for 'git format-patch'.
If none of the functions return non-nil value,
`git-email--minibuffer-get-revision' will be used as a fallback."
  :type 'hook
  :group 'git-email
  :package-version '(git-email . "0.2.0"))

(defcustom git-email-generate-message-buffer
  #'git-email-generate-message-buffer-name
  "Function for generating the name of a message buffer.
The function must take three arguments: the type, the \"To\"
address, and the group name.  See `message-generate-new-buffers'
for more information.

By default it will be \"*git-email unsent patch to *** TO ADDRESS
HERE *** *\"."
  :type '(choice (const nil)
		 (sexp :tag "unique" :format "unique\n" :value unique
		       :match (lambda (widget value) (memq value '(unique t))))
		 (const unsent)
		 (const standard)
		 (function :format "\n    %{%t%}: %v"))
  :group 'git-email
  :package-version '(git-email . "0.3.0"))

;; Remove Compiler warnings
(declare-function dired-get-filename "dired.el")
(declare-function dired-map-over-marks "dired.el")
(declare-function ibuffer-get-marked-buffers "ibuffer.el")
(declare-function vc-dir-marked-files "vc-dir.el")
(declare-function vc-dir-current-file "vc-dir.el")
(declare-function log-view-current-entry "log-view.el")


;;;; Get files to send

(defun git-email--check-file (file)
  "Check if FILE is a patch."
  (if (and (file-readable-p file)
           (or (string-match-p "\\.patch$" file)
               (string-match-p "\\.diff$" file)))
      file
    (user-error "Not a valid patch!")))

(defun git-email--dired-files ()
  "Return list of filenames for marked files in `dired'.
If no marks are found, return the filename at point."
  (when (eq major-mode 'dired-mode)
    (delq nil
          (mapcar
           (lambda (f) (if (file-directory-p f) nil f))
           (dired-map-over-marks (dired-get-filename) nil)))))

(defun git-email--vc-dir-files ()
  "Return list of filenames for marked files in `vc-dir'.
If no marks are found, return the filename at point."
  (when (eq major-mode 'vc-dir)
    (let* ((marked-files (nreverse (vc-dir-marked-files)))
           (files (if marked-files
                      marked-files
                    (list (vc-dir-current-file)))))
      files)))

(defun git-email--ibuffer-files ()
  "Return list of filenames for marked files in `ibuffer'."
  (when (eq major-mode 'ibuffer-mode)
    (let ((marked-files (nreverse
                         (mapcar (lambda (b) (buffer-file-name b))
                                 (ibuffer-get-marked-buffers)))))
      marked-files)))

(defun git-email--minibuffer-file ()
  "Prompt for a file to send as a patch."
  (list (car (find-file-read-args "Find patch: "
                                  (confirm-nonexistent-file-or-buffer)))))

(defun git-email--get-files ()
  "Return list of filenames for marked files in `vc-dir'.
If no marks are found, return the filename at point."
  (let ((files (or (run-hook-with-args-until-success
                    'git-email-get-files-functions)
                   (git-email--minibuffer-file))))
    (when (mapcar #'git-email--check-file files)
      files)))

(declare-function projectile-project-root "projectile")

(defun git-email--get-current-project ()
  "Return the path of the current project.
Falls back to `default-directory'."
  (let ((dir (or (and (bound-and-true-p projectile-known-projects)
                      (projectile-project-root))
                 (and (bound-and-true-p project-list-file)
                      (cdr (project-current)))
                 (vc-root-dir)
                 default-directory)))
    dir))


;;;; Get contents from patch

(defun git-email--extract-header (header)
  "Extract HEADER from the current buffer."
  (goto-char (point-min))
  (if (eq header 'subject)
      (git-email--extract-subject)
    (buffer-substring-no-properties
     (if (re-search-forward (format " *%s: +" header) nil t)
         (point)
       (point-at-eol))
     (point-at-eol))))

(defvar git-email-subject-regexp
  (rx bol "Subject:"
      (zero-or-more space) "["
      (zero-or-more (not (any "]" "\n")))
      "PATCH"
      (zero-or-more (not (any "]" "\n")))
      "]" (one-or-more space)
      (one-or-more not-newline)
      (or (and eol (= 2 space)
               (one-or-more (not (any "\n" "\t" "$"))) eol)
          eol)))

(defun git-email--extract-subject ()
  "Extract the subject from the current buffer.  git-format-patch
will add a newline in the subject if the subject is too long.
Just using `git-email--extract-header' would result in part of
the subject being cut of.  See what I did there?  ;-)"
  (let ((string (buffer-substring-no-properties (point-min) (point-max))))
    (string-match git-email-subject-regexp string)
    (string-remove-prefix
     "Subject: " (replace-regexp-in-string
                  "\n" "" (match-string-no-properties 0 string)))))

(defun git-email--extract-headers (patch-file)
  "Extract headers from PATCH-FILE.
If the header is not found, return an empty string."
  (with-temp-buffer
    (insert-file-contents patch-file)
    (mapcar (lambda (header)
              `(,header . ,(git-email--extract-header header)))
            git-email-headers)))

(defun git-email--extract-diff (patch-file)
  "Extract the diff from PATCH-FILE."
  (with-temp-buffer
    (insert-file-contents patch-file)
    (goto-char (point-min))
    (buffer-substring
     (- (re-search-forward "\n\n") 1)
     (point-max))))

;; See https://emacs.stackexchange.com/a/5408
(defun git-email--fontify-diff (text)
  "Fontify TEXT as diffs in `message-mode'."
  (with-temp-buffer
    (erase-buffer)
    (insert text)
    (delay-mode-hooks (diff-mode))
    (font-lock-default-function #'diff-mode)
    (font-lock-default-fontify-region (point-min)
                                      (point-max)
                                      nil)
    (buffer-string)))

(defun git-email--fontify-using-faces (text)
  "Fontify TEXT using faces."
  (let ((pos 0)
        (next (gensym)))
    (while (setq next (next-single-property-change pos 'face text))
      (put-text-property pos next 'font-lock-face
                         (get-text-property pos 'face text) text)
      (setq pos next))
    (add-text-properties 0  (length text) '(fontified t) text)
    text))

(defun git-email--remove-subject (header)
  "Remove HEADER if it is the subject."
  (not (string-equal (symbol-name (car header)) "subject")))

(defun git-email--get-to-address ()
  "Get the \"to\" address of the message.

This runs \“git config --list\" in the current directory
so might not always work."
  (let* ((to (shell-command-to-string  "git config --list | grep sendemail.to"))
         (address (if (string= "" to)
                      ""
                    (substring to 13 -1)))) ; Remove newline
    address))

(defun git-email--compose-email (patch-file)
  "Given a PATCH-FILE, compose an email.
Extracts the relevant headers and the diff from the PATCH-FILE and inserts
them into the message buffer."
  (let* ((headers (git-email--extract-headers patch-file))
         ;; Remove empty headers.
         (used-headers (seq-filter
                        (lambda (header)
                          (not (string-equal (cdr header) "")))
                        headers))
         (to-address (seq-position used-headers
                                   'to
                                   (lambda (a b)
                                     (equal (car a) b))))
         ;; Don't insert 'to' address if the patch already contains one.
         (sendemail-to (if to-address
                           (cdr (nth to-address used-headers))
                         (run-hook-with-args-until-success
                          'git-email-get-to-address-functions)))
         (to (if (string-equal sendemail-to "")
                 "*** TO ADDRESS HERE ***"
               sendemail-to))
         (diff (git-email--extract-diff patch-file)))
    (funcall git-email-compose-email-function to
             ;; Remove 'subject' header, otherwise two subject headers will be
             ;; inserted.
             (cdr (assoc 'subject used-headers))
             (seq-filter #'git-email--remove-subject used-headers))
    ;; Insert diff at the beginning of the body
    (goto-char (point-min))
    (let ((_ (or (re-search-forward
                  "^<#part \\(encrypt\\|sign\\)=.*mime>$"
                  nil t)
                 (re-search-forward (regexp-quote mail-header-separator) nil t))))
      (save-excursion
        (insert (git-email--fontify-using-faces
                 (git-email--fontify-diff diff)))))
    ;; Jump to subject or 'to' address if they are emtpy
    (when (or (re-search-backward "\\*\\*\\* TO ADDRESS HERE \\*\\*\\*" nil t)
              (re-search-backward "\\*\\*\\* SUBJECT HERE \\*\\*\\*" nil t))
      (kill-line))))


;;;; Format patches

(defun git-email--minibuffer-get-revision ()
  "Let the user choose a git revision from the minibuffer."
  (interactive)
  (let* ((default-directory (run-hook-with-args-until-success
                             'git-email-get-current-project-functions))
         ;; Last element is an empty string
         (revs (split-string
                (shell-command-to-string
                 (concat
                  git-email-revision-command
                  (int-to-string git-email-revision-limit)))
                "\n"))
         ;; Sort the candidates correctly.
         ;; See https://emacs.stackexchange.com/a/41808.
         (sorted-revs
          (lambda (string pred action)
            (if (eq action 'metadata)
                '(metadata (display-sort-function . identity)
                           (cycle-sort-function . identity))
              (complete-with-action
               action revs string pred)))))
    (git-email--parse-revision (completing-read "Revision: " sorted-revs))))

(defun git-email--parse-revision (rev)
  "Return only the revision hash from REV.

This parses the output of ‘git-email--minibuffer-get-revision’."
  (substring rev 0 7))

(defun git-email--log-get-revision ()
  "Get the revision at point in `log-view-mode'."
  (when (eq major-mode 'vc-git-log-view-mode)
    (cadr (log-view-current-entry (point) t))))

;;;###autoload
(defun git-email-format-patch (args range keep)
  "Format and send patch(es) using 'git format-patch'.

ARGS are additional arguments to give to 'git format-patch'.  By
default, the arguments in `git-email-format-patch-default-args'
will be used.

Patches for the commits in RANGE will be created.

With prefix argument KEEP, keep the generated patches.  The
default behavior is to delete them after sending the message."
  (interactive
   (list (apply #'concat (mapcar
                          (lambda (a) (concat a " "))
                          (completing-read-multiple
                           "Args: " git-email-format-patch-extra-args
                           nil nil git-email-format-patch-default-args)))
         (or (run-hook-with-args-until-success
              'git-email-get-revision-functions)
             (git-email--minibuffer-get-revision))
         current-prefix-arg))
  ;; List of patches generated, the last element is an empty string
  ;; so remove it.  Reverse the list so we edit the cover letter first.
  (let ((files (nreverse (butlast
                          (split-string
                           (shell-command-to-string
                            (format "git format-patch %s %s"
                                    args range))
                           "\n")))))
    (git-email--send-files files)
    (unless keep
      (mapc #'delete-file files))))


;;;; Misc

(defun git-email-generate-message-buffer-name (_type address _group)
  "Generate a buffer name that looks like this:

\"* git-email unsent patch to *** TO ADDRESS HERE *** *\""
  (concat "*git-email unsent patch to " address " *"))


;;;; Operate on emails

(defun git-email-message-buffer-greaterp (old new)
  "Compare the number in the buffer name of OLD with NEW"
  (cl-flet ((regexp (name)
                    (string-to-number
                     (replace-regexp-in-string ".*<\\([0-9]+\\)>"
                                               "\\1"
                                               name))))
    (let ((old (regexp old))
          (new (regexp new)))
      (> old new))))

(defun git-email-send-all ()
  "Send all unsent emails."
  (interactive)
  ;; Sort the buffers so that [PATCH 0/N] comes first, this prevents
  ;; the ordering from getting messed up.
  (let ((buffers (sort (message-buffers) #'git-email-message-buffer-greaterp)))
    (mapc (lambda (b) (switch-to-buffer b)
            (funcall git-email-send-email-function))
          buffers)))

(defun git-email--rewrite-header-in-buffer (buffer header value append)
  (switch-to-buffer buffer)
  (save-excursion
    (goto-char (point-min))
    (let* ((case-fold-search t))
      (if (re-search-forward (concat "^" (capitalize header) ":") nil t)
          (progn
            (unless append
              (delete-region (point) (point-at-eol)))
            (goto-char (point-at-eol))
            (insert " " value))
        (progn
          (re-search-forward "^Subject: .*$")
          (insert "\n" (concat (capitalize header) ": " value)))))))

(defun git-email--send-files (files)
  (dolist (file files)
    (run-hooks 'git-email-pre-compose-email-hook)
    (let ((message-generate-new-buffers
           git-email-generate-message-buffer))
      (git-email--compose-email file))
    (run-hooks 'git-email-post-compose-email-hook)))

;;;###autoload
(defun git-email-rewrite-header (header value &optional append)
  "Re-write the value of HEADER to VALUE, if HEADER doesn't exist
yet, just set it to VALUE.

With prefix argument APPEND, append the VALUE to HEADER instead
of overwriting it.

This is mainly useful if you forgot to Cc someone when using
`git-email-format-patch', or if you are waiting for Debbugs to
give you an address to send your patches to."
  (interactive
   (list (completing-read "Header to re-write: "
                          git-email-headers)
         (read-from-minibuffer "Set header to: ")
         current-prefix-arg))
  (let ((buffers (message-buffers))
        (start-buffer (current-buffer)))
    (save-excursion
       (mapc (lambda (buffer)
               (git-email--rewrite-header-in-buffer
                buffer header value append))
             buffers))
    (switch-to-buffer start-buffer)))

;;;###autoload
(defun git-email-send-email (files)
  "Send FILES as patch(es) to someone using your MUA."
  (interactive (list (git-email--get-files)))
  (git-email--send-files files))

(provide 'git-email)
;;; git-email.el ends here