Emacs smart-backup

10-backup.el

;; Some sane configuration
(setq delete-old-versions -1)    ; disable automatic backup trimming
(setq version-control t)         ; use version control
(setq vc-make-backup-files t)    ; make backups file even when in version controlled dir
;; Disable built-in automatic backups. I use my own solution below.
(setq backup-inhibited t)
;; Store backups in ~/.emacs.d/backups/ instead of working directories
(setq backup-directory-alist
      `(("." . ,(file-name-as-directory
                (expand-file-name "backups" user-emacs-directory)))))
(setq backup-by-copying t)       ; backup by copying instead of renaming; more reliable.
;; Store auto-save files in ~/.emacs.d/auto-save-list/ instead of working directories
(setq auto-save-file-name-transforms
      `((".*" ,(file-name-as-directory
               (expand-file-name "auto-save-list" user-emacs-directory)) t)))

;; Activate the smart backup system
(require 'smart-backup)
(add-hook 'after-save-hook #'smart-backup-buffer)
(setq smart-backup-excluded-directories
        (list (file-name-as-directory
         (expand-file-name "scratch" user-emacs-directory))))

smart-backup.el

;;; smart-backup.el --- Content-aware backup system with deduplication -*- lexical-binding: t; -*-

;; Copyright (C) 2025

;; Author: Ivan Mirić <email@example.com>
;; Version: 0.1.0
;; Package-Requires: ((emacs "30.0"))
;; Keywords: backup

;; This file is not part of GNU Emacs.

;;; Commentary:

;; This package provides an intelligent backup system that extends Emacs'
;; built-in backup functionality with content-aware backup creation.
;;
;; Features:
;; - Content deduplication: Prevents creating backups with identical content
;; - Time-based throttling: Only creates backups after configurable intervals
;; - Cross-session awareness: Examines existing backups when files are opened
;; - Directory exclusion: Skip backups for specified directories
;; - Hash-based filenames: Backup files include content hash for identification
;;
;; Backup files are created with the format:
;; FILE~NUMBER~HASH~
;;
;; Example: !home!user!project!file.ext.~5~a1b2c3d4e5f67890abcdef1234567890~
;;
;; Customization:
;; - `smart-backup-interval': Time between backups (default 300 seconds)
;; - `smart-backup-excluded-directories': Directories to exclude from backups
;; - `smart-backup-max-check-count': Maximum amount of recent backup files to check when initializing state (default 50)

;;; Code:

;; Configuration variables
(defvar smart-backup-interval 300
  "Interval in seconds between smart backups for the same file.")

(defvar smart-backup-excluded-directories nil
  "List of directories to exclude from smart backups.
Paths are expanded, so you can use ~ and relative paths.")

(defvar smart-backup-max-check-count 50
  "Maximum number of recent backup files to check when initializing state.")

(defvar smart-backup-last-time (make-hash-table :test 'equal)
  "Hash table tracking last backup time for each file.")

(defvar smart-backup-last-hash (make-hash-table :test 'equal)
  "Hash table tracking content hash at last backup for each file.")

;; Hash-based filename integration
;; NOTE: This approach doesn't work because find-backup-file-name uses
;; make-backup-file-name-1 directly and constructs versioned filenames
;; with format "%s.~%d~", bypassing make-backup-file-name-function entirely.
;; (setq make-backup-file-name-function #'smart-make-backup-file-name)

;; Custom backup file naming and recognition functions
(setq backup-file-name-p
      (lambda (filename)
        "Return non-nil if FILENAME is a backup file (handles both standard and hash formats)."
        (or (string-match "~[0-9]+~$" filename)           ; Standard format
            (string-match "~[0-9]+~[a-f0-9]+~$" filename)))) ; Hash format

(setq file-name-sans-versions-function
      (lambda (filename)
        "Remove backup suffixes from FILENAME (handles both standard and hash formats)."
        (replace-regexp-in-string "~[0-9]+\\(~[a-f0-9]+\\)?~$" "" filename)))

;; Core utility functions
(defun smart-file-content-hash (filename)
  "Return an MD5 hash of the file's content."
  (when (file-exists-p filename)
    (with-temp-buffer
      (insert-file-contents filename)
      (secure-hash 'md5 (current-buffer)))))

(defun smart-backup-file-in-excluded-directory-p (filename)
  "Return t if FILENAME is in an excluded directory."
  (let ((expanded-file (expand-file-name filename)))
    (cl-some (lambda (dir)
               (let ((expanded-dir (file-name-as-directory
                                    (expand-file-name dir))))
                 (string-prefix-p expanded-dir expanded-file)))
             smart-backup-excluded-directories)))

;; Hash-based backup filename integration
;; We override find-backup-file-name because it's the function that actually
;; determines backup filenames. The backup-buffer function calls find-backup-file-name
;; to get the backup filename, and find-backup-file-name constructs versioned
;; filenames directly using format "%s.~%d~" without consulting make-backup-file-name-function.
(defvar smart-original-find-backup-file-name (symbol-function 'find-backup-file-name)
  "Store original find-backup-file-name function for delegation.")

(defun smart-find-backup-file-name (fn)
  "Custom find-backup-file-name that includes content hash in filename.
Creates filenames with format: FILE~NUMBER~HASH~ with proper number incrementing."
  (let ((content-hash (smart-file-content-hash fn)))
    (if (not content-hash)
        (funcall smart-original-find-backup-file-name fn)
      (let* ((backup-dir (or (cdr (assoc "." backup-directory-alist))
                             (file-name-directory fn)))
             (basic-name (make-backup-file-name-1 fn))
             (base-pattern (concat "^" (regexp-quote (file-name-nondirectory basic-name)) "\\.~"))
             (existing-files (when (file-directory-p backup-dir)
                               (directory-files backup-dir nil base-pattern)))
             ;; Extract numbers from all backup files (both standard and hash format)
             (existing-numbers (mapcar (lambda (f)
                                         (when (string-match "~\\([0-9]+\\)~" f)
                                           (string-to-number (match-string 1 f))))
                                       existing-files))
             (max-number (if existing-numbers (apply #'max existing-numbers) 0))
             (next-number (1+ max-number))
             (new-backup-name (format "%s.~%d~%s~" basic-name next-number content-hash)))
        (cons new-backup-name nil)))))

;; Override the built-in function
(fset 'find-backup-file-name #'smart-find-backup-file-name)

;; Helper functions for hash-based deduplication
(defun smart-extract-hash-from-backup-name (backup-file)
  "Extract content hash from backup filename, return nil if not hash format."
  (when (string-match "~[0-9]+~\\([a-f0-9]+\\)~$" backup-file)
    (match-string 1 backup-file)))

(defun smart-find-backup-with-hash (file hash)
  "Return t if a backup with the same content hash already exists for FILE."
  (let* ((backup-dir (or (cdr (assoc "." backup-directory-alist))
                         (file-name-directory file)))
         (basic-name (make-backup-file-name-1 file))
         (base-pattern (concat (file-name-nondirectory basic-name) ".~"))
         (existing-files (when (file-directory-p backup-dir)
                           (directory-files backup-dir nil
                                            (concat "^" (regexp-quote base-pattern)))))
         (hash-backups (cl-remove-if-not
                        (lambda (f) (string-match "~[0-9]+~[a-f0-9]+~$" f))
                        existing-files)))
    (cl-some (lambda (backup)
               (string= hash (smart-extract-hash-from-backup-name backup)))
             hash-backups)))

(defun smart-initialize-backup-state-for-file (file)
  "Initialize backup tracking state by examining existing backups."
  (unless (gethash file smart-backup-last-time)
    (let* ((backup-dir (or (cdr (assoc "." backup-directory-alist))
                           (file-name-directory file)))
           (basic-name (make-backup-file-name-1 file))
           (base-pattern (concat "^" (regexp-quote (file-name-nondirectory basic-name)) "\\.~"))
           ;; Only get files matching THIS specific file's backup pattern
           (existing-files (when (file-directory-p backup-dir)
                             (directory-files backup-dir nil base-pattern)))
           (hash-backups (cl-remove-if-not
                          (lambda (f) (string-match "~[0-9]+~[a-f0-9]+~$" f))
                          existing-files))
           (full-paths (mapcar (lambda (f) (expand-file-name f backup-dir)) hash-backups))
           (existing-backups (cl-remove-if-not #'file-exists-p full-paths))
           ;; Sort by modification time (newest first) and take only first N
           (recent-backups (cl-subseq
                            (sort existing-backups
                                  (lambda (a b)
                                    (time-less-p (nth 5 (file-attributes b))
                                                 (nth 5 (file-attributes a)))))
                            0 (min smart-backup-max-check-count (length existing-backups))))
           (newest-backup (car recent-backups)))
      (when newest-backup
        (let ((backup-time (float-time (nth 5 (file-attributes newest-backup))))
              (backup-hash (smart-extract-hash-from-backup-name newest-backup)))
          (when backup-hash
            (puthash file backup-time smart-backup-last-time)
            (puthash file backup-hash smart-backup-last-hash)))))))

;; Backup creation functions
(defun smart-backup-buffer-force ()
  "Force creation of a backup for the current buffer and show the backup filename.

Returns t if backup was created, nil otherwise."
  (interactive)
  (if (not buffer-file-name)
      (progn (message "Buffer is not visiting a file") nil)
    (let ((backup-inhibited nil)
          (buffer-backed-up nil)
          (backup-by-copying t)
          (next-backup (car (find-backup-file-name buffer-file-name))))
      (backup-buffer)
      (if (and next-backup (file-exists-p next-backup))
          (progn
            (message "Backup created for %s: %s" (buffer-file-name)
                     (file-name-nondirectory next-backup)) t)
        (progn
          (message "Backup creation was skipped for %s" (buffer-file-name)) nil)))))

(defun smart-backup-buffer ()
  "Smart buffer backup with content deduplication.

Backup the current buffer if enough time has passed since the last backup,
the file's contents have changed since the last backup, it is not in an
excluded directory, and no backup with identical content already exists."
  (when (and buffer-file-name
             (not (smart-backup-file-in-excluded-directory-p buffer-file-name)))
    (let* ((file buffer-file-name)
           (last-backup (gethash file smart-backup-last-time 0))
           (now (float-time)))

      ;; Initialize state from existing backups if needed
      (smart-initialize-backup-state-for-file file)

      ;; Check time first - cheapest operation
      (when (> (- now last-backup) smart-backup-interval)
        (let* ((current-hash (smart-file-content-hash file)))
          (when current-hash
            (let ((last-hash (gethash file smart-backup-last-hash "")))
              ;; Only proceed if content changed AND no existing backup has same hash
              (when (and (not (string= current-hash last-hash))
                         (not (smart-find-backup-with-hash file current-hash)))
                (when (smart-backup-buffer-force)
                  (puthash file now smart-backup-last-time)
                  (puthash file current-hash smart-backup-last-hash))))))))))

(provide 'smart-backup)

;;; smart-backup.el ends here