Re: Backup Blacklist

["Juanma Barranquero" <lekktu@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 208 bytes --]

On 1/3/07, Juanma Barranquero <lekktu@gmail.com> wrote:

I've put it all in a package (lightly tested, BTW). Hope it helps, and
hope the docstrings are documentation enough :)

                    /L/e/k/t/u

[-- Attachment #2: backup-exclude.el --]
[-- Type: application/octet-stream, Size: 5859 bytes --]

;;; backup-exclude.el --- exclude individual files from backup

;; Copyright (C) 2007 Juanma Barranquero
;; Author: Juanma Barranquero <lekktu@gmail.com>
;; Keywords: backup

;; This file is not yet part of GNU Emacs.

;; GNU Emacs 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 2, or (at your option)
;; any later version.

;; GNU Emacs 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

(eval-when-compile (require 'cl))
(require 'regexp-opt)

(defgroup backup-exclude nil
  "Exclude files from backup."
  :group 'emacs)

;; Internal
(defvar bex-mode nil)
(defvar bex-previous-backup-predicate nil)

(defcustom bex-save-file "~/.emacs.d/backup-exclusions"
  "File to save the backup exclusion list.
Set to nil to deactivate saving of the exclusion list."
  :type '(choice file (const :tag "None" nil))
  :set #'(lambda (sym val)
           (set-default sym val)
           (when bex-mode
             (if val
                 (add-hook 'emacs-kill-hook 'bex-save-exclusions)
               (remove-hook 'emacs-kill-hook 'bex-save-exclusions))))
  :group 'backup-exclude)

(defcustom bex-case-fold-search case-fold-search
  "Whether to ignore case when matching files in the exclusion list."
  :type 'boolean
  :group 'backup-exclude)

(defun bex-exclude-files (&rest files)
  "Exclude from backup all filenames in FILES.
They must be absolute paths.
Other files are passed to the function previously pointed by
`backup-enable-predicate', so it is still possible for them
to be excluded anyway."
  (let ((excluded (get 'backup-exclude :files)))
    (when files
      (mapc #'(lambda (file)
                (unless (file-name-absolute-p file)
                  (error "%s is not an absolute filename" file))
                (pushnew (expand-file-name file) excluded :test #'equal))
            files)
      (put 'backup-exclude :files excluded))
    ;; Recompute the regexp cache
    (put 'backup-exclude :regexp (and excluded
                                      (concat "^" (regexp-opt excluded) "$")))))

(defun bex-exclude-file-from-backup (&optional file)
  "Exclude FILE from backup.
Defaults to the current buffer's visited file, if any."
  (interactive (list (read-file-name "File to exclude from backup: " nil nil t
                                     (file-name-nondirectory buffer-file-name))))
  (bex-exclude-files file))

(defun bex-remove-exclusion (&rest files)
  "Remove FILES from the backup exclusion list.
They are still passed to the function previously pointed by
`backup-enable-predicate', so it is still possible for them
to be excluded anyway."
  (let ((excluded (get 'backup-exclude :files)))
    (mapc #'(lambda (file)
              (setq excluded (delete (expand-file-name file) excluded)))
          files)
    (put 'backup-exclude :files excluded)
    (bex-exclude-files)))

(defun bex-enable-predicate (file)
  "Alternate `backup-enable-predicate' function that excludes from
backups those files registered with `bex-exclude-files' or
`bex-exclude-file-from-backup'."
  (let ((regexp (get 'backup-exclude :regexp)))
    (if (and regexp
             (let ((case-fold-search bex-case-fold-search))
               (string-match regexp (expand-file-name file))))
        nil
      (funcall bex-previous-backup-predicate file))))

(defun bex-save-exclusions ()
  "Save the backup exclusion list in file `bex-save-file' (which see).
This function is intended to be called from `emacs-kill-hook'."
  (let ((dir (file-name-directory bex-save-file)))
    (unless (file-directory-p dir) (make-directory dir t)))
  (with-temp-file bex-save-file
    (insert ";; backup-exclude save file\n;; version: 1.0\n(bex-exclude-files ")
    (mapc #'(lambda (file)
              (insert (format "  \"%s\"\n" file)))
          (get 'backup-exclude :files))
    (insert ")\n")))

(defun bex-restore-exclusions ()
  "Restore the backup exclusion list from file `bex-save-file' (which see).
This function is intended to be called from your `.emacs'."
  (when (file-exists-p bex-save-file)
    (load-file bex-save-file)))

(defun bex-mode (&optional arg)
  "Toggle BEX (backup exclusion) mode.
When active, files excluded through `bex-exclude-files' and
`bex-exclude-file-from-backup' are not backed up.
With ARG, set BEX mode on iff ARG is positive, off otherwise."
  (interactive "P")
  (setq arg (if (null arg)
                (not bex-mode)
              (> (prefix-numeric-value arg) 0)))
  (cond ((eq arg bex-mode)
         (message "No change"))
        ((setq bex-mode arg)
         (setq bex-previous-backup-predicate backup-enable-predicate)
         (setq backup-enable-predicate 'bex-enable-predicate)
         (when bex-save-file
           (add-hook 'emacs-kill-hook 'bex-save-exclusions))
         (message "Backup exclusion active"))
        ((eq backup-enable-predicate 'bex-enable-predicate)
         (setq backup-enable-predicate bex-previous-backup-predicate)
         (setq bex-previous-backup-predicate nil)
         (remove-hook 'emacs-kill-hook 'bex-save-exclusions)
         (message "Backup exclusion inactive"))
        (t (error "`backup-enable-predicate' has been hijacked."))))

(provide 'backup-exclude)

;; end of backup-exclude.el

[-- Attachment #3: Type: text/plain, Size: 152 bytes --]

_______________________________________________
help-gnu-emacs mailing list
help-gnu-emacs@gnu.org
http://lists.gnu.org/mailman/listinfo/help-gnu-emacs