[elpa] master 4c1bbf4 2/3: Touch up the automatic patch applying logic

[Lars Ingebrigtsen]

branch: master
commit 4c1bbf4682f27fa12238d1cfab675bdbf56d3ca5
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    Touch up the automatic patch applying logic
---
 packages/debbugs/debbugs-gnu.el |   32 ++++++++++++++++++++++++++++++--
 1 files changed, 30 insertions(+), 2 deletions(-)

diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index 73c19d8..296538a 100644
--- a/packages/debbugs/debbugs-gnu.el
+++ b/packages/debbugs/debbugs-gnu.el
@@ -1378,7 +1378,9 @@ If given a prefix, patch in the branch directory instead."
       (article-decode-charset)
       (push gnus-article-buffer patch-buffers))
     (dolist (buffer patch-buffers)
-      (with-current-buffer buffer
+      (with-temp-buffer
+       (insert-buffer-substring buffer)
+       (debbugs-gnu-fix-patch dir)
        (call-process-region (point-min) (point-max)
                             "patch" nil output-buffer nil
                             "-r" rej "--no-backup-if-mismatch"
@@ -1414,6 +1416,28 @@ If given a prefix, patch in the branch directory 
instead."
     (switch-to-buffer "*vc-diff*")
     (goto-char (point-min))))
 
+(defun debbugs-gnu-fix-patch (dir)
+  (setq dir (directory-file-name (expand-file-name dir)))
+  (goto-char (point-min))
+  (re-search-forward diff-file-header-re nil t)
+  (goto-char (match-beginning 0))
+  (let ((file-names (diff-hunk-file-names)))
+    (when (and file-names
+              (not (string-match "/" (car file-names))))
+      ;; We have a simple patch that refers to a file somewhere in the
+      ;; tree.  Find it.
+      (when-let ((files (directory-files-recursively
+                        dir (concat "^" (regexp-quote (car file-names))
+                                    "$"))))
+       (when (re-search-forward (concat "^[+]+ "
+                                        (regexp-quote (car file-names))
+                                        "[ \t]")
+                                nil t)
+         (replace-match (concat "+++ a"
+                                (substring (car files) (length dir))
+                                "\t")
+                        nil t))))))
+
 (defun debbugs-gnu-find-contributor (string)
   "Search through ChangeLogs to find contributors."
   (interactive "sContributor match: ")
@@ -1503,7 +1527,11 @@ If given a prefix, patch in the branch directory 
instead."
   (save-some-buffers t)
    (when (get-buffer "*vc-dir*")
      (kill-buffer (get-buffer "*vc-dir*")))
-   (vc-dir debbugs-gnu-trunk-directory)
+   (let ((trunk (expand-file-name debbugs-gnu-trunk-directory)))
+     (if (equal (subseq default-directory 0 (length trunk))
+               trunk)
+        (vc-dir debbugs-gnu-trunk-directory)
+       (vc-dir debbugs-gnu-branch-directory)))
    (goto-char (point-min))
    (while (not (search-forward "edited" nil t))
      (sit-for 0.01))