buffer-snapshotter-mode.el

;;; buffer-snapshotter.el --- Minor mode that keeps snapshots of changed versions buffers (visiting files or not) written to disk, and limits those snapshots by number or time -*- lexical-binding: t -*-

;; Copyright 2023 - Twitchy Ears

;; Author: Twitchy Ears https://github.com/twitchy-ears/
;; URL: https://github.com/twitchy-ears/buffer-snapshotter
;; Version: 0.1
;; Package-Requires ((emacs "29.1") cl-lib)
;; Keywords: buffer save

;; This file is not part of GNU Emacs.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.

;;; History
;;
;; 2023-12-11 Initial version.

;;; Commentary:

;; Essentially all you need is this:
;; (use-package buffer-snapshotter-mode)
;;
;; Then M-x buffer-snapshotter-mode in a buffer you feel needs this mode.
;;
;; If you want it to clean up old files whenever you start Emacs then
;; try something like this:
;;
;; (use-package buffer-snapshotter
;;     :config
;;     (buffer-snapshotter-cleanup-directory))
;;
;; If you want it to automatically start for certain modes use tricks
;; like this:
;;
;; (add-hook 'atomic-chrome-edit-mode-hook
;;            (lambda () (buffer-snapshotter-mode 1)))
;;
;; If you want to activate it globally then use something like this: 
;;
;; (add-hook 'after-change-major-mode-hook #'buffer-snapshotter-mode)

;; TODO:
;;
;; Generally more testing.

;;; Code:

