Function: make-backup-file-name-1

make-backup-file-name-1 is a byte-compiled function defined in files.el.gz.

Signature

(make-backup-file-name-1 FILE)

Documentation

Subroutine of make-backup-file-name--default-function.

The function find-backup-file-name also uses this.

Source Code

;; Defined in /usr/src/emacs/lisp/files.el.gz
(defun make-backup-file-name-1 (file)
  "Subroutine of `make-backup-file-name--default-function'.
The function `find-backup-file-name' also uses this."
  (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)
	  (progn
	    (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
              (cond
               ((file-remote-p file)
                ;; Remove the leading slash, if any, to prevent
                ;; convert-standard-filename from converting that to a
                ;; backslash.
                (and (memq (aref file 0) '(?/ ?\\))
                     (setq file (substring file 1)))
                ;; Replace any invalid file-name characters, then
                ;; prepend the leading slash back.
                (setq file (concat "/" (convert-standard-filename file))))
               (t
                ;; Replace any invalid file-name characters.
                (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
	      ?/ ?!
	      (string-replace "!" "!!" file))
	     backup-directory))
	(expand-file-name (file-name-nondirectory file)
			  (file-name-as-directory abs-backup-directory))))))