;;; Commentary:
-;; Defines most of Emacs's file- and directory-handling functions,
+;; Defines most of Emacs'ss file- and directory-handling functions,
;; including basic file visiting, backup generation, link handling,
;; ITS-id version control, load- and write-hook handling, and the like.
(defun locate-dominating-file (file name)
"Look up the directory hierarchy from FILE for a file named NAME.
Stop at the first parent directory containing a file NAME,
-and return the directory. Return nil if not found."
+and return the directory. Return nil if not found.
+
+This function only tests if FILE exists. If you care about whether
+it is readable, regular, etc., you should test the result."
;; We used to use the above locate-dominating-files code, but the
;; directory-files call is very costly, so we're much better off doing
;; multiple calls using the code in here.
;; (setq user (nth 2 (file-attributes file)))
;; (and prev-user (not (equal user prev-user))))
(string-match locate-dominating-stop-dir-regexp file)))
+ ;; FIXME? maybe this function should (optionally?)
+ ;; use file-readable-p instead. In many cases, an unreadable
+ ;; FILE is no better than a non-existent one.
+ ;; See eg dir-locals-find-file.
(setq try (file-exists-p (expand-file-name name file)))
(cond (try (setq root file))
((equal file (setq file (file-name-directory
When a file is visited, the file's class is found. A directory
may be assigned a class using `dir-locals-set-directory-class'.
Then variables are set in the file's buffer according to the
-class' LIST. The list is processed in order.
+VARIABLES list of the class. The list is processed in order.
* If the element is of the form (MAJOR-MODE . ALIST), and the
buffer's major mode is derived from MAJOR-MODE (as determined
(locals-file (locate-dominating-file file dir-locals-file-name))
(dir-elt nil))
;; `locate-dominating-file' may have abbreviated the name.
- (if locals-file
- (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
+ (and locals-file
+ (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
+ ;; Let dir-locals-read-from-file inform us via demoted-errors
+ ;; about unreadable files, etc.
+ ;; Maybe we'd want to keep searching though - that is
+ ;; a locate-dominating-file issue.
+;;; (or (not (file-readable-p locals-file))
+;;; (not (file-regular-p locals-file)))
+;;; (setq locals-file nil))
;; Find the best cached value in `dir-locals-directory-cache'.
(dolist (elt dir-locals-directory-cache)
(when (and (eq t (compare-strings file nil (length (car elt))
The new class name is the same as the directory in which FILE
is found. Returns the new class name."
(with-temp-buffer
- (insert-file-contents file)
- (let* ((dir-name (file-name-directory file))
- (class-name (intern dir-name))
- (variables (let ((read-circle nil))
- (read (current-buffer)))))
- (dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class dir-name class-name
- (nth 5 (file-attributes file)))
- class-name)))
+ ;; This is with-demoted-errors, but we want to mention dir-locals
+ ;; in any error message.
+ (let (err)
+ (condition-case err
+ (progn
+ (insert-file-contents file)
+ (let* ((dir-name (file-name-directory file))
+ (class-name (intern dir-name))
+ (variables (let ((read-circle nil))
+ (read (current-buffer)))))
+ (dir-locals-set-class-variables class-name variables)
+ (dir-locals-set-directory-class dir-name class-name
+ (nth 5 (file-attributes file)))
+ class-name))
+ (error (message "Error reading dir-locals: %S" err) nil)))))
(defun hack-dir-local-variables ()
"Read per-directory local variables for the current buffer.
directory 'full directory-files-no-dot-files-regexp)))
(delete-directory-internal directory)))))
-(defun files-equal-p (file1 file2)
- "Return non-nil if FILE1 and FILE2 name the same file."
- (let ((handler (or (find-file-name-handler file1 'files-equal-p)
- (find-file-name-handler file2 'files-equal-p))))
+(defun file-equal-p (file1 file2)
+ "Return non-nil if files FILE1 and FILE2 name the same file.
+If FILE1 or FILE2 does not exist, the return value is unspecified."
+ (let ((handler (or (find-file-name-handler file1 'file-equal-p)
+ (find-file-name-handler file2 'file-equal-p))))
(if handler
- (funcall handler 'files-equal-p file1 file2)
- (equal (file-attributes (file-truename file1))
- (file-attributes (file-truename file2))))))
-
-(defun file-subdir-of-p (dir1 dir2)
- "Return non-nil if DIR1 is a subdirectory of DIR2.
-Note that a directory is treated by this function as a subdirectory of itself.
-This function only works when its two arguments already exist,
-when they don't, it returns nil."
- (let ((handler (or (find-file-name-handler dir1 'file-subdir-of-p)
- (find-file-name-handler dir2 'file-subdir-of-p))))
+ (funcall handler 'file-equal-p file1 file2)
+ (let (f1-attr f2-attr)
+ (and (setq f1-attr (file-attributes (file-truename file1)))
+ (setq f2-attr (file-attributes (file-truename file2)))
+ (equal f1-attr f2-attr))))))
+
+(defun file-in-directory-p (file dir)
+ "Return non-nil if FILE is in DIR or a subdirectory of DIR.
+A directory is considered to be \"in\" itself.
+Return nil if DIR is not an existing directory."
+ (let ((handler (or (find-file-name-handler file 'file-in-directory-p)
+ (find-file-name-handler dir 'file-in-directory-p))))
(if handler
- (funcall handler 'file-subdir-of-p dir1 dir2)
- (when (and (file-directory-p dir1)
- (file-directory-p dir2))
- (loop with f1 = (file-truename dir1)
- with f2 = (file-truename dir2)
- with ls1 = (or (split-string f1 "/" t) (list "/"))
- with ls2 = (or (split-string f2 "/" t) (list "/"))
- for p = (string-match "^/" f1)
- for i in ls1
- for j in ls2
- when (string= i j)
- concat (if p (concat "/" i) (concat i "/"))
- into root
- finally return
- (files-equal-p (file-truename root) f2))))))
+ (funcall handler 'file-in-directory-p file dir)
+ (when (file-directory-p dir) ; DIR must exist.
+ (setq file (file-truename file)
+ dir (file-truename dir))
+ (let ((ls1 (split-string file "/" t))
+ (ls2 (split-string dir "/" t))
+ (root (if (string-match "\\`/" file) "/" ""))
+ (mismatch nil))
+ (while (and ls1 ls2 (not mismatch))
+ (if (string-equal (car ls1) (car ls2))
+ (setq root (concat root (car ls1) "/"))
+ (setq mismatch t))
+ (setq ls1 (cdr ls1)
+ ls2 (cdr ls2)))
+ (unless mismatch
+ (file-equal-p root dir)))))))
(defun copy-directory (directory newname &optional keep-time parents copy-contents)
"Copy DIRECTORY to NEWNAME. Both args must be strings.
(format "Copy directory %s to: " dir)
default-directory default-directory nil nil)
current-prefix-arg t nil)))
- (when (file-subdir-of-p newname directory)
+ (when (file-in-directory-p newname directory)
(error "Cannot copy `%s' into its subdirectory `%s'"
directory newname))
;; If default-directory is a remote directory, make sure we find its
(cond ((not (file-directory-p newname))
;; If NEWNAME is not an existing directory, create it;
;; that is where we will copy the files of DIRECTORY.
- (make-directory newname parents)
- ;; `file-subdir-of-p' doesn't handle non--existing directories,
- ;; so double check now if NEWNAME is not a subdir of DIRECTORY.
- (and (file-subdir-of-p newname directory)
- (error "Cannot copy `%s' into its subdirectory `%s'"
- directory newname)))
+ (make-directory newname parents))
;; If NEWNAME is an existing directory and COPY-CONTENTS
;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
((not copy-contents)
;; We do not want to copy "." and "..".
(directory-files directory 'full
directory-files-no-dot-files-regexp))
- (if (file-directory-p file)
- (copy-directory file newname keep-time parents)
- (let ((target (expand-file-name (file-name-nondirectory file) newname))
- (attrs (file-attributes file)))
- (if (stringp (car attrs)) ; Symbolic link
- (make-symbolic-link (car attrs) target t)
- (copy-file file target t keep-time)))))
+ (let ((target (expand-file-name (file-name-nondirectory file) newname))
+ (filetype (car (file-attributes file))))
+ (cond
+ ((eq filetype t) ; Directory but not a symlink.
+ (copy-directory file newname keep-time parents))
+ ((stringp filetype) ; Symbolic link
+ (make-symbolic-link filetype target t))
+ ((copy-file file target t keep-time)))))
;; Set directory attributes.
(let ((modes (file-modes directory))
(unlock-buffer)))
(widen)
(let ((coding-system-for-read
- ;; Auto-saved file should be read by Emacs'
+ ;; Auto-saved file should be read by Emacs's
;; internal coding.
(if auto-save-p 'auto-save-coding
(or coding-system-for-read
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.
-With prefix ARG, silently save all file-visiting buffers, then kill."
+With prefix ARG, silently save all file-visiting buffers without asking.
+If there are active processes where `process-query-on-exit-flag'
+returns non-nil, asks whether processes should be killed.
+Runs the members of `kill-emacs-query-functions' in turn and stops
+if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(interactive "P")
(save-some-buffers arg t)
(and (or (not (memq t (mapcar (function
(new-fn (expand-file-name (file-name-nondirectory fn)
trash-dir)))
;; We can't trash a parent directory of trash-directory.
- (if (string-match fn trash-dir)
+ (if (string-prefix-p fn trash-dir)
(error "Trash directory `%s' is a subdirectory of `%s'"
trash-dir filename))
(unless (file-directory-p trash-dir)
(file-name-directory fn)))
(error "Cannot move %s to trash: Permission denied" filename))
;; The trashed file cannot be the trash dir or its parent.
- (if (string-match fn trash-files-dir)
+ (if (string-prefix-p fn trash-files-dir)
(error "The trash directory %s is a subdirectory of %s"
trash-files-dir filename))
- (if (string-match fn trash-info-dir)
+ (if (string-prefix-p fn trash-info-dir)
(error "The trash directory %s is a subdirectory of %s"
trash-info-dir filename))