(eval-and-compile
  (require 'seq)
  (with-no-warnings (require 'cl-lib)))

;; Local variables
(defvar-local buffer-snapshotter-timer nil "Holds the timer for the current buffers process")

(defvar-local buffer-snapshotter-force-timer nil "Holds the timer for the current buffers force saver")

(defvar-local buffer-snapshotter-bcmt nil "The current buffers (buffer-chars-modified-tick) used to work out if we should snapshot or not")

(defvar-local buffer-snapshotter-base-name nil "The current buffers snapshot name, as generated by the function in buffer-snapshotter-namegen-func")



;; General variables
(defvar buffer-snapshotter-frequency 30 "Seconds in idle timer before checking to see if a snapshot is required")

(defvar buffer-snapshotter-force-frequency 600 "Seconds in non-idle timer before forcing a snapshot, if nil deactivates this behaviour")

(defvar buffer-snapshotter-notify nil "When t will output a message when snapshotting a buffer")

(defvar buffer-snapshotter-include-hostname t
  "When t will include the hostname when using
buffer-snapshotter--default-namegen-func so that buffers are
distinguished between machines if you are synchronising your
directories")

(defvar buffer-snapshotter-directory
    (expand-file-name (format "%s/%s"
                              user-emacs-directory
                              "buffer-snapshots"))
  "Stores location of buffer snapshots")

(defvar buffer-snapshotter-namegen-function
    #'buffer-snapshotter--default-namegen-func
 "Function used to generate snapshot filename bases which will have
timestamps appended, also used to find files to clean up so
if you change it you may leave a mess behind that needs
cleaning manually.")

(defvar buffer-snapshotter-keep-versions 5 "Number of versions to keep")

(defvar buffer-snapshotter-keep-time 21600 "Number of seconds to keep a version of the file, defaults to 21600 (6 hours)")

(defvar buffer-snapshotter-cleanup-method-function
  #'buffer-snapshotter-delete-excess-by-number
  "Method of cleaning up excess snapshot files, defaults to
'buffer-snapshotter-delete-excess-by-number' for using
'buffer-snapshotter-keep-versions' to determine how many to keep,
if you set it to 'buffer-snapshotter-delete-excess-by-time' it
will use 'buffer-snapshotter-keep-time' to determine which to
delete.  If you point it to your own function you can make your
own decisions")

(defvar buffer-snapshotter-maximum-age 259200 "Maximum age for a snapshot file to be valid, can be used for a general purpose directory cleanup")

(defvar buffer-snapshotter-mode-after-hook nil "Hook that runs after the mode is turned on or off")

(defvar buffer-snapshotter-save-copy-after-hook nil "Hook that runs after a succesful run of the 'buffer-snapshotter-save-copy' function where a new snapshot is made")

(defvar buffer-snapshotter--string-safe-pattern "[a-zA-Z0-9_-]" "The pattern used by buffer-snapshotter--string-safe, everything not matching this will be replaced by numeric codepoint versions when constructing the names of snapshot files")

(defvar buffer-snapshotter-never-activate-mode-list
  '(minibuffer-mode)
  "List of modes to never activate buffer-snapshotter-mode in, is checked
against both 'major-mode' and 'local-minor-modes', defaults to avoiding the minibuffer.")

(defvar buffer-snapshotter-never-activate-function
  #'buffer-snapshotter-never-activate-function-p
  "Function that runs before the mode is activated, if it returns t then the mode will not be activated.")


;;--- Functions ---

(defun buffer-snapshotter-never-activate-function-p ()
  "Runs in the current buffer as part of 'buffer-snapshot-mode' if
it returns t then the mode will not activate for this buffer.

By default checks to see if we're an encrypted file using (epa-file-name-p)
and returns t for this case."
  (let ((bfname (buffer-file-name)))
    (if bfname
        (epa-file-name-p bfname))))

(defun buffer-snapshotter--string-safe (str)
  "Takes a string 'STR' and renders everything not matching the
pattern stored in 'buffer-snapshotter--string-safe-pattern'
which defaults to '[a-zA-Z0-9_-]' into a codepoint number,
returns the composite string"
  (let ((res '()))
    (with-temp-buffer
      (insert str)
      (goto-char (point-min))

      ;; Run through the buffer start to finish, prepend characters
      ;; matching the pattern, otherwise prepend the codepoint
      (while (not (eobp))
        (let* ((char (following-char))
               (strchar (string char))
               (final
                (if (string-match-p buffer-snapshotter--string-safe-pattern
                                    strchar)
                    strchar
                  char)))
                        ;(or (get-char-property (point) 'untranslated-utf-8)
                        ;    (encode-char (char-after) 'ucs)
                        ;    (following-char)))))
          (setq res (cons final res))
          (forward-char 1)))

      ;; Create a string by reversing what we go and running it
      ;; through format
      (string-join (mapcar (lambda (x)
                             (format "%s" x))
                           (nreverse res))                                    
                   ""))))

(defun buffer-snapshotter--default-namegen-func (&optional buffer)
  "Generates a safe consistent snapshot base name for a buffer.
If given BUFFER will generate for that, otherwise will use (buffer-name).

If 'buffer-snapshotter-include-hostname' is t then the
'system-name' variable will be prepended to buffers that don't
have a 'buffer-file-name', this disambiguates the machine that
created them if you have a synchronised Emacs directory between
multiple machines."
  (let ((fixable-name (if buffer-file-name
                          buffer-file-name
                        (if buffer-snapshotter-include-hostname
                            (format "%s-%s" system-name (buffer-name))
                          (format "%s" (buffer-name))))))
    (if fixable-name
        (buffer-snapshotter--string-safe fixable-name)
      nil)))

(defun buffer-snapshotter--get-snapshot-list (&optional force-name)
  "Retrieves the lists of snapshot files for the current buffer
by checking in the 'buffer-snapshotter-directory' and using the
'buffer-snapshotter-base-name' variable as a basename for the
search.

If FORCE-NAME is given then it will use this instead of the
'buffer-snapshotter-base-name' and search the
'buffer-snapshotter-directory' for files with that followed by
a dot, then a numeric timestamp."
  (let* ((bs-basename (if force-name
                          force-name
                        buffer-snapshotter-base-name))
         (snap-list  (directory-files buffer-snapshotter-directory
                                      t
                                      (format "%s.[0-9]*$" bs-basename))))
    snap-list))

(defun buffer-snapshotter-cleanup-directory (&optional force-dir)
  "Runs through every file in the 'buffer-snapshotter-directory' and
deletes every file with an mtime older in seconds than
'buffer-snapshotter-keep-time' chases down symlinks as well.

If FORCE-DIR is given then it will use this directory instead of
'buffer-snapshotter-directory', this can obviously be
dangerous."
  (interactive)
  (when (or (not (boundp 'buffer-snapshotter-maximum-age))
            (not (numberp buffer-snapshotter-maximum-age))
            (not (>= buffer-snapshotter-maximum-age 1)))
    (error "buffer-snapshotter-cleanup-directory: buffer-snapshotter-maximum-age seems in error should be a number > 1"))
  
  (let* ((target-dir (if force-dir
                         force-dir
                       buffer-snapshotter-directory))
         (whole-list (directory-files target-dir t))
         (now (string-to-number (format-time-string "%s" (current-time))))
         (oldest (- now buffer-snapshotter-maximum-age)))

    ;; Run through the list.
    (dolist (target whole-list)
      
      ;; Calculate the mtime of the file-truename to get the real path
      ;; and chase down symlinks and so forth and make sure to convert
      ;; it back into a number.  There is probably a better way to do
      ;; this I may be wasting my time with one of the conversions.
      (let ((mtime (string-to-number
                    (format-time-string
                     "%s"
                     (file-attribute-modification-time
                      (file-attributes
                       (file-truename (expand-file-name target))))))))
        
        ;; Older than the oldest allowed?  Delete
        (when (< mtime oldest)
          (if buffer-snapshotter-notify
              (message "buffer-snapshotter-cleanup-directory deleting: '%s'" target))
          (delete-file target))))))
                   
  

(defun buffer-snapshotter-delete-excess-by-number (&optional force-name)
  "Checks the 'buffer-snapshotter-directory' for snapshot files of
the current buffer (using 'buffer-snapshotter--get-snapshot-list') and
deletes all but the latest 'buffer-snapshotter-keep-versions' versions.

If the optional FORCE-NAME argument is set this is passed to
'buffer-snapshotter--get-snapshot-list' to generate the files to consider.

If 'buffer-snapshotter-notify' is t then it will use (message) to
log when it deletes a file."
  
  (when (or (not (numberp buffer-snapshotter-keep-versions))
            (not (>= buffer-snapshotter-keep-versions 1)))
    (error "buffer-snapshotter-delete-excess-by-number: buffer-snapshotter-keep-versions seems in error should be a number > 1"))

  ;; Find our list
  (let* ((snap-list (buffer-snapshotter--get-snapshot-list force-name)))
                   
    ;; If we have more than minimum then generate a butlast list and
    ;; delete them one by one
    (if (> (length snap-list) buffer-snapshotter-keep-versions)
        (let ((target-list (butlast snap-list
                                    buffer-snapshotter-keep-versions)))
          (dolist (target target-list)
            (if buffer-snapshotter-notify
                (message "buffer-snapshotter-delete-excess-by-number deleting: '%s'" target))
            (delete-file target))))))

(defun buffer-snapshotter-delete-excess-by-time (&optional force-name)
  "Checks the 'buffer-snapshotter-directory' for snapshot files of
the current buffer (using 'buffer-snapshotter--get-snapshot-list') and
deletes any that have an mtime older in seconds than the
'buffer-snapshotter-keep-time'.

If the optional FORCE-NAME argument is set this is passed to
'buffer-snapshotter--get-snapshot-list' to generate the files to consider.

If 'buffer-snapshotter-notify' is t then it will use (message) to
log when it deletes a file."
  
  (when (or (not (numberp buffer-snapshotter-keep-time))
            (not (>= buffer-snapshotter-keep-time 1)))
    (error "buffer-snapshotter-delete-excess-by-time: buffer-snapshotter-keep-time seems in error should be a number > 1"))

  ;; Find our list
  (let* ((snap-list (buffer-snapshotter--get-snapshot-list force-name))
         (now (string-to-number (format-time-string "%s" (current-time))))
         (oldest (- now buffer-snapshotter-keep-time)))
    (dolist (target snap-list)

      ;; Calculate the mtime of the file-truename to get the real path
      ;; and chase down symlinks and so forth and make sure to convert
      ;; it back into a number.  There is probably a better way to do
      ;; this I may be wasting my time with one of the conversions.
      (let ((mtime (string-to-number
                    (format-time-string
                     "%s"
                     (file-attribute-modification-time
                      (file-attributes
                       (file-truename (expand-file-name target))))))))
        
        ;; Older than the oldest allowed?  Delete
        (when (< mtime oldest)
          (if buffer-snapshotter-notify
              (message "buffer-snapshotter-delete-excess-by-time deleting: '%s'" target))
          (delete-file target))))))

  

(cl-defun buffer-snapshotter-save-copy (&optional force-name)
  "Attempts to save a snapshot of the file, if it hasn't changed or
buffer-snapshotter-mode isn't enabled then it returns.

It relies on the buffer having a 'buffer-snapshotter-base-name'
as a local variable, which is setup when the mode is
activated (and is generated by 'buffer-snapshotter-namegen-function').
This snapshot file is put into the the 'buffer-snapshotter-directory' with
a dot then a timestamp in epoch seconds appended.

If it sees changes and successfully writes a snapshot file to disk it will
use (message) to notify the user if 'buffer-snapshotter-notify' is set
then call the 'buffer-snapshotter-cleanup-method-function' to remove
old copies.

Finally if a fresh snapshot is made it will run the
'buffer-snapshotter-save-copy-after-hook' hook in case you want to do
anything yourself."
  (interactive)

  ;; No change?  Bail
  (when (or (not buffer-snapshotter-mode)
            (equal buffer-snapshotter-bcmt (buffer-chars-modified-tick)))
    (if buffer-snapshotter-mode
        (cl-return-from buffer-snapshotter-save-copy
          (format "No changes to save for %s because '%s' == '%s'"
                  (buffer-name)
                  buffer-snapshotter-bcmt
                  (buffer-chars-modified-tick)))
      (cl-return-from buffer-snapshotter-save-copy
        (format "buffer-snapshotter not running in '%s'" (buffer-name)))))

  ;; Calculate name and write out
  (let ((bs-filename (if force-name
                         force-name
                       (expand-file-name
                        (format "%s/%s.%s"
                                buffer-snapshotter-directory
                                buffer-snapshotter-base-name
                                (format-time-string "%s" (current-time)))))))

    ;; If the file doesn't exist then write the whole buffer to it
    (when (not (file-exists-p bs-filename))
      (save-mark-and-excursion
        (save-restriction
          (widen)
          
          ;; It just returns nil so we can't check the return but
          ;; instead have to just check the file-exists-p afterwards.
          (write-region nil nil        ;; whole buffer
                        bs-filename    ;; target
                        nil nil nil t) ;; ensure new

          ;; If it got created then fix its permissions, run a cleanup
          ;; cycle, update our modified-tick and notify the user if
          ;; wanted.
          (when (file-exists-p bs-filename)
            (if buffer-snapshotter-notify
                (message "buffer-snapshotter: snapshotting '%s' into '%s'"
                         (buffer-name) bs-filename))
            (chmod bs-filename (string-to-number "600" 8))
            (setq-local buffer-snapshotter-bcmt (buffer-chars-modified-tick))

            ;; Cleanup old files or by number
            (if (fboundp buffer-snapshotter-cleanup-method-function)
                (funcall buffer-snapshotter-cleanup-method-function))

            ;; Run any user hooks
            (run-hooks 'buffer-snapshotter-save-copy-after-hook)
            bs-filename)))))) ;; return the filename on success

(defun buffer-snapshotter--mode-activate-check-p ()
  "Returns t if buffer-snapshotter-mode should activate and nil
if it should not.  If 'buffer-snapshotter-notify' is t then it
also outputs helpful messages.

Makes use of the 'buffer-snapshotter-never-activate-mode-list' as well
as the 'buffer-snapshotter-never-activate-function' variables."
  (cond
   ;; Check major mode 
   ((seq-contains-p buffer-snapshotter-never-activate-mode-list
                    major-mode)
    (if buffer-snapshotter-notify
        (message "Cannot activate buffer-snapshotter-mode in '%s' because '%s' is in the buffer-snapshotter-never-activate-mode-list"
                 (buffer-name)
                 major-mode))
    nil)

   ;; Check minor modes
   ((let ((is (seq-intersection buffer-snapshotter-never-activate-mode-list
                                local-minor-modes)))
      (when is
        (if buffer-snapshotter-nofify
            (message "Cannot activate buffer-snapshotter-mode in '%s' because '%s' is in the buffer-snapshotter-never-activate-mode-list"
                     (buffer-name)
                     is))
        nil)))

   ;; Check predicate function
   ((when (and (fboundp buffer-snapshotter-never-activate-function)
               (funcall buffer-snapshotter-never-activate-function))
      (if buffer-snapshotter-notify         
          (message "Cannot activate buffer-snapshotter-mode in '%s' because '%s' returned t"
                   (buffer-name)
                   buffer-snapshotter-never-activate-function))
      nil))

   ;; Default case actually works.
   (t t)))


(define-minor-mode buffer-snapshotter-mode ()
  "When enabled snapshots a buffer regularly into a directory by
timestamp, keeping only the last N snapshot files or removing
snapshot files older than a specific date decided by the
'buffer-snapshotter-cleanup-method-function' variable.  See the
'buffer-snapshotter-save-copy' function for the entry point to
most of the work.

Checks the variable 'buffer-snapshotter-never-activate-mode-list' and refuses to activate if any of the modes in this list are in the major-mode or local-minor-modes variables.

Can work on temporary buffers or buffers visiting files.

Has a 'buffer-snapshotter-mode-after-hook' which occurs after it is
 activated/deactivated.

If you want to activate it globally then add it to
'after-change-major-mode-hook' with something like this:
(add-hook 'after-change-major-mode-hook #'buffer-snapshotter-mode)"
  :init-value nil
  :global nil
  :lighter "bs"
  :after-hook buffer-snapshotter-mode-after-hook

  (if buffer-snapshotter-mode

      ;; Turn on
      (when (buffer-snapshotter--mode-activate-check-p)
        
        ;; Kill existing timer(s)
        (if buffer-snapshotter-timer
            (cancel-timer buffer-snapshotter-timer))
        (if buffer-snapshotter-force-timer
            (cancel-timer buffer-snapshotter-force-timer))

        ;; Create directory if required
        (make-directory buffer-snapshotter-directory t)

        ;; Make private
        (chmod buffer-snapshotter-directory (string-to-number "700" 8))

        ;; Setup variables
        (setq-local buffer-snapshotter-base-name
                    (funcall buffer-snapshotter-namegen-function))
        (setq-local buffer-snapshotter-bcmt (buffer-chars-modified-tick))

        ;; Setup new one
        (setq-local buffer-snapshotter-timer
                     (run-with-idle-timer buffer-snapshotter-frequency
                                          t
                                          #'buffer-snapshotter-save-copy))

        (if buffer-snapshotter-force-frequency
            (setq-local buffer-snapshotter-force-timer
                        (run-with-timer buffer-snapshotter-force-frequency
                                        buffer-snapshotter-force-frequency
                                        #'buffer-snapshotter-save-copy))))


    ;; Turning off
    
    ;; Kill existing timer(s)
    (if buffer-snapshotter-timer
        (cancel-timer buffer-snapshotter-timer))
    (if buffer-snapshotter-force-timer
        (cancel-timer buffer-snapshotter-force-timer))
    
    ;; Clearout variables
    (setq-local buffer-snapshotter-base-name nil
                buffer-snapshotter-bcmt nil
                buffer-snapshotter-timer nil
                buffer-snapshotter-force-timer nil)))

(provide 'buffer-snapshotter-mode)