martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix file-relative-name to allow for ancestors as well as descendants.

Browse Source
This commit is contained in:
Karl Heuer
1994-02-02 04:39:22 +00:00
parent 1892807a4d
commit b1fa544fda
1 changed files with 5 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
lisp/files.el
View File

@@ -1382,22 +1382,16 @@ Value is a list whose car is the name for the backup file
"Return number of names file FILENAME has."
(car (cdr (file-attributes filename))))
(defun file-relative-name-1 (directory)
(cond ((string= directory "/")
filename)
((string-match (concat "^" (regexp-quote directory))
filename)
(substring filename (match-end 0)))
(t
(file-relative-name-1
(file-name-directory (substring directory 0 -1))))))
(defun file-relative-name (filename &optional directory)
"Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
(setq filename (expand-file-name filename)
directory (file-name-as-directory (expand-file-name
(or directory default-directory))))
(file-relative-name-1 directory))
(let ((ancestor ""))
(while (not (string-match (concat "^" (regexp-quote directory)) filename))
(setq directory (file-name-directory (substring directory 0 -1))
ancestor (concat "../" ancestor)))
(concat ancestor (substring filename (match-end 0)))))
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.