master 5b80894d0a7: Support viewing VC change history across renames (Git, Hg)

[Dmitry Gutov]

branch: master
commit 5b80894d0a7ff94496c37bad595579c29f5a925c
Author: Dmitry Gutov <dmitry@gutov.dev>
Commit: Dmitry Gutov <dmitry@gutov.dev>

    Support viewing VC change history across renames (Git, Hg)
    
    * lisp/vc/vc.el (vc-print-log-setup-buttons):
    When the log ends at a rename, add a button to jump to the
    previous names.  Use the new backend action 'file-name-changes'.
    
    * lisp/vc/vc-git.el (vc-git-print-log-follow): New option.
    (vc-git-file-name-changes): Implementation (bug#55871, bug#39044).
    (vc-git-print-log-follow): Update docstring.
    
    * lisp/vc/log-view.el (log-view-find-revision)
    (log-view-annotate-version): Pass the log's VC backend explicitly.
    
    * lisp/vc/vc-hg.el (vc-hg-file-name-changes):
    Add Hg implementation (bug#13004).
    
    * etc/NEWS: Mention the changes.
---
 etc/NEWS            | 10 ++++++++++
 lisp/vc/log-view.el |  6 ++++--
 lisp/vc/vc-git.el   | 50 +++++++++++++++++++++++++++++++++++++++++++++++++-
 lisp/vc/vc-hg.el    | 17 +++++++++++++++++
 lisp/vc/vc.el       | 51 ++++++++++++++++++++++++++++++++++++++++++++++++---
 5 files changed, 128 insertions(+), 6 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 1ff2f8a149f..29b3d6676de 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -457,6 +457,16 @@ With this value only the revision number is displayed on 
the mode-line.
 *** Obsolete command 'vc-switch-backend' re-added as 'vc-change-backend'.
 The command was previously obsoleted and unbound in Emacs 28.
 
+*** Support for viewing VC change history across renames.
+When a fileset's VC change history ('C-x v l') ends at a rename, we
+now print the old name(s) and a button which jumps to their history.
+Git and Hg are supported.  Naturally, 'vc-git-print-log-follow' should
+be nil for this to work (or '--follow' should not be in
+'vc-hg-print-log-switches', in Hg's case).
+
+*** New option 'vc-git-file-name-changes-switches'.
+It allows tweaking the thresholds for rename and copy detection.
+
 ** Diff mode
 
 +++
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index af24fcfd398..6c3abd15d8d 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -516,7 +516,8 @@ If called interactively, visit the version at point."
     (switch-to-buffer (vc-find-revision (if log-view-per-file-logs
                                            (log-view-current-file)
                                          (car log-view-vc-fileset))
-                                       (log-view-current-tag)))))
+                                       (log-view-current-tag)
+                                        log-view-vc-backend))))
 
 
 (defun log-view-extract-comment ()
@@ -562,7 +563,8 @@ If called interactively, annotate the version at point."
     (vc-annotate (if log-view-per-file-logs
                     (log-view-current-file)
                   (car log-view-vc-fileset))
-                (log-view-current-tag))))
+                (log-view-current-tag)
+                 nil nil nil log-view-vc-backend)))
 
 ;;
 ;; diff
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 2e057ecfaa7..fa1f14b65bb 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -89,6 +89,7 @@
 ;; - make-version-backups-p (file)                 NOT NEEDED
 ;; - previous-revision (file rev)                  OK
 ;; - next-revision (file rev)                      OK
+;; - file-name-changes (rev)                       OK
 ;; - check-headers ()                              COULD BE SUPPORTED
 ;; - delete-file (file)                            OK
 ;; - rename-file (old new)                         OK
