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-git.el (7921B)
1 ;;; patch-review-git.el --- git integration for patch-review -*- 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 ;; git shell-out for applying patches and probing whether they apply.
13 ;; Port of thunderbird-review-ui's api/patchHost/implementation.js.
14 ;;
15 ;; The applicability probe runs `git am' in a throwaway --detach
16 ;; worktree of the user's repository, so the honest answer comes from
17 ;; git am itself without ever dirtying the user's tree. Probes point
18 ;; core.hooksPath at an empty directory: no human act authorized the
19 ;; user's hooks to run against unreviewed patch content. Applying is a
20 ;; deliberate act and runs the user's hooks unless suppressed.
21
22 ;;; Code:
23
24 (require 'cl-lib)
25
26 (defcustom patch-review-git-executable "git"
27 "Path to the git executable."
28 :type 'string
29 :group 'patch-review)
30
31 (defun patch-review-git--run (dir &rest args)
32 "Run git with ARGS in DIR. Return (EXIT-CODE . OUTPUT)."
33 (let ((default-directory (file-name-as-directory (expand-file-name dir))))
34 (with-temp-buffer
35 (cons (apply #'call-process patch-review-git-executable nil t nil args)
36 (buffer-string)))))
37
38 (defun patch-review-git-describe (dir)
39 "Return a short description of repository DIR, or nil if not a repo."
40 (pcase-let ((`(,exit . ,out)
41 (patch-review-git--run dir "rev-parse" "--is-inside-work-tree")))
42 (when (and (= exit 0) (string-match-p "true" out))
43 (let ((toplevel (string-trim
44 (cdr (patch-review-git--run
45 dir "rev-parse" "--show-toplevel"))))
46 (head (string-trim
47 (cdr (patch-review-git--run
48 dir "rev-parse" "--short" "HEAD")))))
49 (if (string-empty-p head)
50 toplevel
51 (format "%s (%s)" toplevel head))))))
52
53 (defun patch-review-git-dirty-p (dir)
54 "Return t if DIR has staged or unstaged changes, nil if clean,
55 `bad-head' if HEAD is invalid. Untracked files do not count,
56 matching git am's require_clean_work_tree."
57 (let ((exit (car (patch-review-git--run
58 dir "diff-index" "--quiet" "--ignore-submodules" "HEAD"))))
59 (cond ((= exit 0) nil)
60 ((= exit 1) t)
61 (t 'bad-head))))
62
63 (defun patch-review-git-am-in-progress-p (dir)
64 "Return non-nil if a previous `git am' session is unfinished in DIR.
65 An unfinished am leaves a rebase-apply/ directory inside the git dir."
66 (pcase-let ((`(,exit . ,out)
67 (patch-review-git--run dir "rev-parse" "--absolute-git-dir")))
68 (and (= exit 0)
69 (file-directory-p
70 (expand-file-name "rebase-apply" (string-trim out))))))
71
72 (defmacro patch-review-git--with-empty-hooks (var &rest body)
73 "Evaluate BODY with VAR bound to an empty directory for core.hooksPath.
74 An empty existing directory suppresses hooks portably. The
75 directory is removed afterwards."
76 (declare (indent 1))
77 `(let ((,var (make-temp-file "patch-review-hooks" t)))
78 (unwind-protect
79 (progn ,@body)
80 (delete-directory ,var t))))
81
82 (defun patch-review-git--worktree-probe (dir mbox)
83 "Run `git am' against MBOX in a throwaway --detach worktree of DIR.
84 Return (STATUS . OUTPUT) with STATUS `applied', `applicable' or
85 `conflict'."
86 (patch-review-git--with-empty-hooks hooks
87 (let ((tmp (make-temp-file "patch-review-wt" t)))
88 (unwind-protect
89 (pcase-let ((`(,add-exit . ,add-out)
90 (patch-review-git--run
91 dir "-c" (concat "core.hooksPath=" hooks)
92 "worktree" "add" "--detach" tmp "HEAD")))
93 (if (/= add-exit 0)
94 (cons 'conflict
95 (format "Could not create probe worktree:\n%s" add-out))
96 (pcase-let ((`(,exit . ,out)
97 (patch-review-git--run
98 tmp
99 "-c" "advice.mergeConflict=false"
100 "-c" "advice.amWorkDir=false"
101 "-c" (concat "core.hooksPath=" hooks)
102 "am" "--3way" mbox)))
103 (cond
104 ;; git am --3way's own tri-state signal: "No changes --
105 ;; Patch already applied", exit 0, or exit 128.
106 ((string-match-p "[Pp]atch already applied" out)
107 (cons 'applied out))
108 ((= exit 0) (cons 'applicable out))
109 (t (cons 'conflict out))))))
110 (patch-review-git--run dir "-c" (concat "core.hooksPath=" hooks)
111 "worktree" "remove" "--force" tmp)))))
112
113 (defun patch-review-git-check (dir mbox)
114 "Probe whether MBOX (a single concatenated mbox) applies to DIR.
115 Return (STATUS . DETAIL) where STATUS is one of `dirty',
116 `am-in-progress', `applied', `applicable' or `conflict'."
117 (cond
118 ((eq t (patch-review-git-dirty-p dir))
119 (cons 'dirty
120 (cdr (patch-review-git--run
121 dir "status" "-s" "--untracked-files=no"))))
122 ((eq 'bad-head (patch-review-git-dirty-p dir))
123 (cons 'conflict "Repository HEAD is invalid (no commits?).\n"))
124 ((patch-review-git-am-in-progress-p dir)
125 (cons 'am-in-progress
126 "A previous `git am' session is unfinished in this repository.\n"))
127 (t
128 (patch-review-git--worktree-probe dir mbox))))
129
130 (defun patch-review-git-apply (dir mbox &optional no-hooks)
131 "Apply MBOX to DIR with `git am'.
132 Return (STATUS . OUTPUT) with STATUS `applied', `conflict' or
133 `am-in-progress'. On conflict, `git am --abort' runs so the
134 repository returns to its previous state.
135
136 Applying is a deliberate act and runs the user's git hooks; with
137 NO-HOOKS non-nil they are suppressed via an empty core.hooksPath."
138 (if (patch-review-git-am-in-progress-p dir)
139 (cons 'am-in-progress
140 (concat "A previous `git am' session is already in progress "
141 "in this repository.\n"
142 "Resolve it yourself — git am --continue, --skip, or "
143 "--abort — then apply again.\n"))
144 (patch-review-git--with-empty-hooks hooks
145 (let ((args (append (list "-c" "advice.mergeConflict=false"
146 "-c" "advice.amWorkDir=false")
147 (when no-hooks
148 (list "-c" (concat "core.hooksPath=" hooks)))
149 (list "am" "--3way" mbox))))
150 (pcase-let ((`(,exit . ,out)
151 (apply #'patch-review-git--run dir args)))
152 (if (= exit 0)
153 (cons 'applied out)
154 (patch-review-git--run dir
155 "-c" "advice.mergeConflict=false"
156 "-c" "advice.amWorkDir=false"
157 "-c" (concat "core.hooksPath=" hooks)
158 "am" "--abort")
159 (cons 'conflict
160 (concat out
161 "\n(git am --abort ran; the repository is back "
162 "to its previous state)\n"))))))))
163
164 (defun patch-review-git-concat-mboxes (files)
165 "Concatenate mbox FILES into one temporary file; return its path.
166 Multiple patch files checked independently against the original
167 tree fail spuriously when a sequel depends on an earlier patch's
168 context; one concatenated mbox verifies sequentially, matching
169 `git am'."
170 (let ((tmp (make-temp-file "patch-review-series")))
171 (with-temp-file tmp
172 (dolist (f files)
173 (insert-file-contents f)
174 (goto-char (point-max))
175 (unless (or (bobp) (eq (char-before) ?\n))
176 (insert "\n"))))
177 tmp))
178
179 (provide 'patch-review-git)
180 ;;; patch-review-git.el ends here