emacs-patch-review
Port of Thunderbird Patch Review to mu4e.
git clone git://mccd.space/emacs-patch-review| Log | Files | Refs | README | Mail |
patch-review.el (22602B)
1 ;;; patch-review.el --- Review git patches from email -*- lexical-binding: t; -*-
2
3 ;; Copyright (C) 2026 Marc Coquand
4
5 ;; This program is free software: you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation, either version 3 of the License, or
8 ;; (at your option) any later version.
9
10 ;; Package-Requires: ((emacs "28.1"))
11 ;; Version: 0.1.0
12
13 ;;; Commentary:
14
15 ;; A major mode (derived from `diff-mode') for reviewing git patches
16 ;; received by email. The review buffer is an ordinary, editable diff
17 ;; buffer: type your commentary anywhere in it. On send (C-c C-c), the
18 ;; buffer is diffed against the pristine original; your insertions are
19 ;; extracted, anchored to the patch line above them, and formatted as an
20 ;; interleaved mailing-list reply. C-c C-a applies the patch to a local
21 ;; repository with git-am(1).
22 ;;
23 ;; Entry points:
24 ;; M-x patch-review-open-message-file — raw .eml / format-patch file
25 ;; patch-review-mu4e-review — from a mu4e view buffer
26 ;; opening a .patch/.diff file — via auto-mode-alist
27 ;;
28 ;; This is an Emacs port of the Thunderbird Patch Review add-on
29 ;; (thunderbird-review-ui).
30
31 ;;; Code:
32
33 (require 'cl-lib)
34 (require 'subr-x)
35 (require 'diff-mode)
36 (require 'message)
37 (require 'mailheader)
38 (require 'project)
39 (require 'patch-review-parse)
40 (require 'patch-review-reply)
41 (require 'patch-review-git)
42
43 ;;;; Customization
44
45 (defgroup patch-review nil
46 "Review git patches from email."
47 :group 'tools
48 :prefix "patch-review-")
49
50 (defcustom patch-review-project nil
51 "Repository to probe and apply patches against.
52 When nil, fall back to the current project (per `project-current');
53 \\[patch-review-set-project] sets it per buffer."
54 :type '(choice (const :tag "Ask" nil) directory)
55 :group 'patch-review)
56
57 (defface patch-review-status-ok
58 '((t :inherit success))
59 "Face for a positive apply status (applies cleanly / already applied)."
60 :group 'patch-review)
61
62 (defface patch-review-status-warn
63 '((t :inherit warning))
64 "Face for a warning apply status (dirty worktree, no project)."
65 :group 'patch-review)
66
67 (defface patch-review-status-error
68 '((t :inherit error))
69 "Face for a negative apply status (conflicts, am in progress)."
70 :group 'patch-review)
71
72 ;;;; Buffer state
73
74 (defvar-local patch-review--parsed nil
75 "The `patch-review-email' struct for this buffer.")
76
77 (defvar-local patch-review--pristine nil
78 "The buffer text as opened. Comments are extracted by diffing the
79 current buffer against this string.")
80
81 (defvar-local patch-review--headers nil
82 "Alist of the source message's mail headers, per `mail-header-extract'.")
83
84 (defvar-local patch-review--source-file nil
85 "File `git am' is run on for this buffer.")
86
87 (defvar-local patch-review--project nil
88 "Repository this buffer's patch targets.")
89
90 (defvar-local patch-review--status 'unknown
91 "Apply status: unknown, checking, applicable, applied, dirty,
92 conflict, am-in-progress or no-project.")
93
94 (defvar-local patch-review--status-detail nil
95 "Human-readable detail for `patch-review--status'.")
96
97 (defvar patch-review--pending-init nil
98 "Dynamically bound initialization plist for `patch-review-mode'.
99 `patch-review--open-text' binds this around the mode call so the
100 mode's self-initialization can pick up headers, source file and
101 project.")
102
103 ;;;; Mode
104
105 (define-derived-mode patch-review-mode diff-mode "PatchReview"
106 "Major mode for reviewing a git patch.
107
108 The buffer is editable: type comments anywhere. On \\[patch-review-send-review]
109 the buffer is diffed against the pristine original and your
110 insertions are sent as an interleaved review reply.
111
112 \\{patch-review-mode-map}"
113 (setq buffer-read-only nil)
114 ;; `diff-mode' enables `diff-mode-shared-map' (RET→diff-goto-source,
115 ;; digits→digit-argument, special-mode's [remap self-insert-command
116 ;; → undefined], …) whenever the buffer was read-only when the
117 ;; parent body ran, by latching the buffer-local `diff-mode-read-only'
118 ;; to read-only state. A review buffer taken over in place from a
119 ;; read-only mu4e article starts that way, so diff-mode latches the
120 ;; short keys before we flip `buffer-read-only' back to nil; doing
121 ;; so would otherwise make the buffer uneditable and turn RET into
122 ;; the "Use file …: " prompt from `diff-goto-source'. Drop the
123 ;; latch so the shared diff keymap never activates here.
124 (setq diff-mode-read-only nil)
125 (setq-local header-line-format '(:eval (patch-review--header-line)))
126 (patch-review--ensure-initialized))
127
128 (define-key patch-review-mode-map (kbd "C-c C-c") #'patch-review-send-review)
129 (define-key patch-review-mode-map (kbd "C-c C-a") #'patch-review-apply)
130 (define-key patch-review-mode-map (kbd "C-c C-p") #'patch-review-set-project)
131 (define-key patch-review-mode-map (kbd "C-c C-r") #'patch-review-refresh-status)
132
133 (defun patch-review--ensure-initialized ()
134 "Initialize the review buffer from its text unless already done."
135 (unless patch-review--parsed
136 (let* ((pending patch-review--pending-init)
137 (text (buffer-substring-no-properties (point-min) (point-max)))
138 (headers (or (plist-get pending :headers)
139 (car (patch-review--split-message text))))
140 (source (or (plist-get pending :source) buffer-file-name)))
141 (setq patch-review--pristine text
142 patch-review--parsed (patch-review-parse-email text)
143 patch-review--headers headers
144 patch-review--source-file source
145 patch-review--project (or (plist-get pending :project)
146 (patch-review--default-project)))
147 (if (and patch-review--project source)
148 (patch-review-refresh-status)
149 (setq patch-review--status 'no-project)))))
150
151 (defun patch-review--default-project ()
152 "Default repository for new review buffers."
153 (or patch-review-project
154 (when-let* ((pr (project-current nil)))
155 (project-root pr))))
156
157 ;;;; Opening
158
159 ;;;###autoload
160 (defun patch-review-open-message-file (file &optional project in-place)
161 "Open raw patch email FILE (an .eml or format-patch file) for review.
162 PROJECT overrides the target repository. When IN-PLACE is non-nil,
163 reuse the current buffer instead of popping up a new one (see
164 `patch-review--open-text')."
165 (interactive "fPatch message file: ")
166 (patch-review--open-text
167 (with-temp-buffer
168 (insert-file-contents file)
169 (buffer-string))
170 (expand-file-name file)
171 project
172 in-place))
173
174 (defun patch-review--open-text (text source-file project &optional in-place)
175 "Open TEXT (a raw message) in a review buffer.
176 SOURCE-FILE is what `git am' runs on; PROJECT overrides the target
177 repository. Return the review buffer.
178
179 When IN-PLACE is non-nil, reuse the current buffer instead of
180 popping up a new one: the buffer is renamed to `*Review: SUBJECT*',
181 its contents are replaced with the message body, and it is switched
182 to `patch-review-mode'. `patch-review-mu4e-review' uses this to
183 take over a mu4e article buffer rather than opening a window."
184 (pcase-let ((`(,headers . ,body) (patch-review--split-message text)))
185 (unless (patch-review-patch-message-p (cdr (assq 'subject headers)) body)
186 (unless (y-or-n-p "This message does not look like a patch; open anyway? ")
187 (user-error "Aborted")))
188 (let ((name (format "*Review: %s*"
189 (or (patch-review--decode (cdr (assq 'subject headers)))
190 (and source-file
191 (file-name-nondirectory source-file))
192 "patch")))
193 (init (list :headers headers :source source-file :project project)))
194 (if in-place
195 (let ((buf (current-buffer)))
196 (with-current-buffer buf
197 (rename-buffer name t)
198 (let ((inhibit-read-only t))
199 (erase-buffer)
200 (insert body)
201 (goto-char (point-min)))
202 (let ((patch-review--pending-init init))
203 (patch-review-mode)))
204 buf)
205 (let ((buf (generate-new-buffer name)))
206 (with-current-buffer buf
207 (insert body)
208 (goto-char (point-min))
209 (let ((patch-review--pending-init init))
210 (patch-review-mode)))
211 (pop-to-buffer buf)
212 buf)))))
213
214 (defun patch-review--split-message (text)
215 "Split raw message TEXT into (HEADERS . BODY).
216 HEADERS is nil when the text carries no mail header block (a bare
217 .diff). A leading mbox \"From \" line is skipped."
218 (with-temp-buffer
219 (insert text)
220 (goto-char (point-min))
221 (when (looking-at "From .*Mon Sep 17 00:00:00 2001$")
222 (forward-line 1))
223 (if (not (looking-at "[A-Za-z][A-Za-z0-9-]*:"))
224 (cons nil text)
225 (let* ((hdr-end (save-excursion
226 (if (re-search-forward "^$" nil t)
227 (line-beginning-position)
228 (point-min))))
229 (headers (save-excursion
230 (save-restriction
231 (narrow-to-region (point-min) hdr-end)
232 (goto-char (point-min))
233 (mail-header-extract))))
234 (body-start (save-excursion
235 (goto-char hdr-end)
236 (forward-line 1)
237 (point))))
238 (cons headers
239 (buffer-substring-no-properties body-start (point-max)))))))
240
241 (defun patch-review--decode (s)
242 "Decode encoded words in header string S, if possible."
243 (when s
244 (if (fboundp 'mail-decode-encoded-word-string)
245 (mail-decode-encoded-word-string s)
246 s)))
247
248 ;;;; Header line
249
250 (defun patch-review--button (label help command)
251 "Return LABEL as a clickable header-line button running COMMAND."
252 (propertize label
253 'keymap (let ((map (make-sparse-keymap)))
254 (define-key map [header-line mouse-1] command)
255 map)
256 'mouse-face 'highlight
257 'follow-link t
258 'help-echo help))
259
260 (defun patch-review--status-string ()
261 "Propertized status text for the header line."
262 (pcase patch-review--status
263 ('applicable (propertize "applies cleanly" 'face 'patch-review-status-ok))
264 ('applied (propertize "already applied" 'face 'patch-review-status-ok))
265 ('dirty (propertize "worktree dirty" 'face 'patch-review-status-warn))
266 ('conflict (propertize "conflicts" 'face 'patch-review-status-error))
267 ('am-in-progress (propertize "am in progress" 'face 'patch-review-status-error))
268 ('no-project (propertize "no project (C-c C-p)" 'face 'patch-review-status-warn))
269 ('checking (propertize "checking..." 'face 'shadow))
270 (_ (propertize "unknown" 'face 'shadow))))
271
272 (defun patch-review--header-line ()
273 "Compute the review buffer's header line."
274 (let ((subject (or (patch-review--decode (cdr (assq 'subject
275 patch-review--headers)))
276 (buffer-name)))
277 (project (if patch-review--project
278 (abbreviate-file-name
279 (directory-file-name patch-review--project))
280 "—")))
281 (concat
282 " " (propertize subject 'face 'bold)
283 " | Project: " project
284 " | " (propertize (substring-no-properties (patch-review--status-string))
285 'face (get-text-property
286 0 'face (patch-review--status-string))
287 'help-echo patch-review--status-detail)
288 " | "
289 (patch-review--button "[Send review]" "C-c C-c: compose the review reply"
290 #'patch-review-send-review)
291 " "
292 (patch-review--button "[Apply]" "C-c C-a: apply with git am"
293 #'patch-review-apply)
294 " "
295 (patch-review--button "[Refresh]" "C-c C-r: re-run the applicability probe"
296 #'patch-review-refresh-status))))
297
298 ;;;; Project and status
299
300 (defun patch-review-set-project (dir)
301 "Set the repository DIR this patch targets and re-run the probe."
302 (interactive "DProject repository: " patch-review-mode)
303 (unless (patch-review-git-describe dir)
304 (user-error "%s is not a git working tree" dir))
305 (setq patch-review--project dir)
306 (patch-review-refresh-status))
307
308 (defun patch-review-refresh-status ()
309 "Re-run the applicability probe for the current project."
310 (interactive nil patch-review-mode)
311 (cond
312 ((null patch-review--project)
313 (setq patch-review--status 'no-project
314 patch-review--status-detail "Set a project with C-c C-p."))
315 ((null patch-review--source-file)
316 (setq patch-review--status 'unknown
317 patch-review--status-detail "No source file to probe."))
318 (t
319 (setq patch-review--status 'checking)
320 (force-mode-line-update t)
321 (message "Probing %s..." patch-review--project)
322 (pcase-let ((`(,status . ,detail)
323 (patch-review-git-check patch-review--project
324 patch-review--source-file)))
325 (setq patch-review--status status
326 patch-review--status-detail detail)
327 (message "Status: %s" (substring-no-properties
328 (patch-review--status-string))))))
329 (force-mode-line-update t))
330
331 ;;;; Comment extraction
332
333 (defun patch-review--write-temp (text)
334 "Write TEXT to a temporary file (final newline ensured); return it."
335 (let ((file (make-temp-file "patch-review")))
336 (with-temp-file file
337 (insert text)
338 (unless (or (zerop (buffer-size))
339 (eq (char-before (point-max)) ?\n))
340 (goto-char (point-max))
341 (insert "\n")))
342 file))
343
344 (defun patch-review--locator-index (parsed)
345 "Map body-line indices of PARSED to locator strings."
346 (let ((index (make-hash-table :test #'eql)))
347 (cl-loop for fi from 0
348 for file in (patch-review-email-files parsed)
349 do (cl-loop for hi from 0
350 for hunk in (patch-review-file-hunks file)
351 do (cl-loop
352 for li from 0
353 for line in (patch-review-hunk-lines hunk)
354 do (puthash (patch-review-line-body-line line)
355 (patch-review-reply-locator fi hi li)
356 index))))
357 index))
358
359 (defun patch-review--add-comment (comments anchor added locator-index)
360 "Record ADDED lines as a comment at ANCHOR (1-based pristine line).
361 ANCHOR 0 or an anchor outside any hunk maps to the general comment.
362 Return the updated COMMENTS alist."
363 (let ((text (string-trim (mapconcat #'identity added "\n"))))
364 (if (string-empty-p text)
365 comments
366 (let* ((locator (or (and (> anchor 0)
367 (gethash (1- anchor) locator-index))
368 patch-review-reply-general))
369 (existing (assoc locator comments)))
370 (if existing
371 (progn
372 (setcdr existing (concat (cdr existing) "\n\n" text))
373 comments)
374 (cons (cons locator text) comments))))))
375
376 (defun patch-review--parse-diff (text locator-index)
377 "Parse `diff -U0' output TEXT against LOCATOR-INDEX.
378 Return (COMMENTS DELETIONS CHANGES): an alist (LOCATOR . TEXT) and
379 counts of original lines the user deleted or rewrote."
380 (let ((comments nil) (deletions 0) (changes 0))
381 (with-temp-buffer
382 (insert text)
383 (goto-char (point-min))
384 (while (re-search-forward
385 "^@@ -\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? \\+\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? @@"
386 nil t)
387 (let ((old-start (string-to-number (match-string 1)))
388 (old-count (if (match-string 2)
389 (string-to-number (match-string 2)) 1))
390 (new-count (if (match-string 4)
391 (string-to-number (match-string 4)) 1))
392 (added nil) (removed nil))
393 (forward-line 1)
394 (while (and (not (eobp)) (looking-at "^[-+\\\\]"))
395 (pcase (char-after)
396 (?+ (push (buffer-substring-no-properties
397 (1+ (point)) (line-end-position))
398 added))
399 (?- (push (buffer-substring-no-properties
400 (1+ (point)) (line-end-position))
401 removed)))
402 (forward-line 1))
403 (setq added (nreverse added)
404 removed (nreverse removed))
405 (cond
406 ;; Pure insertion: comment on the original line above.
407 ((= old-count 0)
408 (setq comments
409 (patch-review--add-comment comments old-start added
410 locator-index)))
411 ;; Pure deletion of original text.
412 ((= new-count 0)
413 (setq deletions (+ deletions (length removed))))
414 ;; Rewritten lines: the new text is a comment on the last
415 ;; replaced line — unless only the final newline changed,
416 ;; which diff reports as remove+add of identical lines.
417 ((not (equal added removed))
418 (setq changes (+ changes (length removed))
419 comments
420 (patch-review--add-comment
421 comments (+ old-start old-count -1) added
422 locator-index)))))))
423 (list comments deletions changes)))
424
425 (defun patch-review-extract-comments (parsed pristine current)
426 "Diff PRISTINE against CURRENT and extract the user's comments.
427 PARSED is the `patch-review-email' struct for PRISTINE. Return
428 \(COMMENTS DELETIONS CHANGES); see `patch-review--parse-diff'."
429 (let ((a (patch-review--write-temp pristine))
430 (b (patch-review--write-temp current)))
431 (unwind-protect
432 (let ((output
433 (with-temp-buffer
434 (let ((exit (call-process "diff" nil t nil "-U0"
435 "--label" "pristine"
436 "--label" "current" a b)))
437 (pcase exit
438 (0 nil)
439 (1 (buffer-string))
440 (_ (error "diff failed: %s" (buffer-string))))))))
441 (if (null output)
442 (list nil 0 0)
443 (patch-review--parse-diff
444 output (patch-review--locator-index parsed))))
445 (delete-file a)
446 (delete-file b))))
447
448 ;;;; Sending the review
449
450 (defun patch-review-send-review ()
451 "Extract comments from the buffer and compose the review reply.
452 Text inserted above the first hunk becomes a general remark; text
453 inserted anywhere else is a comment on the patch line above it."
454 (interactive nil patch-review-mode)
455 (unless patch-review--parsed
456 (user-error "Not a patch review buffer"))
457 (let ((comments (car (patch-review-extract-comments
458 patch-review--parsed
459 patch-review--pristine
460 (buffer-substring-no-properties
461 (point-min) (point-max))))))
462 (unless comments
463 (when (y-or-n-p "No inline comments found; add a general comment? ")
464 (let ((text (read-string "General comment: ")))
465 (unless (string-empty-p (string-trim text))
466 (push (cons patch-review-reply-general text) comments))))
467 (unless comments
468 (user-error "Nothing to send")))
469 (patch-review--compose
470 (patch-review-reply-format patch-review--parsed comments))))
471
472 (defun patch-review--compose (body)
473 "Open a `message-mode' reply buffer containing BODY."
474 (let* ((headers patch-review--headers)
475 (from (patch-review--decode (cdr (assq 'from headers))))
476 (to (or from (read-string "To: ")))
477 (subject (or (cdr (assq 'subject headers)) "patch review"))
478 (message-id (cdr (assq 'message-id headers)))
479 (cc (patch-review--cc-list headers))
480 (new-subject
481 (concat "Re: "
482 (replace-regexp-in-string
483 "^\\s-*\\(?:[Rr][Ee]\\s-*:\\s-*\\)*" "" subject)))
484 (other-headers
485 (append (unless (string-empty-p cc) `(("Cc" . ,cc)))
486 (when message-id
487 `(("In-Reply-To" . ,message-id)
488 ("References" . ,message-id))))))
489 (message-mail to new-subject other-headers)
490 (message-goto-body)
491 (delete-region (point) (point-max))
492 (insert body)
493 (message-goto-body)
494 (message "Review the draft, then C-c C-c to send.")))
495
496 (defun patch-review--cc-list (headers)
497 "Join the original To and Cc for a wide reply."
498 (mapconcat #'identity
499 (delq nil (mapcar (lambda (s) (and s (string-trim s)))
500 (list (cdr (assq 'to headers))
501 (cdr (assq 'cc headers)))))
502 ", "))
503
504 ;;;; Applying
505
506 (defun patch-review-apply (&optional no-hooks)
507 "Apply the reviewed patch to the current project with `git am'.
508 With prefix argument NO-HOOKS, suppress the user's git hooks."
509 (interactive "P" patch-review-mode)
510 (unless patch-review--project
511 (user-error "No project set; use C-c C-p first"))
512 (unless patch-review--source-file
513 (user-error "No patch file to apply"))
514 (pcase-let ((`(,status . ,output)
515 (patch-review-git-apply patch-review--project
516 patch-review--source-file
517 no-hooks)))
518 (setq patch-review--status status
519 patch-review--status-detail output)
520 (force-mode-line-update t)
521 (pcase status
522 ('applied
523 (message "Applied to %s." (abbreviate-file-name
524 (directory-file-name
525 patch-review--project))))
526 (_
527 (with-current-buffer (get-buffer-create "*patch-review-apply*")
528 (let ((inhibit-read-only t))
529 (erase-buffer)
530 (insert (format "git am in %s — %s\n\n%s"
531 (abbreviate-file-name
532 (directory-file-name patch-review--project))
533 (substring-no-properties
534 (patch-review--status-string))
535 output))
536 (goto-char (point-min))
537 (diff-mode)
538 (read-only-mode 1))
539 (pop-to-buffer (current-buffer)))))))
540
541 ;;;###autoload
542 (add-to-list 'auto-mode-alist '("\\.\\(?:patch\\|diff\\)\\'" . patch-review-mode))
543
544 (provide 'patch-review)
545 ;;; patch-review.el ends here