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
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)
;; During bootstrap, it can happen that
;; `read-file-name-completion-ignore-case' is
;; not defined yet.
;; FIXME: `read-file-name-completion-ignore-case' is
;; a user-config which we shouldn't trust to reflect
;; the actual file system's semantics.
(and (boundp 'read-file-name-completion-ignore-case)
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 (string-equal-ignore-case
(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.
"?")
(if (string-match "\\`//\\([^:/]+\\)/" directory)
(match-string 1 directory)
"?")))))
;; 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))))))