emacs-patch-review
Port of Thunderbird Patch Review to mu4e.
git clone git://mccd.space/emacs-patch-reviewcommit e191b62fd2d344b7b37769970983b4af25a7ca29
parent 47f6d91a65c7c73ce34f373b5b80e0e84e30377e
Author: Pi Agent <agent@pi.local>
Date: Sun, 2 Aug 2026 12:54:12 +0200
Add patch-review-parse: pure parsing of patch emails
Port of thunderbird-review-ui's diff-parse.js (body -> commit message,
diffstat, structured hunks with body-line anchors for re-quoting) and
patch-detect.js (subject-tag heuristics, diff detection, series
matching). Tests port the JS suite's expectations against the same
fixtures.
Diffstat:
2 files changed, 410 insertions(+), 0 deletions(-)
diff --git a/patch-review-parse.el b/patch-review-parse.el
@@ -0,0 +1,310 @@
+;;; patch-review-parse.el --- Parse git patch emails -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026 Marc Coquand
+
+;; 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.
+
+;;; Commentary:
+
+;; Pure parsing for git format-patch emails, ported from
+;; thunderbird-review-ui's modules/diff-parse.js and
+;; modules/patch-detect.js. No side effects.
+;;
+;; Every parsed element remembers the index of its source line in the
+;; email body (`body-line') so replies can re-quote the original text
+;; verbatim.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'subr-x)
+
+;;;; Data structures
+
+(cl-defstruct (patch-review-email (:constructor patch-review-email--create))
+ "Parsed patch email."
+ commit-message diffstat files body-lines)
+
+(cl-defstruct (patch-review-file (:constructor patch-review-file--create))
+ "One file's diff within a patch email."
+ old-path new-path display-path
+ is-binary is-new is-deleted is-rename
+ body-line hunks)
+
+(cl-defstruct (patch-review-hunk (:constructor patch-review-hunk--create))
+ "One hunk within a file diff."
+ header section body-line
+ old-start old-count new-start new-count
+ lines)
+
+(cl-defstruct (patch-review-line (:constructor patch-review-line--create))
+ "One line within a hunk; ORIGIN is `add', `del' or `ctx'."
+ origin text raw body-line old-line new-line)
+
+;;;; Regexps
+
+(defconst patch-review--hunk-re
+ "^@@ -\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? \\+\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? @@ ?\\(.*\\)$")
+
+(defconst patch-review--diff-git-re
+ "^diff --git \\(?:\"?a/\\(.*?\\)\"?\\) \\(?:\"?b/\\(.*?\\)\"?\\)$")
+
+(defconst patch-review--scissors-re "^---\\s-*$")
+
+(defconst patch-review--mbox-from-re "^From .*Mon Sep 17 00:00:00 2001$")
+
+(defconst patch-review--signature-re "^-- ?$")
+
+;;;; Patch email parsing
+
+(defun patch-review-parse-email (text)
+ "Parse TEXT, the body of a git format-patch email.
+Return a `patch-review-email' struct with commit message, diffstat
+and a structured diff."
+ (cl-block nil
+ (let* ((body-lines (split-string (or text "") "\r?\n"))
+ (n (length body-lines))
+ (first-diff (cl-loop for i from 0 below n
+ for l = (nth i body-lines)
+ when (or (string-match patch-review--diff-git-re l)
+ (string-match patch-review--hunk-re l))
+ return i))
+ (result (patch-review-email--create :body-lines (vconcat body-lines)))
+ file hunk old-line new-line consumed-old consumed-new)
+ (unless first-diff
+ (setf (patch-review-email-commit-message result) (or text ""))
+ (cl-return result))
+
+ ;; The commit message ends at the "---" scissors line when present,
+ ;; otherwise at the first diff line. Between the scissors and the
+ ;; diff sits the diffstat.
+ (let ((scissors (cl-loop for i from 0 below first-diff
+ when (string-match patch-review--scissors-re
+ (nth i body-lines))
+ return i))
+ (message-start 0)
+ message-end)
+ (setq message-end (or scissors first-diff))
+ ;; git format-patch prepends an mbox-style header block to the body
+ ;; ("From <sha> Mon Sep 17 ...", From:, Date:, Subject:, then a
+ ;; blank line). Strip it to keep only the commit message text.
+ (when (and (> message-end 0)
+ (string-match patch-review--mbox-from-re (car body-lines)))
+ (let ((blank 1))
+ (while (and (< blank message-end)
+ (not (string-empty-p (nth blank body-lines))))
+ (setq blank (1+ blank)))
+ (setq message-start (min (1+ blank) message-end))))
+ (setf (patch-review-email-commit-message result)
+ (string-trim
+ (mapconcat #'identity
+ (cl-subseq body-lines message-start message-end)
+ "\n")))
+ (when scissors
+ (setf (patch-review-email-diffstat result)
+ (string-trim
+ (mapconcat #'identity
+ (cl-subseq body-lines (1+ scissors) first-diff)
+ "\n")))))
+
+ (cl-flet ((start-file (old-path new-path body-line)
+ (setq file (patch-review-file--create
+ :old-path old-path :new-path new-path
+ :display-path (if (and new-path
+ (not (equal new-path "/dev/null")))
+ new-path
+ old-path)
+ :body-line body-line)
+ hunk nil)
+ (push file (patch-review-email-files result))))
+ (let ((i first-diff))
+ (while (< i n)
+ (let ((line (nth i body-lines)))
+ (cond
+ ;; git format-patch signature trailer terminates the diff.
+ ((and hunk (string-match patch-review--signature-re line))
+ (setq i n))
+
+ ((string-match patch-review--diff-git-re line)
+ (start-file (match-string 1 line) (match-string 2 line) i))
+
+ ((string-match patch-review--hunk-re line)
+ (unless file (start-file "" "" i))
+ (setq hunk
+ (patch-review-hunk--create
+ :header line
+ :section (match-string 5 line)
+ :body-line i
+ :old-start (string-to-number (match-string 1 line))
+ :old-count (if (match-string 2 line)
+ (string-to-number (match-string 2 line))
+ 1)
+ :new-start (string-to-number (match-string 3 line))
+ :new-count (if (match-string 4 line)
+ (string-to-number (match-string 4 line))
+ 1))
+ old-line (patch-review-hunk-old-start hunk)
+ new-line (patch-review-hunk-new-start hunk)
+ consumed-old 0
+ consumed-new 0)
+ (push hunk (patch-review-file-hunks file)))
+
+ ((and file (not hunk))
+ ;; Extended header lines between "diff --git" and first hunk.
+ (cond
+ ((string-match "^new file mode " line)
+ (setf (patch-review-file-is-new file) t))
+ ((string-match "^deleted file mode " line)
+ (setf (patch-review-file-is-deleted file) t))
+ ((string-match "^rename \\(from\\|to\\) " line)
+ (setf (patch-review-file-is-rename file) t))
+ ((or (string-match "^Binary files " line)
+ (string-match "^GIT binary patch" line))
+ (setf (patch-review-file-is-binary file) t))
+ ((string-match "^--- " line)
+ (setf (patch-review-file-old-path file)
+ (replace-regexp-in-string
+ "\"$" ""
+ (replace-regexp-in-string
+ "^\"?a/" "" (substring line 4)))))
+ ((string-match "^\\+\\+\\+ " line)
+ (let ((p (replace-regexp-in-string
+ "\"$" ""
+ (replace-regexp-in-string
+ "^\"?b/" "" (substring line 4)))))
+ (setf (patch-review-file-new-path file) p)
+ (unless (equal p "/dev/null")
+ (setf (patch-review-file-display-path file) p))))))
+
+ (hunk
+ (if (string-empty-p line)
+ (progn
+ (push (patch-review-line--create
+ :origin 'ctx :text "" :raw line :body-line i
+ :old-line old-line :new-line new-line)
+ (patch-review-hunk-lines hunk))
+ (setq old-line (1+ old-line)
+ new-line (1+ new-line)
+ consumed-old (1+ consumed-old)
+ consumed-new (1+ consumed-new)))
+ (let ((c (aref line 0)))
+ (cond
+ ((eq c ?+)
+ (push (patch-review-line--create
+ :origin 'add :text (substring line 1) :raw line
+ :body-line i :new-line new-line)
+ (patch-review-hunk-lines hunk))
+ (setq new-line (1+ new-line)
+ consumed-new (1+ consumed-new)))
+ ((eq c ?-)
+ (push (patch-review-line--create
+ :origin 'del :text (substring line 1) :raw line
+ :body-line i :old-line old-line)
+ (patch-review-hunk-lines hunk))
+ (setq old-line (1+ old-line)
+ consumed-old (1+ consumed-old)))
+ ((eq c ?\s)
+ (push (patch-review-line--create
+ :origin 'ctx :text (substring line 1) :raw line
+ :body-line i :old-line old-line :new-line new-line)
+ (patch-review-hunk-lines hunk))
+ (setq old-line (1+ old-line)
+ new-line (1+ new-line)
+ consumed-old (1+ consumed-old)
+ consumed-new (1+ consumed-new)))
+ ((eq c ?\\)
+ ;; "\ No newline at end of file" — context-like metadata.
+ (push (patch-review-line--create
+ :origin 'ctx :text line :raw line :body-line i)
+ (patch-review-hunk-lines hunk)))
+ (t
+ ;; Anything else ends the current hunk.
+ (setq hunk nil)))))
+ (when (and hunk
+ (>= consumed-old (patch-review-hunk-old-count hunk))
+ (>= consumed-new (patch-review-hunk-new-count hunk)))
+ (setq hunk nil))))
+ (setq i (1+ i))))))
+
+ (setf (patch-review-email-files result)
+ (nreverse (patch-review-email-files result)))
+ (dolist (f (patch-review-email-files result))
+ (setf (patch-review-file-hunks f) (nreverse (patch-review-file-hunks f)))
+ (dolist (h (patch-review-file-hunks f))
+ (setf (patch-review-hunk-lines h) (nreverse (patch-review-hunk-lines h)))))
+ result)))
+
+;;;; Subject heuristics (port of patch-detect.js)
+
+(defconst patch-review--subject-tag-re
+ "^\\(?:\\s-*\\(?:re\\|aw\\|fwd?\\)\\s-*:\\s-*\\)*\\[\\([^]]*\\bPATCH\\b[^]]*\\)\\]\\s-*\\(.*\\)$"
+ "Matches subject tags like [PATCH], [PATCH 3/7], [RFC PATCH v2 0/5].")
+
+(defun patch-review-parse-subject (subject)
+ "Parse a patch SUBJECT line.
+Return a plist (:tag :title :prefix :version :n :m) or nil.
+PREFIX is the tag minus version and n/m, normalized; VERSION is 1
+when no vN marker is present; N is the index within the series
+\(0 = cover letter) and M the series size, both nil for a bare
+[PATCH] tag."
+ (let ((case-fold-search t))
+ (when (string-match patch-review--subject-tag-re (or subject ""))
+ (let* ((tag (string-trim (match-string 1 subject)))
+ (title (string-trim (match-string 2 subject)))
+ (has-nm (string-match "\\b\\([0-9]+\\)\\s-*/\\s-*\\([0-9]+\\)\\b" tag))
+ (n (and has-nm (string-to-number (match-string 1 tag))))
+ (m (and has-nm (string-to-number (match-string 2 tag))))
+ (nm (and has-nm (match-string 0 tag)))
+ (has-ver (string-match "\\bv[0-9]+\\b" tag))
+ (ver (and has-ver (match-string 0 tag)))
+ (prefix tag))
+ (when nm (setq prefix (string-replace nm "" prefix)))
+ (when ver (setq prefix (string-replace ver "" prefix)))
+ (setq prefix (upcase (mapconcat #'identity
+ (split-string prefix nil t) " ")))
+ (list :tag tag
+ :title title
+ :prefix prefix
+ :version (if ver (string-to-number (substring ver 1)) 1)
+ :n n
+ :m m)))))
+
+(defun patch-review-reply-subject-p (subject)
+ "Return non-nil if SUBJECT carries a leading Re:/Aw:/Fwd: prefix."
+ (let ((case-fold-search t))
+ (string-match-p "^\\(?:\\s-*\\(?:re\\|aw\\|fwd?\\)\\s-*:\\s-*\\)+"
+ (or subject ""))))
+
+(defun patch-review-body-looks-like-diff-p (text)
+ "Return non-nil if TEXT contains a unified diff."
+ (and text
+ (or (string-match "^diff --git " text)
+ (and (string-match "^--- \\(a/\\|/dev/null\\)" text)
+ (string-match "^\\+\\+\\+ \\(b/\\|/dev/null\\)" text))
+ (string-match "^@@ -[0-9]+\\(,[0-9]+\\)? \\+[0-9]+\\(,[0-9]+\\)? @@" text))
+ t))
+
+(defun patch-review-patch-message-p (subject body)
+ "Decide whether a message with SUBJECT and BODY is a reviewable patch.
+The subject tag is the primary signal; a diff in the body confirms
+it. A cover letter (0/m) has no diff but is part of a series."
+ (let ((info (patch-review-parse-subject subject)))
+ (if info
+ (or (eq (plist-get info :n) 0)
+ (patch-review-body-looks-like-diff-p body)
+ (not (null (plist-get info :m))))
+ (patch-review-body-looks-like-diff-p body))))
+
+(defun patch-review-same-series-p (a b)
+ "Return non-nil when parsed subjects A and B belong to one series:
+same normalized prefix, same version, same series size."
+ (and a b
+ (equal (plist-get a :prefix) (plist-get b :prefix))
+ (eq (plist-get a :version) (plist-get b :version))
+ (eq (plist-get a :m) (plist-get b :m))))
+
+(provide 'patch-review-parse)
+;;; patch-review-parse.el ends here
diff --git a/tests/patch-review-test.el b/tests/patch-review-test.el
@@ -1,6 +1,7 @@
;;; patch-review-test.el --- ERT suite -*- lexical-binding: t -*-
(require 'ert)
+(require 'patch-review-parse)
(defun patch-review-test-fixture (name)
"Return the contents of fixture NAME."
@@ -16,5 +17,104 @@
"patch1.eml"))
(should (stringp (patch-review-test-fixture f)))))
+;;;; Parsing (ports of the diff-parse.js checks)
+
+(ert-deftest patch-review-test-parse-patch1 ()
+ (let* ((p (patch-review-parse-email (patch-review-test-fixture "patch1.body")))
+ (file (car (patch-review-email-files p)))
+ (hunk (car (patch-review-file-hunks file))))
+ (should (= 1 (length (patch-review-email-files p))))
+ (should (equal "src/socket.c" (patch-review-file-display-path file)))
+ (should (string-prefix-p "Reject negative descriptors"
+ (patch-review-email-commit-message p)))
+ (should (string-match-p "1 file changed" (patch-review-email-diffstat p)))
+ (should (= 1 (length (patch-review-file-hunks file))))
+ (should (= 15 (patch-review-hunk-old-count hunk)))
+ (should (= 20 (patch-review-hunk-new-count hunk)))
+ (let ((first-add (cl-find 'add (patch-review-hunk-lines hunk)
+ :key #'patch-review-line-origin)))
+ (should (equal "#include <errno.h>" (patch-review-line-text first-add)))
+ (should (= 2 (patch-review-line-new-line first-add)))
+ (should (null (patch-review-line-old-line first-add))))
+ (let ((first-del (cl-find 'del (patch-review-hunk-lines hunk)
+ :key #'patch-review-line-origin)))
+ (should (= 5 (patch-review-line-old-line first-del)))
+ (should (null (patch-review-line-new-line first-del))))
+ ;; Raw lines must round-trip exactly for quoting in replies.
+ (let* ((lines (patch-review-hunk-lines hunk))
+ (start (patch-review-line-body-line (car lines)))
+ (body-lines (patch-review-email-body-lines p))
+ (slice (cl-loop for i from start below (+ start (length lines))
+ collect (aref body-lines i))))
+ (should (equal slice (mapcar #'patch-review-line-raw lines))))))
+
+(ert-deftest patch-review-test-parse-patch2-new-file ()
+ (let* ((p (patch-review-parse-email (patch-review-test-fixture "patch2.body")))
+ (file (car (patch-review-email-files p))))
+ (should (patch-review-file-is-new file))
+ (should (equal "src/log.c" (patch-review-file-display-path file)))
+ (should (cl-every (lambda (l) (eq 'add (patch-review-line-origin l)))
+ (patch-review-hunk-lines
+ (car (patch-review-file-hunks file)))))))
+
+(ert-deftest patch-review-test-parse-patch3-binary ()
+ (let* ((p (patch-review-parse-email (patch-review-test-fixture "patch3.body")))
+ (file (car (patch-review-email-files p))))
+ (should (patch-review-file-is-binary file))
+ (should (null (patch-review-file-hunks file)))))
+
+(ert-deftest patch-review-test-parse-no-diff ()
+ (let ((p (patch-review-parse-email "just a message\nwith two lines")))
+ (should (null (patch-review-email-files p)))
+ (should (string-match-p "just a message"
+ (patch-review-email-commit-message p)))))
+
+;;;; Subject heuristics (ports of the patch-detect.js checks)
+
+(ert-deftest patch-review-test-parse-subject ()
+ (let ((info (patch-review-parse-subject "[PATCH 1/2] x")))
+ (should (equal "PATCH" (plist-get info :prefix)))
+ (should (= 1 (plist-get info :version)))
+ (should (= 1 (plist-get info :n)))
+ (should (= 2 (plist-get info :m)))
+ (should (equal "x" (plist-get info :title))))
+ (let ((info (patch-review-parse-subject "[RFC PATCH v2 0/5] y")))
+ (should (equal "RFC PATCH" (plist-get info :prefix)))
+ (should (= 2 (plist-get info :version)))
+ (should (= 0 (plist-get info :n)))
+ (should (= 5 (plist-get info :m))))
+ (let ((info (patch-review-parse-subject "[PATCH net-next v3 1/2] z")))
+ (should (equal "PATCH NET-NEXT" (plist-get info :prefix)))
+ (should (= 3 (plist-get info :version))))
+ (let ((info (patch-review-parse-subject "Re: [PATCH] w")))
+ (should info)
+ (should (null (plist-get info :n)))
+ (should (null (plist-get info :m))))
+ (should (null (patch-review-parse-subject "not a patch"))))
+
+(ert-deftest patch-review-test-detect ()
+ (should (patch-review-body-looks-like-diff-p
+ (patch-review-test-fixture "patch1.body")))
+ (should-not (patch-review-body-looks-like-diff-p "just some prose"))
+ (should (patch-review-patch-message-p
+ "[PATCH 1/2] x" (patch-review-test-fixture "patch1.body")))
+ (should (patch-review-patch-message-p
+ "a fix" (patch-review-test-fixture "patch1.body")))
+ ;; Cover letter: 0/m tag, no diff, still part of a series.
+ (should (patch-review-patch-message-p
+ "[PATCH 0/3] cover" (patch-review-test-fixture "cover.body")))
+ (should-not (patch-review-patch-message-p "a fix" "prose only")))
+
+(ert-deftest patch-review-test-same-series ()
+ (should (patch-review-same-series-p
+ (patch-review-parse-subject "[PATCH v2 1/3] a")
+ (patch-review-parse-subject "[PATCH v2 3/3] c")))
+ (should-not (patch-review-same-series-p
+ (patch-review-parse-subject "[PATCH 1/3] a")
+ (patch-review-parse-subject "[PATCH v2 3/3] c")))
+ (should-not (patch-review-same-series-p
+ (patch-review-parse-subject "[PATCH 1/3] a")
+ (patch-review-parse-subject "[PATCH 1/4] b"))))
+
(provide 'patch-review-test)
;;; patch-review-test.el ends here