emacs-patch-review
Port of Thunderbird Patch Review to mu4e.
git clone git://mccd.space/emacs-patch-reviewcommit f9d6e8ca8bc3cf51a1d67330b0e5bd0a9e60f905
parent 6df1b7cd983a55858094875451578a238634c0a3
Author: Pi Agent <agent@pi.local>
Date: Mon, 3 Aug 2026 10:03:13 +0200
Add patch-review-git: apply and applicability probe
Port of patchHost's git logic. The probe runs 'git am --3way' in a
throwaway --detach worktree of the user's repo — git am's own output
gives the tri-state ("No changes -- Patch already applied", exit 0,
exit 128) without touching the user's tree; probes always suppress user
hooks via an empty core.hooksPath. Apply runs hooks by default (a
deliberate act), refuses while a previous am session is unfinished, and
aborts back to a clean state on conflict. concat-mboxes encodes the
lesson that multi-file checks must be one mbox to verify sequentially.
Diffstat:
2 files changed, 310 insertions(+), 0 deletions(-)
diff --git a/patch-review-git.el b/patch-review-git.el
@@ -0,0 +1,180 @@
+;;; patch-review-git.el --- git integration for patch-review -*- 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:
+
+;; git shell-out for applying patches and probing whether they apply.
+;; Port of thunderbird-review-ui's api/patchHost/implementation.js.
+;;
+;; The applicability probe runs `git am' in a throwaway --detach
+;; worktree of the user's repository, so the honest answer comes from
+;; git am itself without ever dirtying the user's tree. Probes point
+;; core.hooksPath at an empty directory: no human act authorized the
+;; user's hooks to run against unreviewed patch content. Applying is a
+;; deliberate act and runs the user's hooks unless suppressed.
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defcustom patch-review-git-executable "git"
+ "Path to the git executable."
+ :type 'string
+ :group 'patch-review)
+
+(defun patch-review-git--run (dir &rest args)
+ "Run git with ARGS in DIR. Return (EXIT-CODE . OUTPUT)."
+ (let ((default-directory (file-name-as-directory (expand-file-name dir))))
+ (with-temp-buffer
+ (cons (apply #'call-process patch-review-git-executable nil t nil args)
+ (buffer-string)))))
+
+(defun patch-review-git-describe (dir)
+ "Return a short description of repository DIR, or nil if not a repo."
+ (pcase-let ((`(,exit . ,out)
+ (patch-review-git--run dir "rev-parse" "--is-inside-work-tree")))
+ (when (and (= exit 0) (string-match-p "true" out))
+ (let ((toplevel (string-trim
+ (cdr (patch-review-git--run
+ dir "rev-parse" "--show-toplevel"))))
+ (head (string-trim
+ (cdr (patch-review-git--run
+ dir "rev-parse" "--short" "HEAD")))))
+ (if (string-empty-p head)
+ toplevel
+ (format "%s (%s)" toplevel head))))))
+
+(defun patch-review-git-dirty-p (dir)
+ "Return t if DIR has staged or unstaged changes, nil if clean,
+`bad-head' if HEAD is invalid. Untracked files do not count,
+matching git am's require_clean_work_tree."
+ (let ((exit (car (patch-review-git--run
+ dir "diff-index" "--quiet" "--ignore-submodules" "HEAD"))))
+ (cond ((= exit 0) nil)
+ ((= exit 1) t)
+ (t 'bad-head))))
+
+(defun patch-review-git-am-in-progress-p (dir)
+ "Return non-nil if a previous `git am' session is unfinished in DIR.
+An unfinished am leaves a rebase-apply/ directory inside the git dir."
+ (pcase-let ((`(,exit . ,out)
+ (patch-review-git--run dir "rev-parse" "--absolute-git-dir")))
+ (and (= exit 0)
+ (file-directory-p
+ (expand-file-name "rebase-apply" (string-trim out))))))
+
+(defmacro patch-review-git--with-empty-hooks (var &rest body)
+ "Evaluate BODY with VAR bound to an empty directory for core.hooksPath.
+An empty existing directory suppresses hooks portably. The
+directory is removed afterwards."
+ (declare (indent 1))
+ `(let ((,var (make-temp-file "patch-review-hooks" t)))
+ (unwind-protect
+ (progn ,@body)
+ (delete-directory ,var t))))
+
+(defun patch-review-git--worktree-probe (dir mbox)
+ "Run `git am' against MBOX in a throwaway --detach worktree of DIR.
+Return (STATUS . OUTPUT) with STATUS `applied', `applicable' or
+`conflict'."
+ (patch-review-git--with-empty-hooks hooks
+ (let ((tmp (make-temp-file "patch-review-wt" t)))
+ (unwind-protect
+ (pcase-let ((`(,add-exit . ,add-out)
+ (patch-review-git--run
+ dir "-c" (concat "core.hooksPath=" hooks)
+ "worktree" "add" "--detach" tmp "HEAD")))
+ (if (/= add-exit 0)
+ (cons 'conflict
+ (format "Could not create probe worktree:\n%s" add-out))
+ (pcase-let ((`(,exit . ,out)
+ (patch-review-git--run
+ tmp
+ "-c" "advice.mergeConflict=false"
+ "-c" "advice.amWorkDir=false"
+ "-c" (concat "core.hooksPath=" hooks)
+ "am" "--3way" mbox)))
+ (cond
+ ;; git am --3way's own tri-state signal: "No changes --
+ ;; Patch already applied", exit 0, or exit 128.
+ ((string-match-p "[Pp]atch already applied" out)
+ (cons 'applied out))
+ ((= exit 0) (cons 'applicable out))
+ (t (cons 'conflict out))))))
+ (patch-review-git--run dir "-c" (concat "core.hooksPath=" hooks)
+ "worktree" "remove" "--force" tmp)))))
+
+(defun patch-review-git-check (dir mbox)
+ "Probe whether MBOX (a single concatenated mbox) applies to DIR.
+Return (STATUS . DETAIL) where STATUS is one of `dirty',
+`am-in-progress', `applied', `applicable' or `conflict'."
+ (cond
+ ((eq t (patch-review-git-dirty-p dir))
+ (cons 'dirty
+ (cdr (patch-review-git--run
+ dir "status" "-s" "--untracked-files=no"))))
+ ((eq 'bad-head (patch-review-git-dirty-p dir))
+ (cons 'conflict "Repository HEAD is invalid (no commits?).\n"))
+ ((patch-review-git-am-in-progress-p dir)
+ (cons 'am-in-progress
+ "A previous `git am' session is unfinished in this repository.\n"))
+ (t
+ (patch-review-git--worktree-probe dir mbox))))
+
+(defun patch-review-git-apply (dir mbox &optional no-hooks)
+ "Apply MBOX to DIR with `git am'.
+Return (STATUS . OUTPUT) with STATUS `applied', `conflict' or
+`am-in-progress'. On conflict, `git am --abort' runs so the
+repository returns to its previous state.
+
+Applying is a deliberate act and runs the user's git hooks; with
+NO-HOOKS non-nil they are suppressed via an empty core.hooksPath."
+ (if (patch-review-git-am-in-progress-p dir)
+ (cons 'am-in-progress
+ (concat "A previous `git am' session is already in progress "
+ "in this repository.\n"
+ "Resolve it yourself — git am --continue, --skip, or "
+ "--abort — then apply again.\n"))
+ (patch-review-git--with-empty-hooks hooks
+ (let ((args (append (list "-c" "advice.mergeConflict=false"
+ "-c" "advice.amWorkDir=false")
+ (when no-hooks
+ (list "-c" (concat "core.hooksPath=" hooks)))
+ (list "am" "--3way" mbox))))
+ (pcase-let ((`(,exit . ,out)
+ (apply #'patch-review-git--run dir args)))
+ (if (= exit 0)
+ (cons 'applied out)
+ (patch-review-git--run dir
+ "-c" "advice.mergeConflict=false"
+ "-c" "advice.amWorkDir=false"
+ "-c" (concat "core.hooksPath=" hooks)
+ "am" "--abort")
+ (cons 'conflict
+ (concat out
+ "\n(git am --abort ran; the repository is back "
+ "to its previous state)\n"))))))))
+
+(defun patch-review-git-concat-mboxes (files)
+ "Concatenate mbox FILES into one temporary file; return its path.
+Multiple patch files checked independently against the original
+tree fail spuriously when a sequel depends on an earlier patch's
+context; one concatenated mbox verifies sequentially, matching
+`git am'."
+ (let ((tmp (make-temp-file "patch-review-series")))
+ (with-temp-file tmp
+ (dolist (f files)
+ (insert-file-contents f)
+ (goto-char (point-max))
+ (unless (or (bobp) (eq (char-before) ?\n))
+ (insert "\n"))))
+ tmp))
+
+(provide 'patch-review-git)
+;;; patch-review-git.el ends here
diff --git a/tests/patch-review-test.el b/tests/patch-review-test.el
@@ -3,6 +3,7 @@
(require 'ert)
(require 'patch-review-parse)
(require 'patch-review-reply)
+(require 'patch-review-git)
(defun patch-review-test-fixture (name)
"Return the contents of fixture NAME."
@@ -166,5 +167,134 @@
(ert-deftest patch-review-test-reply-empty ()
(should (equal "" (patch-review-reply-format nil nil))))
+;;;; git integration
+
+(defconst patch-review-test--base-content
+ "#include <stdio.h>\n\nint open_socket(int fd)\n{\n\tif (fd < 0)\n\t\treturn -1;\n\tprintf(\"opening %d\\n\", fd);\n\treturn fd;\n}\n\nint close_socket(int fd)\n{\n\tprintf(\"closing %d\\n\", fd);\n\treturn 0;\n}\n")
+
+(defconst patch-review-test--new-content
+ "#include <stdio.h>\n#include <errno.h>\n\nint open_socket(int fd)\n{\n\tif (fd < 0) {\n\t\terrno = EBADF;\n\t\treturn -1;\n\t}\n\tprintf(\"opening %d\\n\", fd);\n\treturn fd;\n}\n\nint close_socket(int fd)\n{\n\tif (fd < 0)\n\t\treturn -1;\n\tprintf(\"closing %d\\n\", fd);\n\treturn 0;\n}\n")
+
+(defun patch-review-test--write (dir path text)
+ (let ((file (expand-file-name path dir)))
+ (make-directory (file-name-directory file) t)
+ (write-region text nil file nil 'silent)))
+
+(defun patch-review-test--git (dir &rest args)
+ (let ((result (apply #'patch-review-git--run dir args)))
+ (should (= 0 (car result)))
+ (cdr result)))
+
+(defmacro patch-review-test--with-repo (dir &rest body)
+ "Create a throwaway git repo, bind DIR, evaluate BODY."
+ (declare (indent 1))
+ `(let ((,dir (make-temp-file "patch-review-repo" t))
+ (process-environment
+ (append '("GIT_AUTHOR_NAME=Test"
+ "GIT_AUTHOR_EMAIL=test@example.org"
+ "GIT_COMMITTER_NAME=Test"
+ "GIT_COMMITTER_EMAIL=test@example.org")
+ process-environment)))
+ (unwind-protect
+ (progn
+ (patch-review-test--git ,dir "init" "-q" "-b" "main")
+ ,@body)
+ (delete-directory ,dir t))))
+
+(defun patch-review-test--make-patch (dir)
+ "Build DIR's history: base commit, patch commit; reset to base.
+Return the path of a format-patch file for the patch commit."
+ (patch-review-test--write dir "src/socket.c"
+ patch-review-test--base-content)
+ (patch-review-test--git dir "add" ".")
+ (patch-review-test--git dir "commit" "-q" "-m" "base socket code")
+ (patch-review-test--write dir "src/socket.c"
+ patch-review-test--new-content)
+ (patch-review-test--git dir "add" ".")
+ (patch-review-test--git dir "commit" "-q" "-m"
+ "Reject negative descriptors in socket paths")
+ (let ((mbox (expand-file-name "patch.mbox" dir)))
+ (write-region (patch-review-test--git dir "format-patch" "-1" "--stdout")
+ nil mbox nil 'silent)
+ (patch-review-test--git dir "reset" "-q" "--hard" "HEAD~1")
+ mbox))
+
+(ert-deftest patch-review-test-git-describe-and-dirty ()
+ (patch-review-test--with-repo dir
+ (patch-review-test--write dir "src/socket.c"
+ patch-review-test--base-content)
+ (patch-review-test--git dir "add" ".")
+ (patch-review-test--git dir "commit" "-q" "-m" "base")
+ (should (string-match-p (regexp-quote dir)
+ (patch-review-git-describe dir)))
+ (should-not (patch-review-git-dirty-p dir))
+ (patch-review-test--write dir "src/socket.c"
+ patch-review-test--new-content)
+ (should (eq t (patch-review-git-dirty-p dir)))))
+
+(ert-deftest patch-review-test-git-check-applicable ()
+ (patch-review-test--with-repo dir
+ (let ((mbox (patch-review-test--make-patch dir)))
+ (should (eq 'applicable (car (patch-review-git-check dir mbox)))))))
+
+(ert-deftest patch-review-test-git-apply-then-applied ()
+ (patch-review-test--with-repo dir
+ (let ((mbox (patch-review-test--make-patch dir)))
+ (should (eq 'applied (car (patch-review-git-apply dir mbox))))
+ (should (equal patch-review-test--new-content
+ (with-temp-buffer
+ (insert-file-contents
+ (expand-file-name "src/socket.c" dir))
+ (buffer-string))))
+ ;; Once applied, the probe must report it.
+ (should (eq 'applied (car (patch-review-git-check dir mbox)))))))
+
+(ert-deftest patch-review-test-git-check-conflict ()
+ (patch-review-test--with-repo dir
+ (let ((mbox (patch-review-test--make-patch dir)))
+ ;; Commit a change that breaks the patch's context.
+ (patch-review-test--write
+ dir "src/socket.c"
+ (string-replace "if (fd < 0)" "if (fd < -1)"
+ patch-review-test--base-content))
+ (patch-review-test--git dir "add" ".")
+ (patch-review-test--git dir "commit" "-q" "-m" "diverge")
+ (should (eq 'conflict (car (patch-review-git-check dir mbox)))))))
+
+(ert-deftest patch-review-test-git-check-dirty ()
+ (patch-review-test--with-repo dir
+ (let ((mbox (patch-review-test--make-patch dir)))
+ (patch-review-test--write dir "src/socket.c"
+ patch-review-test--new-content)
+ (should (eq 'dirty (car (patch-review-git-check dir mbox)))))))
+
+(ert-deftest patch-review-test-git-am-in-progress-guard ()
+ (patch-review-test--with-repo dir
+ (let ((mbox (patch-review-test--make-patch dir)))
+ (should-not (patch-review-git-am-in-progress-p dir))
+ (make-directory (expand-file-name ".git/rebase-apply" dir) t)
+ (should (patch-review-git-am-in-progress-p dir))
+ (should (eq 'am-in-progress (car (patch-review-git-apply dir mbox))))
+ ;; The repository must be untouched.
+ (should (string-match-p "base socket code"
+ (patch-review-test--git
+ dir "log" "-1" "--format=%s"))))))
+
+(ert-deftest patch-review-test-git-concat-mboxes ()
+ (let ((a (make-temp-file "pr-a")) (b (make-temp-file "pr-b")))
+ (unwind-protect
+ (progn
+ (write-region "first-no-eol" nil a nil 'silent)
+ (write-region "second\n" nil b nil 'silent)
+ (let ((cat (patch-review-git-concat-mboxes (list a b))))
+ (unwind-protect
+ (should (equal "first-no-eol\nsecond\n"
+ (with-temp-buffer
+ (insert-file-contents cat)
+ (buffer-string))))
+ (delete-file cat))))
+ (delete-file a)
+ (delete-file b))))
+
(provide 'patch-review-test)
;;; patch-review-test.el ends here