From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 24 Aug 2020 16:26:05 +0000 (+0200)
Subject: Add a new function 'file-backup-file-names'
X-Git-Tag: emacs-28.0.90~6429
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b74aaee5a473f70e5b78218724cd4d10b123c388;p=emacs.git

Add a new function 'file-backup-file-names'

* lisp/files.el (file-backup-file-names): New function (bug#24089).
(file-newest-backup): Use it.
---

diff --git a/etc/NEWS b/etc/NEWS
index a65852fcd0f..cd8cc317055 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1108,6 +1108,10 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
 
 * Lisp Changes in Emacs 28.1
 
+---
+*** New function 'file-backup-file-names'.
+This function returns all backup file names for the file in question.
+
 +++
 ** The 'count-lines' function now takes an optional parameter to
 ignore invisible lines.
diff --git a/lisp/files.el b/lisp/files.el
index f92c3793b00..5102585d7de 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5655,25 +5655,27 @@ like `write-region' does."
 
 (defun file-newest-backup (filename)
   "Return most recent backup file for FILENAME or nil if no backups exist."
+  (car (file-backup-file-names filename)))
+
+(defun file-backup-file-names (filename)
+  "Return a list of backup files for FILENAME.
+The list will be sorted by newness."
   ;; `make-backup-file-name' will get us the right directory for
   ;; ordinary or numeric backups.  It might create a directory for
   ;; backups as a side-effect, according to `backup-directory-alist'.
   (let* ((filename (file-name-sans-versions
 		    (make-backup-file-name (expand-file-name filename))))
-	 (file (file-name-nondirectory filename))
-	 (dir  (file-name-directory    filename))
-	 (comp (file-name-all-completions file dir))
-         (newest nil)
-         tem)
-    (while comp
-      (setq tem (pop comp))
-      (cond ((and (backup-file-name-p tem)
-                  (string= (file-name-sans-versions tem) file))
-             (setq tem (concat dir tem))
-             (if (or (null newest)
-                     (file-newer-than-file-p tem newest))
-                 (setq newest tem)))))
-    newest))
+         (dir (file-name-directory filename)))
+    (sort
+     (seq-filter
+      (lambda (candidate)
+        (and (backup-file-name-p candidate)
+             (string= (file-name-sans-versions candidate) filename)))
+      (mapcar
+       (lambda (file)
+         (concat dir file))
+       (file-name-all-completions (file-name-nondirectory filename) dir)))
+     #'file-newer-than-file-p)))
 
 (defun rename-uniquely ()
   "Rename current buffer to a similar name not already taken.