;;; files.el --- file input and output commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1992-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992-2016 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
\f
(defun insert-file-contents-literally (filename &optional visit beg end replace)
"Like `insert-file-contents', but only reads in the file literally.
+See `insert-file-contents' for an explanation of the parameters.
A buffer may be modified in several ways after reading into the buffer,
due to Emacs features such as format decoding, character code
conversion, `find-file-hook', automatic uncompression, etc.
(format-message
"%s: `lexical-binding' at end of file unreliable"
(file-name-nondirectory
- (or buffer-file-name ""))))))
+ ;; We are called from
+ ;; 'with-temp-buffer', so we need
+ ;; to use 'thisbuf's name in the
+ ;; warning message.
+ (or (buffer-file-name thisbuf) ""))))))
(t
(ignore-errors
(push (cons (if (eq var 'eval)
(error
;; The file's content might be invalid (e.g. have a merge conflict), but
;; that shouldn't prevent the user from opening the file.
- (message "%s error: %s" dir-locals-file (error-message-string err))
+ (message ".dir-locals error: %s" (error-message-string err))
nil))))
(defun dir-locals-set-directory-class (directory class &optional mtime)
applied by recursively following these rules."
(setf (alist-get class dir-locals-class-alist) variables))
-(defconst dir-locals-file ".dir-locals*.el"
- "Pattern for files that contain directory-local variables.
-It has to be constant to enforce uniform values across different
-environments and users.
-
-Multiple dir-locals files in the same directory are loaded in
-`string<' order.
-See Info node `(elisp)Directory Local Variables' for details.")
-
-(defun dir-locals--all-files (file-or-dir)
- "Return a list of all readable dir-locals files matching FILE-OR-DIR.
-If FILE-OR-DIR is a file pattern, expand wildcards in it and
-return a sorted list of the results. If it is a directory name,
-return a sorted list of all files matching `dir-locals-file' in
-this directory.
-The returned list is sorted by `string<' order."
- (require 'seq)
- (let ((default-directory (if (file-directory-p file-or-dir)
- file-or-dir
- default-directory)))
- (seq-filter (lambda (f) (and (file-readable-p f)
- (file-regular-p f)))
- (file-expand-wildcards
- (cond ((not (file-directory-p file-or-dir)) file-or-dir)
- ((eq system-type 'ms-dos) (dosified-file-name dir-locals-file))
- (t dir-locals-file))
- 'full))))
+(defconst dir-locals-file ".dir-locals.el"
+ "File that contains directory-local variables.
+It has to be constant to enforce uniform values
+across different environments and users.")
(defun dir-locals-find-file (file)
"Find the directory-local variables for FILE.
This function returns either nil (no directory local variables found),
or the matching entry from `dir-locals-directory-cache' (a list),
or the full path to the `dir-locals-file' (a string) in the case
-of no valid cache entry. If `dir-locals-file' contains
-wildcards, then the return value is not a proper filename, it is
-an absolute version of `dir-locals-file' which is guaranteed to
-expand to at least one file."
+of no valid cache entry."
(setq file (expand-file-name file))
- (let* ((locals-dir (locate-dominating-file (file-name-directory file)
- #'dir-locals--all-files))
- locals-file dir-elt)
+ (let* ((dir-locals-file-name
+ (if (eq system-type 'ms-dos)
+ (dosified-file-name dir-locals-file)
+ dir-locals-file))
+ (locals-file (locate-dominating-file file dir-locals-file-name))
+ (dir-elt nil))
;; `locate-dominating-file' may have abbreviated the name.
- (when locals-dir
- (setq locals-dir (expand-file-name locals-dir))
- (setq locals-file (expand-file-name (if (eq system-type 'ms-dos)
- (dosified-file-name dir-locals-file)
- dir-locals-file)
- locals-dir)))
+ (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 (string-prefix-p (car elt) file
- (memq system-type
- '(windows-nt cygwin ms-dos)))
- (> (length (car elt)) (length (car dir-elt))))
- (setq dir-elt elt)))
+ (memq system-type
+ '(windows-nt cygwin ms-dos)))
+ (> (length (car elt)) (length (car dir-elt))))
+ (setq dir-elt elt)))
(if (and dir-elt
- (or (null locals-dir)
- (<= (length locals-dir)
- (length (car dir-elt)))))
- ;; Found a potential cache entry. Check validity.
- ;; A cache entry with no MTIME is assumed to always be valid
- ;; (ie, set directly, not from a dir-locals file).
- ;; Note, we don't bother to check that there is a matching class
- ;; element in dir-locals-class-alist, since that's done by
- ;; dir-locals-set-directory-class.
- (if (or (null (nth 2 dir-elt))
- (let ((cached-files (dir-locals--all-files (car dir-elt))))
- ;; The entry MTIME should match the most recent
- ;; MTIME among matching files.
- (and cached-files
- (= (time-to-seconds (nth 2 dir-elt))
- (apply #'max (mapcar (lambda (f) (time-to-seconds (nth 5 (file-attributes f))))
- cached-files))))))
- ;; This cache entry is OK.
- dir-elt
- ;; This cache entry is invalid; clear it.
- (setq dir-locals-directory-cache
- (delq dir-elt dir-locals-directory-cache))
- ;; Return the first existing dir-locals file. Might be the same
- ;; as dir-elt's, might not (eg latter might have been deleted).
- locals-file)
+ (or (null locals-file)
+ (<= (length (file-name-directory locals-file))
+ (length (car dir-elt)))))
+ ;; Found a potential cache entry. Check validity.
+ ;; A cache entry with no MTIME is assumed to always be valid
+ ;; (ie, set directly, not from a dir-locals file).
+ ;; Note, we don't bother to check that there is a matching class
+ ;; element in dir-locals-class-alist, since that's done by
+ ;; dir-locals-set-directory-class.
+ (if (or (null (nth 2 dir-elt))
+ (let ((cached-file (expand-file-name dir-locals-file-name
+ (car dir-elt))))
+ (and (file-readable-p cached-file)
+ (equal (nth 2 dir-elt)
+ (nth 5 (file-attributes cached-file))))))
+ ;; This cache entry is OK.
+ dir-elt
+ ;; This cache entry is invalid; clear it.
+ (setq dir-locals-directory-cache
+ (delq dir-elt dir-locals-directory-cache))
+ ;; Return the first existing dir-locals file. Might be the same
+ ;; as dir-elt's, might not (eg latter might have been deleted).
+ locals-file)
;; No cache entry.
locals-file)))
(defun dir-locals-read-from-file (file)
"Load a variables FILE and register a new class and instance.
-FILE is the absolute name of the file holding the variables to
-apply. It may contain wildcards.
+FILE is the name of the file holding the variables to apply.
The new class name is the same as the directory in which FILE
is found. Returns the new class name."
- (require 'map)
- (let* ((dir-name (file-name-directory file))
- (class-name (intern dir-name))
- (files (dir-locals--all-files file))
- (read-circle nil)
- (success nil)
- (variables))
+ (with-temp-buffer
(with-demoted-errors "Error reading dir-locals: %S"
- (dolist (file files)
- (with-temp-buffer
- (insert-file-contents file)
- (condition-case-unless-debug nil
- (setq variables
- (map-merge-with 'list (lambda (a b) (map-merge 'list a b))
- variables
- (read (current-buffer))))
- (end-of-file nil))))
- (setq success t))
- (dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class
- dir-name class-name
- (seconds-to-time
- (if success
- (apply #'max (mapcar (lambda (file)
- (time-to-seconds (nth 5 (file-attributes file))))
- files))
- ;; If there was a problem, use the values we could get but
- ;; don't let the cache prevent future reads.
- 0)))
- class-name))
+ (insert-file-contents file)
+ (unless (zerop (buffer-size))
+ (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)))))
(defcustom enable-remote-dir-locals nil
"Non-nil means dir-local variables will be applied to remote files."
(not (file-remote-p (or (buffer-file-name)
default-directory)))))
;; Find the variables file.
- (let ((file-pattern-or-cache (dir-locals-find-file
- (or (buffer-file-name) default-directory)))
+ (let ((variables-file (dir-locals-find-file
+ (or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
- ((stringp file-pattern-or-cache)
- (setq dir-name (file-name-directory file-pattern-or-cache)
- class (dir-locals-read-from-file file-pattern-or-cache)))
- ((consp file-pattern-or-cache)
- (setq dir-name (nth 0 file-pattern-or-cache))
- (setq class (nth 1 file-pattern-or-cache))))
+ ((stringp variables-file)
+ (setq dir-name (file-name-directory variables-file)
+ class (dir-locals-read-from-file variables-file)))
+ ((consp variables-file)
+ (setq dir-name (nth 0 variables-file))
+ (setq class (nth 1 variables-file))))
(when class
(let ((variables
(dir-locals-collect-variables
(defun file-name-sans-extension (filename)
"Return FILENAME sans final \"extension\".
-The extension, in a file name, is the part that follows the last `.',
-except that a leading `.', if any, doesn't count."
+The extension, in a file name, is the part that begins with the last `.',
+except that a leading `.' of the file name, if there is one, doesn't count."
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename)))
directory)
(defun file-name-extension (filename &optional period)
"Return FILENAME's final \"extension\".
-The extension, in a file name, is the part that follows the last `.',
-excluding version numbers and backup suffixes,
-except that a leading `.', if any, doesn't count.
+The extension, in a file name, is the part that begins with the last `.',
+excluding version numbers and backup suffixes, except that a leading `.'
+of the file name, if there is one, doesn't count.
Return nil for extensionless file names such as `foo'.
Return the empty string for file names such as `foo.'.
-If PERIOD is non-nil, then the returned value includes the period
-that delimits the extension, and if FILENAME has no extension,
-the value is \"\"."
+By default, the returned value excludes the period that starts the
+extension, but if the optional argument PERIOD is non-nil, the period
+is included in the value, and in that case, if FILENAME has no
+extension, the value is \"\"."
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename))))
(if (and (string-match "\\.[^.]*\\'" file)
\f
(defun clear-visited-file-modtime ()
"Clear out records of last mod time of visited file.
-Next attempt to save will certainly not complain of a discrepancy."
+Next attempt to save will not complain of a discrepancy."
(set-visited-file-modtime 0))
(defun not-modified (&optional arg)
PATTERN is assumed to represent a file-name wildcard suitable for the
underlying filesystem. For Unix and GNU/Linux, each character from the
-set [ \\t\\n;<>&|()`'\"#$] is quoted with a backslash; for DOS/Windows, all
+set [ \\t\\n;<>&|()\\=`\\='\"#$] is quoted with a backslash; for DOS/Windows, all
the parts of the pattern which don't include wildcard characters are
quoted with double quotes.
(setq error-lines (nreverse error-lines))
;; Now read the numeric positions of file names.
(goto-char linebeg)
- (forward-word 1)
+ (forward-word-strictly 1)
(forward-char 3)
(while (< (point) end)
(let ((start (insert-directory-adj-pos
(cond ((= char ?r) #o0444)
((= char ?w) #o0222)
((= char ?x) #o0111)
- ((= char ?s) #o1000)
- ((= char ?t) #o6000)
+ ((= char ?s) #o6000)
+ ((= char ?t) #o1000)
;; Rights relative to the previous file modes.
((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
((= char ?u) (let ((uright (logand #o4700 from)))
(mapcar 'file-modes-char-to-who
(match-string 1 modes)))))
(when (= num-who 0)
- (setq num-who (default-file-modes)))
+ (setq num-who (logior #o7000 (default-file-modes))))
(setq num-modes
(file-modes-rights-to-number (substring modes (match-end 1))
num-who num-modes)