USER-DEFINED BACKUP FILE NAMING proposed changes to files.el

[David McCracken]

The auto-save-file-name-transforms only works for auto-save files. I 
propose a similar facility for backup file naming. Additionally, my 
proposal addresses some shortcomings of the existing 
auto-save-file-name-transforms.

It has been pointed out that using the entire path and name of a file to 
create a file name risks creating a name that exceeds the limits of the 
OS. One way to reduce the likelihood of this is to define a transform 
using only pieces of the path. For example,
("\\(.:\\)*\\(\\([^/]*\\)/\\)*\\(.+\\)" "~/bak/\\3!\\4")
creates userHome/bak/lastDir!fileName. However, this may not be 
sufficiently distinctive. For example, vers1/src/file.cfg and 
vers2/src/file.cfg would have the same auto-save/backup file. The 
chances of a collision could be reduced significantly without going to 
the extreme of full path name by including additional pieces of the 
path. Elisp regular expressions cannot generally do this because they 
support back reference only to the last instance of a repeating clause 
("\\3" in the example refers to the last directory in the path).

I propose both a general solution and specific options that should prove 
useful. In general, the user can select one of several built-in 
transform modes. The specific modes that I have implemented are 
combinations of full directory names and just the first two characters. 
For example, one mode uses the full first and last directory names with 
just the first two characters of each intervening directory.

Another problem mentioned by some users is that the ! used as directory 
separator may confuse other programs. My proposal addresses this by 
allowing any character to be selected for the separator. The selectable 
transform mode and separator are merged into a variant of the transform 
replacement regular expression. If the first character's ordinal is less 
than 10 then it selects a transform mode, the next character is the 
separator, and the remainder is the backup root directory.

This is implemented by adding two functions to files.el and slightly 
modifying the existing make-backup-file-name-1 function. The transform 
list backup-file-name-transforms is specifically for backup files. It is 
similar to auto-save-file-name-transforms but doesn't use the optional 
third nil/t list element. The new functions are unaware of a distinction 
between backup and auto-save and could be used for both, in which case a 
single transform list could be used. This would require modifying the 
make-auto-save-file-name function. To test my code, I copied 
make-backup-file-name-1 from the source version downloaded from savannah 
2009-07-20 (as of 2009-07-27 this function has not changed). I have 
tested deep and shallow paths under Fedora 10 and XP.

                                                        files.el
(setq backup-file-name-transforms
`((".*" "\4%~/bak/"))) ; userHome%bak%firstDir%lastDir%fileName
;`(("\\(.:\\)*\\(\\([^/]*\\)/\\)*\\(.+\\)" "~/bak/\\3-\\4"))) ; 
userHome/bak/lastDir-fileName

;---------------------------- files-make-user-back-tm 
--------------------------
; Purpose: subroutine of files-make-user-back-name. Synthesize backup name
; according to selected transform mode. This supports transforms that 
cannot be
; defined by regular expression.
; Returns: string backup file name
; Arguments:
;- file is string actual file+path
;- repl string defines the replacement. This is the second item in a 
transform
; list. The first character is a small literal integer (e.g. 0, not '0') 
which
; selects the mode. The second character is the path separator. The 
remainder is
; the path to the backup directory root. For all transform modes, the 
name is
; composed from the given root path + a mode-specific string derived 
from the
; real file path + the file name.
; The mode-specific strings are (by mode):
; 0 = empty, i.e. the name is path+sep+fileName
; For all other modes under DOS/Windows the unembellished drive letter 
is always
; included.
; 1 = first two chars of each dir
; 2 = lastDir
; 3 = first two chars of each dir + lastDir
; 4 = firstDir + lastDir
; 5 = firstDir + first two chars of each dir + lastDir
; Modes 0 and 2 are for convenience, as the same result could be achieve 
with
; standard regular expressions.
;...............................................................................
(defun files-make-user-back-tm ( file repl )
   (let ( (tm (string-to-char repl))
      (pathSep (substring repl 1 2))
      (path (substring repl 2))
      (last -1)
      (nextIdx 0)
      cnt name sep )

   ;; Determine the index of the last directory in the file path.
   (set-match-data nil t)
   (while (string-match "\\(.:\\)*\\(\\([^/]*\\)/\\)" file (match-end 0))
       (setq last (1+ last)))

   ;; Get the file name
   (string-match ".*" file (match-end 0))
   (setq name (match-string 0 file))

   ;; If transform mode 0 then return simple path + name. Else rescan file
   ;; string to build more complex path name.
   (if (> tm 0)
       (progn
       (set-match-data nil t)
       (setq cnt 0)
       ;; At cnt 0 under WinDOS see drive letter; under Linux see / so
       ;; the first named directory is always at cnt 1.
       (while (string-match "\\(.:\\)*\\(\\([^/]*\\)/\\)" file 
(match-end 0))
           (cond
           ((match-string 1 file) ; Windows/DOS drive letter.
               (setq path (concat path
                   (substring (match-string 1 file) 0 1 ) pathSep)))

           ((not (string= (match-string 3 file) "")) ; directory name
               (setq sep pathSep) ; Reset default so only blank case 
has to deal with it.
               (setq path (concat path
                (cond
               ;; Full name cases
               ((or (and (= cnt 1) (> tm 3))
                   (and (= cnt last) (> tm 1)))
                   (match-string 3 file))
               ;; Two-char name cases
               ((= 1 (logand 1 tm))(substring (match-string 3 file) 0 2))
               ;; Everything else is no name and no separator (blank case)
               (t (setq sep ""))) ; cond
               sep))) ; cond directory name

           ;; Neither drive nor directory, i.e. must be first / in Unix.
           ) ; cond
           (setq cnt (1+ cnt)))))
   (concat path name)))

