package-delete-save.el

;;; package-delete-save.el --- Package backup

;; Copyright (C) 2017, 2018 fubuki

;; Author: fubuki@*****.org
;; Keywords: package

;; 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Before updating or deleting the `list-packages', back up the old version.

;;; Installation:

;; (require 'package-delete-save)

;;; Code:

(require 'dired-aux)
(require 'package)

(defcustom pds-backup-directory-name  (locate-user-emacs-file "backup-elpa/")
  "Save directory name with full path."
  :type    'file
  :group   'package
  :version "25.3")

(defcustom pds-overwite-flag 0
  "If file already exists,
NIL returns an error, if INTEGER it asks. Otherwise forcibly overwrite."
  :type    '(choice integer boolean symbol)
  :group   'package
  :version "25.3")

(defun package-delete-save (pkg-desc &optional force nosave)
  "Before updating or deleting the `list-packages', back up the old version."
  (let ((backup-dir (file-name-as-directory pds-backup-directory-name))
        (source-dir (expand-file-name (package-desc-full-name pkg-desc) package-user-dir))
	(dired-recursive-copies 'always) ; Recursive copy without question.
	(flag pds-overwite-flag))

    (unless (file-accessible-directory-p backup-dir)
      (make-directory backup-dir))

    (dired-copy-file source-dir backup-dir flag)

    (message "Backup copy \"%s\" to \"%s\" (%s)" source-dir backup-dir (current-time-string))))

(advice-add 'package-delete :before 'package-delete-save)

(provide 'package-delete-save)
;; fin.