PythonNut / quark-emacs

:rocket: An incredible wonderland of code
MIT License
137 stars 6 forks source link

Add TRAMP support to backup-walker #146

Open PythonNut opened 3 years ago

PythonNut commented 3 years ago

Probably I'll just end up maintaining the package :man_shrugging:

PythonNut commented 3 years ago

Partial solution:

(defun tramp-handle-make-backup-file-name (filename)
  "Like `make-backup-file-name' for Tramp files."
  (if (tramp-tramp-file-p filename)
      (with-parsed-tramp-file-name filename nil
        (let ((backup-directory-alist
           (if tramp-backup-directory-alist
               (mapcar
            (lambda (x)
              (cons
               (car x)
               (if (and (stringp (cdr x))
                    (file-name-absolute-p (cdr x))
                    (not (tramp-tramp-file-p (cdr x))))
                   (tramp-make-tramp-file-name v (cdr x))
                 (cdr x))))
            tramp-backup-directory-alist)
             backup-directory-alist)))
          (tramp-run-real-handler #'make-backup-file-name (list filename))))
    (make-backup-file-name filename)))

(defun backup-walker-get-sorted-backups (filename)
  "Return version sorted list of backups of the form:

  (prefix (list of suffixes))"
  ;; `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
                    (tramp-handle-make-backup-file-name (expand-file-name filename))))
         (file (file-name-nondirectory filename))
         (dir  (file-name-directory    filename))
         (comp (remove (concat file "~") (file-name-all-completions file dir)))
         (prefix-len (length file)))
    (cons filename (mapcar
                    (lambda (f)
                      (substring (cdr f) prefix-len))
                    (sort (mapcar (lambda (f)
                                    (cons (backup-walker-get-version f prefix-len)
                                          f))
                                  comp)
                          (lambda (f1 f2)
                            (not (< (car f1) (car f2)))))))))