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-parse.el (13985B)
1 ;;; patch-review-parse.el --- Parse git patch emails -*- 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 ;;; Commentary:
11
12 ;; Pure parsing for git format-patch emails, ported from
13 ;; thunderbird-review-ui's modules/diff-parse.js and
14 ;; modules/patch-detect.js. No side effects.
15 ;;
16 ;; Every parsed element remembers the index of its source line in the
17 ;; email body (`body-line') so replies can re-quote the original text
18 ;; verbatim.
19
20 ;;; Code:
21
22 (require 'cl-lib)
23 (require 'subr-x)
24
25 ;;;; Data structures
26
27 (cl-defstruct (patch-review-email (:constructor patch-review-email--create))
28 "Parsed patch email."
29 commit-message diffstat files body-lines)
30
31 (cl-defstruct (patch-review-file (:constructor patch-review-file--create))
32 "One file's diff within a patch email."
33 old-path new-path display-path
34 is-binary is-new is-deleted is-rename
35 body-line hunks)
36
37 (cl-defstruct (patch-review-hunk (:constructor patch-review-hunk--create))
38 "One hunk within a file diff."
39 header section body-line
40 old-start old-count new-start new-count
41 lines)
42
43 (cl-defstruct (patch-review-line (:constructor patch-review-line--create))
44 "One line within a hunk; ORIGIN is `add', `del' or `ctx'."
45 origin text raw body-line old-line new-line)
46
47 ;;;; Regexps
48
49 (defconst patch-review--hunk-re
50 "^@@ -\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? \\+\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? @@ ?\\(.*\\)$")
51
52 (defconst patch-review--diff-git-re
53 "^diff --git \\(?:\"?a/\\(.*?\\)\"?\\) \\(?:\"?b/\\(.*?\\)\"?\\)$")
54
55 (defconst patch-review--scissors-re "^---\\s-*$")
56
57 (defconst patch-review--mbox-from-re "^From .*Mon Sep 17 00:00:00 2001$")
58
59 (defconst patch-review--signature-re "^-- ?$")
60
61 ;;;; Patch email parsing
62
63 (defun patch-review-parse-email (text)
64 "Parse TEXT, the body of a git format-patch email.
65 Return a `patch-review-email' struct with commit message, diffstat
66 and a structured diff."
67 (cl-block nil
68 (let* ((body-lines (split-string (or text "") "\r?\n"))
69 (n (length body-lines))
70 (first-diff (cl-loop for i from 0 below n
71 for l = (nth i body-lines)
72 when (or (string-match patch-review--diff-git-re l)
73 (string-match patch-review--hunk-re l))
74 return i))
75 (result (patch-review-email--create :body-lines (vconcat body-lines)))
76 file hunk old-line new-line consumed-old consumed-new)
77 (unless first-diff
78 (setf (patch-review-email-commit-message result) (or text ""))
79 (cl-return result))
80
81 ;; The commit message ends at the "---" scissors line when present,
82 ;; otherwise at the first diff line. Between the scissors and the
83 ;; diff sits the diffstat.
84 (let ((scissors (cl-loop for i from 0 below first-diff
85 when (string-match patch-review--scissors-re
86 (nth i body-lines))
87 return i))
88 (message-start 0)
89 message-end)
90 (setq message-end (or scissors first-diff))
91 ;; git format-patch prepends an mbox-style header block to the body
92 ;; ("From <sha> Mon Sep 17 ...", From:, Date:, Subject:, then a
93 ;; blank line). Strip it to keep only the commit message text.
94 (when (and (> message-end 0)
95 (string-match patch-review--mbox-from-re (car body-lines)))
96 (let ((blank 1))
97 (while (and (< blank message-end)
98 (not (string-empty-p (nth blank body-lines))))
99 (setq blank (1+ blank)))
100 (setq message-start (min (1+ blank) message-end))))
101 (setf (patch-review-email-commit-message result)
102 (string-trim
103 (mapconcat #'identity
104 (cl-subseq body-lines message-start message-end)
105 "\n")))
106 (when scissors
107 (setf (patch-review-email-diffstat result)
108 (string-trim
109 (mapconcat #'identity
110 (cl-subseq body-lines (1+ scissors) first-diff)
111 "\n")))))
112
113 (cl-flet ((start-file (old-path new-path body-line)
114 (setq file (patch-review-file--create
115 :old-path old-path :new-path new-path
116 :display-path (if (and new-path
117 (not (equal new-path "/dev/null")))
118 new-path
119 old-path)
120 :body-line body-line)
121 hunk nil)
122 (push file (patch-review-email-files result))))
123 (let ((i first-diff))
124 (while (< i n)
125 (let ((line (nth i body-lines)))
126 (cond
127 ;; git format-patch signature trailer terminates the diff.
128 ((and hunk (string-match patch-review--signature-re line))
129 (setq i n))
130
131 ((string-match patch-review--diff-git-re line)
132 (start-file (match-string 1 line) (match-string 2 line) i))
133
134 ((string-match patch-review--hunk-re line)
135 (unless file (start-file "" "" i))
136 (setq hunk
137 (patch-review-hunk--create
138 :header line
139 :section (match-string 5 line)
140 :body-line i
141 :old-start (string-to-number (match-string 1 line))
142 :old-count (if (match-string 2 line)
143 (string-to-number (match-string 2 line))
144 1)
145 :new-start (string-to-number (match-string 3 line))
146 :new-count (if (match-string 4 line)
147 (string-to-number (match-string 4 line))
148 1))
149 old-line (patch-review-hunk-old-start hunk)
150 new-line (patch-review-hunk-new-start hunk)
151 consumed-old 0
152 consumed-new 0)
153 (push hunk (patch-review-file-hunks file)))
154
155 ((and file (not hunk))
156 ;; Extended header lines between "diff --git" and first hunk.
157 (cond
158 ((string-match "^new file mode " line)
159 (setf (patch-review-file-is-new file) t))
160 ((string-match "^deleted file mode " line)
161 (setf (patch-review-file-is-deleted file) t))
162 ((string-match "^rename \\(from\\|to\\) " line)
163 (setf (patch-review-file-is-rename file) t))
164 ((or (string-match "^Binary files " line)
165 (string-match "^GIT binary patch" line))
166 (setf (patch-review-file-is-binary file) t))
167 ((string-match "^--- " line)
168 (setf (patch-review-file-old-path file)
169 (replace-regexp-in-string
170 "\"$" ""
171 (replace-regexp-in-string
172 "^\"?a/" "" (substring line 4)))))
173 ((string-match "^\\+\\+\\+ " line)
174 (let ((p (replace-regexp-in-string
175 "\"$" ""
176 (replace-regexp-in-string
177 "^\"?b/" "" (substring line 4)))))
178 (setf (patch-review-file-new-path file) p)
179 (unless (equal p "/dev/null")
180 (setf (patch-review-file-display-path file) p))))))
181
182 (hunk
183 (if (string-empty-p line)
184 (progn
185 (push (patch-review-line--create
186 :origin 'ctx :text "" :raw line :body-line i
187 :old-line old-line :new-line new-line)
188 (patch-review-hunk-lines hunk))
189 (setq old-line (1+ old-line)
190 new-line (1+ new-line)
191 consumed-old (1+ consumed-old)
192 consumed-new (1+ consumed-new)))
193 (let ((c (aref line 0)))
194 (cond
195 ((eq c ?+)
196 (push (patch-review-line--create
197 :origin 'add :text (substring line 1) :raw line
198 :body-line i :new-line new-line)
199 (patch-review-hunk-lines hunk))
200 (setq new-line (1+ new-line)
201 consumed-new (1+ consumed-new)))
202 ((eq c ?-)
203 (push (patch-review-line--create
204 :origin 'del :text (substring line 1) :raw line
205 :body-line i :old-line old-line)
206 (patch-review-hunk-lines hunk))
207 (setq old-line (1+ old-line)
208 consumed-old (1+ consumed-old)))
209 ((eq c ?\s)
210 (push (patch-review-line--create
211 :origin 'ctx :text (substring line 1) :raw line
212 :body-line i :old-line old-line :new-line new-line)
213 (patch-review-hunk-lines hunk))
214 (setq old-line (1+ old-line)
215 new-line (1+ new-line)
216 consumed-old (1+ consumed-old)
217 consumed-new (1+ consumed-new)))
218 ((eq c ?\\)
219 ;; "\ No newline at end of file" — context-like metadata.
220 (push (patch-review-line--create
221 :origin 'ctx :text line :raw line :body-line i)
222 (patch-review-hunk-lines hunk)))
223 (t
224 ;; Anything else ends the current hunk.
225 (setq hunk nil)))))
226 (when (and hunk
227 (>= consumed-old (patch-review-hunk-old-count hunk))
228 (>= consumed-new (patch-review-hunk-new-count hunk)))
229 (setq hunk nil))))
230 (setq i (1+ i))))))
231
232 (setf (patch-review-email-files result)
233 (nreverse (patch-review-email-files result)))
234 (dolist (f (patch-review-email-files result))
235 (setf (patch-review-file-hunks f) (nreverse (patch-review-file-hunks f)))
236 (dolist (h (patch-review-file-hunks f))
237 (setf (patch-review-hunk-lines h) (nreverse (patch-review-hunk-lines h)))))
238 result)))
239
240 ;;;; Subject heuristics (port of patch-detect.js)
241
242 (defconst patch-review--subject-tag-re
243 "^\\(?:\\s-*\\(?:re\\|aw\\|fwd?\\)\\s-*:\\s-*\\)*\\[\\([^]]*\\bPATCH\\b[^]]*\\)\\]\\s-*\\(.*\\)$"
244 "Matches subject tags like [PATCH], [PATCH 3/7], [RFC PATCH v2 0/5].")
245
246 (defun patch-review-parse-subject (subject)
247 "Parse a patch SUBJECT line.
248 Return a plist (:tag :title :prefix :version :n :m) or nil.
249 PREFIX is the tag minus version and n/m, normalized; VERSION is 1
250 when no vN marker is present; N is the index within the series
251 \(0 = cover letter) and M the series size, both nil for a bare
252 [PATCH] tag."
253 (let ((case-fold-search t))
254 (when (string-match patch-review--subject-tag-re (or subject ""))
255 (let* ((tag (string-trim (match-string 1 subject)))
256 (title (string-trim (match-string 2 subject)))
257 (has-nm (string-match "\\b\\([0-9]+\\)\\s-*/\\s-*\\([0-9]+\\)\\b" tag))
258 (n (and has-nm (string-to-number (match-string 1 tag))))
259 (m (and has-nm (string-to-number (match-string 2 tag))))
260 (nm (and has-nm (match-string 0 tag)))
261 (has-ver (string-match "\\bv[0-9]+\\b" tag))
262 (ver (and has-ver (match-string 0 tag)))
263 (prefix tag))
264 (when nm (setq prefix (string-replace nm "" prefix)))
265 (when ver (setq prefix (string-replace ver "" prefix)))
266 (setq prefix (upcase (mapconcat #'identity
267 (split-string prefix nil t) " ")))
268 (list :tag tag
269 :title title
270 :prefix prefix
271 :version (if ver (string-to-number (substring ver 1)) 1)
272 :n n
273 :m m)))))
274
275 (defun patch-review-reply-subject-p (subject)
276 "Return non-nil if SUBJECT carries a leading Re:/Aw:/Fwd: prefix."
277 (let ((case-fold-search t))
278 (string-match-p "^\\(?:\\s-*\\(?:re\\|aw\\|fwd?\\)\\s-*:\\s-*\\)+"
279 (or subject ""))))
280
281 (defun patch-review-body-looks-like-diff-p (text)
282 "Return non-nil if TEXT contains a unified diff."
283 (and text
284 (or (string-match "^diff --git " text)
285 (and (string-match "^--- \\(a/\\|/dev/null\\)" text)
286 (string-match "^\\+\\+\\+ \\(b/\\|/dev/null\\)" text))
287 (string-match "^@@ -[0-9]+\\(,[0-9]+\\)? \\+[0-9]+\\(,[0-9]+\\)? @@" text))
288 t))
289
290 (defun patch-review-patch-message-p (subject body)
291 "Decide whether a message with SUBJECT and BODY is a reviewable patch.
292 The subject tag is the primary signal; a diff in the body confirms
293 it. A cover letter (0/m) has no diff but is part of a series."
294 (let ((info (patch-review-parse-subject subject)))
295 (if info
296 (or (eq (plist-get info :n) 0)
297 (patch-review-body-looks-like-diff-p body)
298 (not (null (plist-get info :m))))
299 (patch-review-body-looks-like-diff-p body))))
300
301 (defun patch-review-same-series-p (a b)
302 "Return non-nil when parsed subjects A and B belong to one series:
303 same normalized prefix, same version, same series size."
304 (and a b
305 (equal (plist-get a :prefix) (plist-get b :prefix))
306 (eq (plist-get a :version) (plist-get b :version))
307 (eq (plist-get a :m) (plist-get b :m))))
308
309 (provide 'patch-review-parse)
310 ;;; patch-review-parse.el ends here