;;; +scratch.el --- *scratch* improvements           -*- lexical-binding: t; -*-

;; Copyright (C) 2023  Case Duckworth

;; Author: Case Duckworth <case@acdw.net>
;; Keywords: convenience

;; 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 of the License, 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.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;;

;;; Code:

(defcustom +scratch-save-dir (locate-user-emacs-file "scratch.d")
  "Where to save scratch files."
  :type 'file)

(defcustom +scratch-max-age (* 60 60 24 365)
  "Maximum age of a saved scratch buffer.  Default: one year."
  :type 'natnum)

(defun +scratch@immortal ()
  "Don't kill *scratch* with `kill-buffer'."
  (if (equal (buffer-name) "*scratch*")
      (progn (bury-buffer) nil)
    t))

(defun +scratch-save (time-format)
  "Save *scratch* buffer to `+scratch-save-dir'.
TIME-FORMAT will be used to name the buffer."
  (interactive (list "%FT%H%z"))
  (with-current-buffer (get-scratch-buffer-create)
    (let ((buffer-file-name (expand-file-name (format "%s.%s"
                                                      (format-time-string
                                                       time-format)
                                                      (pcase major-mode
                                                        ('org-mode "org")
                                                        ('emacs-lisp-mode "el")
                                                        (_ "txt")))
                                              +scratch-save-dir)))
      (unless (string-equal (buffer-substring (point-min) (point-max))
                            initial-scratch-message)
        (save-buffer 0)))))

(defun +scratch-save-on-exit ()
  (+scratch-save "%FT%T%z")
  (+scratch-clean))

(defun +scratch-clean ()
  "Clean up saved scratches.
Scratch files older than `+scratch-max-age' will be removed."
  (dolist (f (directory-files +scratch-save-dir))
    (when (and (not (equal f "."))
               (not (equal f ".."))
               (> (time-convert (file-attribute-modification-time
                                 (file-attributes f))
                                'integer)
                  +scratch-max-age))
      (delete-file (expand-file-name f +scratch-save-dir) :trash))))

(provide '+scratch)
;;; +scratch.el ends here