ebackup.el

[Kevin A. Burton]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1


... updated for emacs21

;;; ebackup.el --- Enhanced backup operation for Emacs

;; Copyright (C) 1997-2000 Free Software Foundation, Inc.

;; Author: Kevin A. Burton (address@hidden)
;; Maintainer: Kevin A. Burton (address@hidden)
;; Location: http://relativity.yi.org
;; Keywords: backup
;; Version: 1.3.0

;; $Id: ebackup.el,v 1.13 2001/10/21 02:13:41 burton Exp $

;; This file is [not yet] 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 2 of the License, or 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, write to the Free Software Foundation, Inc., 59 Temple
;; Place - Suite 330, Boston, MA 02111-1307, USA.

;;; Commentary:

;; Some lisp magic to add enhanced backup functions basically it mirrors the
;; filesystem that I am editing and copies all new ;; backups into backup
;; directory that you specify.  Default is ~/.backups

;; Should work out of the box.  All you really need to do is add this to your
;; lisp load path and do a (require 'ebackup).  You should also read the backups
;; section of the GNU Emacs manual to determine how to turn this on.

;; Note: Emacs21 also includes numbered backup files but it isn't as advanced as
;; ebackup (it doesnt include directory structure).

;;; Design:
;;
;; This just disables the native Emacs file backup system and hooks itself into
;; the file save system.  Everytime you save a file, ebackup determines if it
;; should take a backup.

;;; Install:
;;
;; Need to do a (require 'ebackup)
;;
;; Tell emacs to turn on backups:
;;
;;  (setq make-backup-files t)
;;  (setq vc-make-backup-files t) ;; this really isn't needed if you commit to
;;  version control often which *you should*!
;;

;;; TODO:

;;; History
;;
;; - Tue Oct 16 2001 05:52 PM (address@hidden): Just labeled this
;;   version 1.3.0.  Seems to work fine.
;;
;; - Tue Oct 16 2001 05:52 PM (address@hidden): keep a log of what is
;;   going on.  This can also be used for debugging.
;;
;; - Wed Dec 20 00:09:00 2000 (burton): (version 1.1) added support for multiple
;;   revisions.
;;
;; - Wed Dec 2 00:10:04 2000 (burton): (version 1.0) init

;;; Code:
(defvar ebackup-max-copies 10 "The maximum number of backup copies to keep 
around.")

(defvar ebackup-destination-dir "~/.emacs-backup" "The destination director to 
store backups.")
(if (not (file-exists-p ebackup-destination-dir))
    (make-directory ebackup-destination-dir))

(defvar ebackup-log nil "If true, we will log all backup operations.")

(defvar ebackup-current-file-backed-up nil "True if this file has been backed 
up at least once.")
(make-variable-buffer-local 'ebackup-current-file-backed-up)

(defvar ebackup-log-message "*ebackup-log-message*" "The buffer name to use for 
logging operations.")

(defun ebackup-make-backup()
  "Make a backup from the current buffer."
  
  (ebackup-make-backup-file-name (buffer-file-name (current-buffer))))

;;need to replace the system 'make-backup-file-name' lisp with a new function
;;to determine a better filename.
(defun ebackup-make-backup-file-name(file)
  "Create the file name for `file'."

  (if (not ebackup-current-file-backed-up)
      (let(backup-filename)

        (setq ebackup-current-file-backed-up t)
        
        (ebackup-log (format "Backing up file: %s \n" file))
        
        ;;first... use the absolute file-name so that we don't have duplicate 
entries
        ;;which are caused by symlinks.
        
        (setq backup-filename (subst-char-in-string ?: ?_ (file-truename file)))
        
        ;;determine the filename to use...
        (setq backup-filename (concat ebackup-destination-dir file))

        ;;make the parent directory if it doesn't exist
        (let(parent)
          (setq parent (file-name-directory backup-filename))
          ;;now prune the name from the path and make its parent directory
          (make-directory parent t))

        (ebackup-rotate backup-filename)
        (setq backup-filename (concat backup-filename ".1"))

        (ebackup-log (format "Backing up file %s as %s \n" file 
backup-filename))

        (copy-file file backup-filename t t))))

(defun ebackup-rotate(backup-file)
  "Given a specific file name ... rotate through all possible entries and move
them down one number.  This is a fairly fast backup system because we rename the
files."
  ;;variable backup-file should be the full path to the file without any 
version number.

  ;;remove the last possible backup file.
  (let(last-file)

    (setq last-file (concat backup-file "." (number-to-string 
ebackup-max-copies)))

    (if (file-exists-p last-file)
        (delete-file last-file)))

  ;;cycle from ebackup-max-copies-1 until 1 renaming files as we go..
  ;;Example: 9 -> 10
  ;;         8 -> 9
  ;;         7 -> 8
  (let(i)
    (setq i (1- ebackup-max-copies))
    (while (>= i 1)
      
      (let(last-file next-file)

        (setq last-file (concat backup-file "." (number-to-string i)))
        (setq next-file (concat backup-file "." (number-to-string (1+ i))))
        (if (file-exists-p last-file)
            (rename-file last-file next-file)))
      
      (setq i (1- i)))))

(defun ebackup-log(message)
  "Log the given message if logging is enabled."

  (if ebackup-log
      (save-excursion

        (set-buffer (get-buffer-create ebackup-log-message))

        (end-of-buffer)

        (insert message))))

(defun toggle-ebackup-log()
  "Toggle use of the ebackup log."
  (interactive)
  
  (if ebackup-log
      (progn
        (message "ebackup log is now disabled.")
        (setq ebackup-log nil))
    (progn
      (message "ebackup log is now enabled.")
      (setq ebackup-log t))))

(defun toggle-ebackup-current-file-backed-up()
  "Toggle use of ebackups for the current buffer."
  (interactive)
  
  (if ebackup-current-file-backed-up
      (progn
        (message "file now marked as NOT backed up..")
        (setq ebackup-current-file-backed-up nil))
    (progn
      (message "file now marked as backed up.")
      (setq ebackup-current-file-backed-up t))))

;disable the normal emacs backup system
(setq make-backup-file-name-function nil)
(setq make-backup-files nil)
(setq vc-make-backup-files nil)

;;but make sure files are precious.
(setq file-precious-flag t)

(setq backup-inhibited t)

(setq version-control 'never)

(add-hook 'after-save-hook 'ebackup-make-backup)

(provide 'ebackup)

;;; ebackup.el ends here

- -- 
  Need a good Engineer?  Hire me!  ( Java | P2P | XML | Linux | Open Source )

                      http://relativity.yi.org/bio/

Kevin A. Burton ( address@hidden, address@hidden, address@hidden )
             Location - San Francisco, CA, Cell - 415.595.9965
        Jabber - address@hidden,  Web - http://relativity.yi.org

Don't by Apple products!.  'Think Different' indeed.

  Apple Threatens Open Source Theme Project - 
http://slashdot.org/article.pl?sid=01/04/17/1628228&mode=thread
  Apple moves to again to squash look-alikes. - 
http://slashdot.org/articles/01/02/03/1926203.shtml
  Themes removed at Apples behest. - 
http://slashdot.org/articles/00/12/14/1245216.shtml
  Apple Advertises '1-click' licensing. - 
http://slashdot.org/article.pl?sid=00/10/01/0015226&mode=thread
  Apple sues to stop leaks. - 
http://slashdot.org/article.pl?sid=00/08/03/0120240&mode=thread

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.0.6 (GNU/Linux)
Comment: Get my public key at: http://relativity.yi.org/pgpkey.txt

iD8DBQE73f4rAwM6xb2dfE0RAgphAJ0TK+KeyFVox2igXrEcWqy+kFDfEgCgvCjU
Ep72/RQKhFiegotEr/vPq/E=
=3WLF
-----END PGP SIGNATURE-----