;------------------------- files-make-user-back-name 
---------------------------
; Purpose: synthesize a backup file path+name given the real path+name 
and the
; user-defined transform list. This can be used for both backup and autosave
; files, as it does not add the # or ~ characters and the transform list 
is an
; argument. For backup files, the transform list is normally defined by
; backup-file-name-transforms, but that is not a default here. The 
caller must
; provide the argument.
; Returns: string backup file name or nil if none of the transforms 
matches file
; Arguments:
;- file is string actual path+file
;- transforms is list of transform lists, each comprising two regular
; expressions. If the first matches file, the second is used to create the
; backup name. Each transform is tested until a match is found or 
transforms is
; exhausted. The match expression serves two purposes. It enables 
location- or
; file-specific transforms, for example, routing priviledged file 
backups to a
; non-public directory. It also identifies components of file for 
reference by
; the replacement expression. The replacement expression can take two 
general
; forms. If the first character has an ordinal value less than 10, this 
value
; selects a predefined transform mode; the second character will be used 
as a
; path separator; and the remainder is the backup root directory. 
Otherwise,the
; replacement expression is an ordinary RE.
; (("\\(.:\\)*\\(\\([^/]*\\)/\\)*\\(.+\\)" "~/bak/\\3-\\4")) contains
; one transform, which synthesizes the name 
userhome/bak/lastRealDir-fileName.
; ((".*" "\2-~/bak/")) uses transform mode 2 to produce the same results 
under
; Unix but slightly different results, due to drive letter, under 
DOS/Windows.
;...............................................................................
(defun files-make-user-back-name ( file transforms )
   "Subroutine of make-backup-file-name-1"
   ( let (result repl)
   (while (and transforms (not result))
       (if (string-match (car (car transforms)) file)
       (setq result (if (< (string-to-char
                   (setq repl (cadr (car transforms)))) 10)
                (files-make-user-back-tm file repl)
                (replace-match repl t nil file)))) ; if (string-match
       (setq transforms (cdr transforms)))  ; while
   result))  ; defun

(defun make-backup-file-name-1 (file)
   "Subroutine of `make-backup-file-name' and `find-backup-file-name'."
   (let ((alist backup-directory-alist)
        elt backup-directory abs-backup-directory)
   (while alist
       (setq elt (pop alist))
       (if (string-match (car elt) file)
       (setq backup-directory (cdr elt)
           alist nil)))
   ;; If backup-directory is relative, it should be relative to the
   ;; file's directory.  By expanding explicitly here, we avoid
   ;; depending on default-directory.
   (if backup-directory
       (setq abs-backup-directory
       (expand-file-name backup-directory
           (file-name-directory file))))

   (if (and abs-backup-directory (not (file-exists-p 
abs-backup-directory)))
       (condition-case nil
       (make-directory abs-backup-directory 'parents)
       (file-error (setq backup-directory nil
               abs-backup-directory nil))))

   (if (null backup-directory)
       file
       (if (file-name-absolute-p backup-directory)
       (if (boundp 
'backup-file-name-transforms)                          ;;<<<<<
           (setq file (files-make-user-back-name 
file                        ;; <<<<<
                  
backup-file-name-transforms))                                 ;; <<<<<
           ;; else backup-save-file-name-transforms is not defined   ;; 
<<<<<
           (when (memq system-type '(windows-nt ms-dos cygwin))
           ;; Normalize DOSish file names: downcase the drive
           ;; letter, if any, and replace the leading "x:" with
           ;; "/drive_x".
           (or (file-name-absolute-p file)
               (setq file (expand-file-name file))) ; make defaults 
explicit
           ;; Replace any invalid file-name characters (for the
           ;; case of backing up remote files).
           (setq file (expand-file-name (convert-standard-filename file)))
           (if (eq (aref file 1) ?:)
               (setq file (concat "/"
                      "drive_"
                      (char-to-string (downcase (aref file 0)))
                      (if (eq (aref file 2) ?/)
                          ""
                          "/")
                      (substring file 2)))))
           ;; Make the name unique by substituting directory
           ;; separators.  It may not really be worth bothering about
           ;; doubling `!'s in the original name...
           (expand-file-name
           (subst-char-in-string
               ?/ ?!
               (replace-regexp-in-string "!" "!!" file))
           backup-directory))

       (expand-file-name (file-name-nondirectory file)
           (file-name-as-directory abs-backup-directory))))))