Function: file-relative-name

file-relative-name is a byte-compiled function defined in files.el.gz.

Signature

(file-relative-name FILENAME &optional DIRECTORY)

Documentation

Convert FILENAME to be relative to DIRECTORY (default: default-directory).

This function returns a relative file name that is equivalent to FILENAME when used with that default directory as the default. If FILENAME is a relative file name, it will be interpreted as existing in default-directory. If FILENAME and DIRECTORY lie on different machines or on different drives on a DOS/Windows machine, it returns FILENAME in expanded form.

Other relevant functions are documented in the file-name group.

Shortdoc

;; file-name
(file-relative-name "/tmp/foo" "/tmp")
    => "foo"

Aliases

f-relative

Source Code

;; Defined in /usr/src/emacs/lisp/files.el.gz
(defun file-relative-name (filename &optional directory)
  "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
This function returns a relative file name that is equivalent to FILENAME
when used with that default directory as the default.
If FILENAME is a relative file name, it will be interpreted as existing in
`default-directory'.
If FILENAME and DIRECTORY lie on different machines or on different drives
on a DOS/Windows machine, it returns FILENAME in expanded form."
  (save-match-data
    (setq directory
	  (file-name-as-directory (expand-file-name (or directory
							default-directory))))
    (setq filename (expand-file-name filename))
    (let ((fremote (file-remote-p filename))
	  (dremote (file-remote-p directory))
	  (fold-case (or (file-name-case-insensitive-p filename)
			 read-file-name-completion-ignore-case)))
      (if ;; Conditions for separate trees
	  (or
	   ;; Test for different filesystems on DOS/Windows
	   (and
	    ;; Should `cygwin' really be included here?  --stef
	    (memq system-type '(ms-dos cygwin windows-nt))
	    (or
	     ;; Test for different drive letters
	     (not (eq t (compare-strings filename 0 2 directory 0 2 fold-case)))
	     ;; Test for UNCs on different servers
	     (not (eq t (compare-strings
			 (progn
			   (if (string-match "\\`//\\([^:/]+\\)/" filename)
			       (match-string 1 filename)
			     ;; Windows file names cannot have ? in
			     ;; them, so use that to detect when
			     ;; neither FILENAME nor DIRECTORY is a
			     ;; UNC.
			     "?"))
			 0 nil
			 (progn
			   (if (string-match "\\`//\\([^:/]+\\)/" directory)
			       (match-string 1 directory)
			     "?"))
			 0 nil t)))))
	   ;; Test for different remote file system identification
	   (not (equal fremote dremote)))
	  filename
        (let ((ancestor ".")
	      (filename-dir (file-name-as-directory filename)))
          (while (not
		  (or (string-prefix-p directory filename-dir fold-case)
		      (string-prefix-p directory filename fold-case)))
            (setq directory (file-name-directory (substring directory 0 -1))
		  ancestor (if (equal ancestor ".")
			       ".."
			     (concat "../" ancestor))))
          ;; Now ancestor is empty, or .., or ../.., etc.
          (if (string-prefix-p directory filename fold-case)
	      ;; We matched within FILENAME's directory part.
	      ;; Add the rest of FILENAME onto ANCESTOR.
	      (let ((rest (substring filename (length directory))))
		(if (and (equal ancestor ".") (not (equal rest "")))
		    ;; But don't bother with ANCESTOR if it would give us `./'.
		    rest
		  (concat (file-name-as-directory ancestor) rest)))
            ;; We matched FILENAME's directory equivalent.
            ancestor))))))