diff options
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | lisp/files-x.el | 29 | ||||
-rw-r--r-- | lisp/files.el | 172 | ||||
-rw-r--r-- | lisp/help-fns.el | 43 |
4 files changed, 154 insertions, 91 deletions
diff --git a/.gitignore b/.gitignore index 7f023b70254..fda50e9df77 100644 --- a/.gitignore +++ b/.gitignore @@ -255,6 +255,7 @@ gnustmp* ChangeLog [0-9]*.patch [0-9]*.txt +.dir-locals?.el /vc-dwim-log-* # Built by 'make install'. diff --git a/lisp/files-x.el b/lisp/files-x.el index a130ffcf928..cf9fe914ed4 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -429,18 +429,25 @@ from the MODE alist ignoring the input argument VALUE." (catch 'exit (unless enable-local-variables (throw 'exit (message "Directory-local variables are disabled"))) - (let ((variables-file (or (and (buffer-file-name) - (not (file-remote-p (buffer-file-name))) - (dir-locals-find-file (buffer-file-name))) - dir-locals-file)) + (let ((variables-file (and (buffer-file-name) + (not (file-remote-p (buffer-file-name))) + (dir-locals-find-file (buffer-file-name)))) variables) - (if (consp variables-file) ; result from cache - ;; If cache element has an mtime, assume it came from a file. - ;; Otherwise, assume it was set directly. - (setq variables-file (if (nth 2 variables-file) - (expand-file-name dir-locals-file - (car variables-file)) - (cadr variables-file)))) + (setq variables-file + ;; If there are several .dir-locals, the user probably + ;; wants to edit the last one (the highest priority). + (cond ((stringp variables-file) + (car (last (dir-locals--all-files variables-file)))) + ((consp variables-file) ; result from cache + ;; If cache element has an mtime, assume it came from a file. + ;; Otherwise, assume it was set directly. + (if (nth 2 variables-file) + (car (last (dir-locals--all-files (car variables-file)))) + (cadr variables-file))) + ;; Try to make a proper file-name. This doesn't cover all + ;; wildcards, but it covers the default value of `dir-locals-file'. + (t (replace-regexp-in-string + "\\*" "" (replace-regexp-in-string "\\?" "-" dir-locals-file))))) ;; I can't be bothered to handle this case right now. ;; Dir locals were set directly from a class. You need to ;; directly modify the class in dir-locals-class-alist. diff --git a/lisp/files.el b/lisp/files.el index 9de9ac09f48..e8ee9490d33 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3648,7 +3648,7 @@ Return the new variables list." (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 ".dir-locals error: %s" (error-message-string err)) + (message "%s error: %s" dir-locals-file (error-message-string err)) nil)))) (defun dir-locals-set-directory-class (directory class &optional mtime) @@ -3698,11 +3698,38 @@ VARIABLES list of the class. The list is processed in order. applied by recursively following these rules." (setf (alist-get class dir-locals-class-alist) variables)) -(defconst dir-locals-file ".dir-locals.el" +(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.") +(defcustom dir-locals-sort-predicate #'string< + "Predicate used to sort dir-locals files before loading them. +The function should take two arguments (file names) and return +non-nil if the first argument should be loaded first (which means +the values in the second file will override those in the first)." + :group 'files + :type 'function) + +(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." + (require 'seq) + (let ((default-directory (if (file-directory-p file-or-dir) + file-or-dir + default-directory))) + (sort (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)) + dir-locals-sort-predicate))) + (defun dir-locals-find-file (file) "Find the directory-local variables for FILE. This searches upward in the directory tree from FILE. @@ -3719,75 +3746,96 @@ If not, the cache entry is cleared so that the file will be re-read. 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." +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." (setq file (expand-file-name file)) - (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)) + (let* ((dir-locals-file-name (if (eq system-type 'ms-dos) + (dosified-file-name dir-locals-file) + dir-locals-file)) + (locals-dir (locate-dominating-file + (file-name-directory file) + (lambda (dir) + (let ((default-directory dir)) + (file-expand-wildcards dir-locals-file-name 'full))))) + locals-file dir-elt) ;; `locate-dominating-file' may have abbreviated the name. - (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. + (when locals-dir + (setq locals-dir (expand-file-name locals-dir)) + (setq locals-file (expand-file-name dir-locals-file-name locals-dir))) + ;; 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-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) + (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) ;; 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 name of the file holding the variables to apply. +FILE is the absolute name of the file holding the variables to +apply. It may contain wildcards. The new class name is the same as the directory in which FILE is found. Returns the new class name." - (with-temp-buffer + (require 'map) + (let* ((dir-name (file-name-directory file)) + (class-name (intern dir-name)) + (files (dir-locals--all-files file)) + (read-circle nil) + (variables)) (with-demoted-errors "Error reading dir-locals: %S" - (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))))) + (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))))) + (dir-locals-set-class-variables class-name variables) + (dir-locals-set-directory-class + dir-name class-name + (seconds-to-time (apply #'max (mapcar (lambda (file) + (time-to-seconds (nth 5 (file-attributes file)))) + files)))) + class-name)) (defcustom enable-remote-dir-locals nil "Non-nil means dir-local variables will be applied to remote files." @@ -3810,17 +3858,17 @@ This does nothing if either `enable-local-variables' or (not (file-remote-p (or (buffer-file-name) default-directory))))) ;; Find the variables file. - (let ((variables-file (dir-locals-find-file - (or (buffer-file-name) default-directory))) + (let ((file-pattern-or-cache (dir-locals-find-file + (or (buffer-file-name) default-directory))) (class nil) (dir-name nil)) (cond - ((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)))) + ((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)))) (when class (let ((variables (dir-locals-collect-variables diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 958a0754946..4e0bfee5bf7 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -907,29 +907,36 @@ if it is given a local binding.\n")))) (buffer-file-name buffer))) (dir-locals-find-file (buffer-file-name buffer)))) - (dir-file t)) + (is-directory nil)) (princ (substitute-command-keys " This variable's value is directory-local")) - (if (null file) - (princ ".\n") - (princ ", set ") - (if (consp file) ; result from cache - ;; If the cache element has an mtime, we - ;; assume it came from a file. - (if (nth 2 file) - (setq file (expand-file-name - dir-locals-file (car file))) - ;; Otherwise, assume it was set directly. - (setq file (car file) - dir-file nil))) - (princ (substitute-command-keys - (if dir-file - "by the file\n `" - "for the directory\n `"))) + (when (consp file) ; result from cache + ;; If the cache element has an mtime, we + ;; assume it came from a file. + (if (nth 2 file) + (setq file (expand-file-name + dir-locals-file (car file))) + ;; Otherwise, assume it was set directly. + (setq file (car file) + is-directory t))) + (if (null file) + (princ ".\n") + (princ ", set ") + (let ((files (file-expand-wildcards file))) + (princ (substitute-command-keys + (cond + (is-directory "for the directory\n `") + ;; Many files matched. + ((cdr files) + (setq file (file-name-directory (car files))) + (format "by a file\n matching `%s' in the directory\n `" + dir-locals-file)) + (t (setq file (car files)) + "by the file\n `")))) (with-current-buffer standard-output (insert-text-button file 'type 'help-dir-local-var-def - 'help-args (list variable file))) + 'help-args (list variable file)))) (princ (substitute-command-keys "'.\n")))) (princ (substitute-command-keys " This variable's value is file-local.\n")))) |