@@ -152,6 +153,20 @@ comparing changes.  See Man page `git-blame' for more."
                  (repeat :tag "Argument List" :value ("") string))
   :version "30.1")
 
+;; XXX: (setq vc-git-log-switches '("--simplify-merges")) can also
+;; create fuller history when using this feature.  Not sure why.
+(defcustom vc-git-file-name-changes-switches '("-M" "-C")
+  "String or list of string to pass to Git when finding previous names.
+
+This option should usually at least contain '-M'.  You can adjust
+the flags to change the similarity thresholds (default 50%).  Or
+add `--find-copies-harder' (slower in large projects, since it
+uses a full scan)."
+  :type '(choice (const :tag "None" nil)
+                 (string :tag "Argument String")
+                 (repeat :tag "Argument List" :value ("") string))
+  :version "30.1")
+
 (defcustom vc-git-resolve-conflicts t
   "When non-nil, mark conflicted file as resolved upon saving.
 That is performed after all conflict markers in it have been
@@ -1416,7 +1431,15 @@ This prompts for a branch to merge from."
 ;; Long explanation here:
 ;; 
https://stackoverflow.com/questions/46487476/git-log-follow-graph-skips-commits
 (defcustom vc-git-print-log-follow nil
-  "If true, follow renames in Git logs for a single file."
+  "If true, use the flag `--follow' when producing single file logs.
+
+It will make the printed log automatically follow the renames.
+The downsides is that the log produced this way may omit
+certain (merge) commits, and that `log-view-diff' fails on
+commits that used the previous name, in that log buffer.
+
+When this variable is nil, and the log ends with a rename, we
+print a button below that shows the log for the previous name."
   :type 'boolean
   :version "26.1")
 
@@ -1866,6 +1889,31 @@ This requires git 1.8.4 or later, for the \"-L\" option 
of \"git log\"."
                    (progn (forward-line 1) (1- (point)))))))))
     (or (vc-git-symbolic-commit next-rev) next-rev)))
 
+(defun vc-git-file-name-changes (rev)
+  (with-temp-buffer
+    (let ((root (vc-git-root default-directory)))
+      (unless vc-git-print-log-follow
+        (apply #'vc-git-command (current-buffer) t nil
+               "diff"
+               "--name-status"
+               "--diff-filter=ADCR"
+               (concat rev "^") rev
+               (vc-switches 'git 'file-name-changes)))
+      (let (res)
+        (goto-char (point-min))
+        (while (re-search-forward 
"^\\([ADCR]\\)[0-9]*\t\\([^\n\t]+\\)\\(?:\t\\([^\n\t]+\\)\\)?" nil t)
+          (pcase (match-string 1)
+            ("A" (push (cons nil (match-string 2)) res))
+            ("D" (push (cons (match-string 2) nil) res))
+            ((or "C" "R") (push (cons (match-string 2) (match-string 3)) res))
+            ;; ("M" (push (cons (match-string 1) (match-string 1)) res))
+            ))
+        (mapc (lambda (c)
+                (if (car c) (setcar c (expand-file-name (car c) root)))
+                (if (cdr c) (setcdr c (expand-file-name (cdr c) root))))
+              res)
+        (nreverse res)))))
+
 (defun vc-git-delete-file (file)
   (vc-git-command nil 0 file "rm" "-f" "--"))
 
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 9df517ea847..d6dadb74469 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -77,6 +77,7 @@
 ;; - make-version-backups-p (file)             ??
 ;; - previous-revision (file rev)              OK
 ;; - next-revision (file rev)                  OK
+;; - file-name-changes (rev)                   OK
 ;; - check-headers ()                          ??
 ;; - delete-file (file)                        TEST IT
 ;; - rename-file (old new)                     OK
@@ -1203,6 +1204,22 @@ REV is ignored."
         (vc-hg-command buffer 0 file "cat" "-r" rev)
       (vc-hg-command buffer 0 file "cat"))))
 
+(defun vc-hg-file-name-changes (rev)
+  (unless (member "--follow" vc-hg-log-switches)
+    (with-temp-buffer
+      (let ((root (vc-hg-root default-directory)))
+        (vc-hg-command (current-buffer) t nil
+                       "log" "-g" "-p" "-r" rev)
+        (let (res)
+          (goto-char (point-min))
+          (while (re-search-forward "^diff --git a/\\([^ \n]+\\) b/\\([^ 
\n]+\\)" nil t)
+            (when (not (equal (match-string 1) (match-string 2)))
+              (push (cons
+                     (expand-file-name (match-string 1) root)
+                     (expand-file-name (match-string 2) root))
+                    res)))
+          (nreverse res))))))
+
 (defun vc-hg-find-ignore-file (file)
   "Return the root directory of the repository of FILE."
   (expand-file-name ".hgignore"
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 958929fe4c6..3689dcb9b27 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -517,6 +517,13 @@
 ;;   Return the revision number that precedes REV for FILE, or nil if no such
 ;;   revision exists.
 ;;
+;; - file-name-changes (rev)
+;;
+;;   Return the list of pairs with changes in file names in REV.  When
+;;   a file was added, it should be a cons with nil car.  When
+;;   deleted, a cons with nil cdr.  When copied or renamed, a cons
+;;   with the source name as car and destination name as cdr.
+;;
 ;; - next-revision (file rev)
 ;;
 ;;   Return the revision number that follows REV for FILE, or nil if no such
@@ -2695,9 +2702,47 @@ or if PL-RETURN is `limit-unsupported'."
       (goto-char (point-min))
       (while (re-search-forward log-view-message-re nil t)
         (cl-incf entries))
-      ;; If we got fewer entries than we asked for, then displaying
-      ;; the "more" buttons isn't useful.
-      (when (>= entries limit)
+      (if (< entries limit)
+          ;; The log has been printed in full.  Perhaps it started
+          ;; with a copy or rename?
+          (let* ((last-revision (log-view-current-tag (point-max)))
+                 ;; XXX: Could skip this when vc-git-print-log-follow = t.
+                 (name-changes
+                  (condition-case nil
+                      (vc-call-backend log-view-vc-backend
+                                       'file-name-changes last-revision)
+                    (vc-not-supported nil)))
+                 (matching-changes
+                  (cl-delete-if-not (lambda (f) (member f log-view-vc-fileset))
+                                    name-changes :key #'cdr))
+                 (old-names (delq nil (mapcar #'car matching-changes)))
+                 (relatives (mapcar #'file-relative-name old-names)))
+            (when old-names
+              (goto-char (point-max))
+              (unless (looking-back "\n\n" (- (point) 2))
+                (insert "\n"))
+              (insert
+               (format
+                "Renamed from %s"
+                (mapconcat (lambda (s)
+                             (propertize s 'font-lock-face
+                                         'log-view-file))
+                           relatives ", "))
+               " ")
+              ;; TODO: Also print a different button somewhere in the
+              ;; created buffer to be able to go back easily.  (There
+              ;; are different ways to do that.)
+              (insert-text-button
+               "View log"
+               'action (lambda (&rest _ignore)
+                         (let ((backend log-view-vc-backend))
+                           (with-current-buffer vc-parent-buffer
+                             ;; To set up parent buffer in the new viewer.
+                             (vc-print-log-internal backend old-names
+                                                    last-revision nil limit))))
+               'help-echo
+               "Show the log for the file name(s) before the rename")))
+        ;; Perhaps there are more entries in the log.
         (goto-char (point-max))
         (insert "\n")
         (insert-text-button