bug#18721: patch

[Tom Tromey]

This patch adds the feature described in this bug.  There are a few
possible ways to do it, this picks a simple one: mimic auto-mode-alist
directly.

Let me know what you think.

thanks,
Tom

commit e13f5fdb86142e1b5bc3e8315a4219287da9c55b
Author: Tom Tromey <tom@tromey.com>
Date:   Fri Jan 13 11:10:08 2017 -0700

    Add auto-mode-alist functionality to .dir-locals.el
    
    Bug#18721
    * doc/emacs/custom.texi (Directory Variables): Document
    auto-mode-alist in .dir-locals.el.
    * doc/emacs/modes.texi (Choosing Modes): Update.
    * lisp/files.el (set-auto-mode--apply-alist): New function,
    from set-auto-mode.
    (set-auto-mode): Check directory locals for auto-mode-alist.
    (dir-locals-collect-variables): Add "predicate" parameter.
    (hack-dir-local--get-variables): New function, from
    hack-dir-local-variables.
    (hack-dir-local-variables): Call hack-dir-local--get-variables.
    * test/data/files-resources/.dir-locals.el: New file.
    * test/data/files-resources/whatever.quux: New file.
    * test/lisp/files-tests.el (files-tests-data-dir): New variable.
    (files-test-dir-locals-auto-mode-alist): New test.

diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index c84f4a9..2386cfd 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1351,6 +1351,16 @@ Directory Variables
 cannot be specified as a directory local variable.  @xref{File
 Variables}.
 
+The special key @code{auto-mode-alist} in a @file{.dir-locals.el} lets
+you set a file's major mode.  It works much like the variable
+@code{auto-mode-alist} (@pxref{Choosing Modes}).  For example, here is
+how you can tell Emacs that @file{.def} source files in this directory
+should be in C mode:
+
+@example
+((auto-mode-alist . (("\\.def\\'" . c-mode))))
+@end example
+
 @findex add-dir-local-variable
 @findex delete-dir-local-variable
 @findex copy-file-locals-to-dir-locals
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index 0acb82d..04736a3 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -349,8 +349,12 @@ Choosing Modes
 particular file type, it is better to enable the minor mode via a
 major mode hook (@pxref{Major Modes}).
 
+  Second, Emacs checks whether the file's extension matches an entry
+in any directory-local @code{auto-mode-alist}.  These are found using
+the @file{.dir-locals.el} facility (@pxref{Directory Variables}).
+
 @vindex interpreter-mode-alist
-  Second, if there is no file variable specifying a major mode, Emacs
+  Third, if there is no file variable specifying a major mode, Emacs
 checks whether the file's contents begin with @samp{#!}.  If so, that
 indicates that the file can serve as an executable shell command,
 which works by running an interpreter named on the file's first line
@@ -368,7 +372,7 @@ Choosing Modes
 @samp{'\"} to specify a list of troff preprocessors.
 
 @vindex magic-mode-alist
-  Third, Emacs tries to determine the major mode by looking at the
+  Fourth, Emacs tries to determine the major mode by looking at the
 text at the start of the buffer, based on the variable
 @code{magic-mode-alist}.  By default, this variable is @code{nil} (an
 empty list), so Emacs skips this step; however, you can customize it
@@ -396,7 +400,7 @@ Choosing Modes
 beginning of the buffer; if the function returns non-@code{nil}, Emacs
 set the major mode with @var{mode-function}.
 
-  Fourth---if Emacs still hasn't found a suitable major mode---it
+  Fifth---if Emacs still hasn't found a suitable major mode---it
 looks at the file's name.  The correspondence between file names and
 major modes is controlled by the variable @code{auto-mode-alist}.  Its
 value is a list in which each element has this form,
diff --git a/lisp/files.el b/lisp/files.el
index b57e35b..6a59077 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2808,11 +2808,62 @@ magic-mode-regexp-match-limit
   "Upper limit on `magic-mode-alist' regexp matches.
 Also applies to `magic-fallback-mode-alist'.")
 
+(defun set-auto-mode--apply-alist (alist keep-mode-if-same dir-local)
+  "Helper function for `set-auto-mode'.
+This function takes an alist of the same form as
+`auto-mode-alist'.  It then tries to find the appropriate match
+in the alist for the current buffer; setting the mode if
+possible.  Returns non-`nil' if the mode was set, `nil'
+otherwise.  DIR-LOCAL is a boolean which, if true, says that this
+call is via directory-locals and extra checks should be done."
+  (if buffer-file-name
+      (let (mode
+            (name buffer-file-name)
+            (remote-id (file-remote-p buffer-file-name))
+            (case-insensitive-p (file-name-case-insensitive-p
+                                 buffer-file-name)))
+        ;; Remove backup-suffixes from file name.
+        (setq name (file-name-sans-versions name))
+        ;; Remove remote file name identification.
+        (when (and (stringp remote-id)
+                   (string-match (regexp-quote remote-id) name))
+          (setq name (substring name (match-end 0))))
+        (while name
+          ;; Find first matching alist entry.
+          (setq mode
+                (if case-insensitive-p
+                    ;; Filesystem is case-insensitive.
+                    (let ((case-fold-search t))
+                      (assoc-default alist 'string-match))
+                  ;; Filesystem is case-sensitive.
+                  (or
+                   ;; First match case-sensitively.
+                   (let ((case-fold-search nil))
+                     (assoc-default name alist 'string-match))
+                   ;; Fallback to case-insensitive match.
+                   (and auto-mode-case-fold
+                        (let ((case-fold-search t))
+                          (assoc-default name alist 'string-match))))))
+          (if (and mode
+                   (consp mode)
+                   (cadr mode))
+              (setq mode (car mode)
+                    name (substring name 0 (match-beginning 0)))
+            (setq name nil)))
+        (when (and dir-local mode)
+          (unless (string-suffix-p "-mode" (symbol-name mode))
+            (message "Ignoring invalid mode `%s'" (symbol-name mode))
+            (setq mode nil)))
+        (when mode
+          (set-auto-mode-0 mode keep-mode-if-same)
+          t))))
+
 (defun set-auto-mode (&optional keep-mode-if-same)
   "Select major mode appropriate for current buffer.
 
 To find the right major mode, this function checks for a -*- mode tag
 checks for a `mode:' entry in the Local Variables section of the file,
+checks if there an `auto-mode-alist' entry in `.dir-locals.el',
 checks if it uses an interpreter listed in `interpreter-mode-alist',
 matches the buffer beginning against `magic-mode-alist',
 compares the filename against the entries in `auto-mode-alist',
@@ -2869,6 +2920,14 @@ set-auto-mode
              (or (set-auto-mode-0 mode keep-mode-if-same)
                  ;; continuing would call minor modes again, toggling them off
                  (throw 'nop nil))))))
+    ;; Check for auto-mode-alist entry in dir-locals.
+    (unless done
+      (with-demoted-errors "Directory-local variables error: %s"
+       ;; Note this is a no-op if enable-local-variables is nil.
+        (let* ((mode-alist (cdr (hack-dir-local--get-variables
+                                 (lambda (key) (eq key 'auto-mode-alist))))))
+          (setq done (set-auto-mode--apply-alist mode-alist
+                                                 keep-mode-if-same t)))))
     ;; hack-local-variables checks local-enable-local-variables etc, but
     ;; we might as well be explicit here for the sake of clarity.
     (and (not done)
@@ -2917,45 +2976,8 @@ set-auto-mode
          (set-auto-mode-0 done keep-mode-if-same)))
     ;; Next compare the filename against the entries in auto-mode-alist.
     (unless done
-      (if buffer-file-name
-         (let ((name buffer-file-name)
-               (remote-id (file-remote-p buffer-file-name))
-               (case-insensitive-p (file-name-case-insensitive-p
-                                    buffer-file-name)))
-           ;; Remove backup-suffixes from file name.
-           (setq name (file-name-sans-versions name))
-           ;; Remove remote file name identification.
-           (when (and (stringp remote-id)
-                      (string-match (regexp-quote remote-id) name))
-             (setq name (substring name (match-end 0))))
-           (while name
-             ;; Find first matching alist entry.
-             (setq mode
-                   (if case-insensitive-p
-                       ;; Filesystem is case-insensitive.
-                       (let ((case-fold-search t))
-                         (assoc-default name auto-mode-alist
-                                        'string-match))
-                     ;; Filesystem is case-sensitive.
-                     (or
-                      ;; First match case-sensitively.
-                      (let ((case-fold-search nil))
-                        (assoc-default name auto-mode-alist
-                                       'string-match))
-                      ;; Fallback to case-insensitive match.
-                      (and auto-mode-case-fold
-                           (let ((case-fold-search t))
-                             (assoc-default name auto-mode-alist
-                                            'string-match))))))
-             (if (and mode
-                      (consp mode)
-                      (cadr mode))
-                 (setq mode (car mode)
-                       name (substring name 0 (match-beginning 0)))
-               (setq name nil))
-             (when mode
-               (set-auto-mode-0 mode keep-mode-if-same)
-               (setq done t))))))
+      (setq done (set-auto-mode--apply-alist auto-mode-alist
+                                             keep-mode-if-same nil)))
     ;; Next try matching the buffer beginning against 
magic-fallback-mode-alist.
     (unless done
       (if (setq done (save-excursion
@@ -3716,10 +3738,13 @@ dir-locals-collect-mode-variables
        ;; Need a new cons in case we setcdr later.
        (push (cons variable value) variables)))))
 
-(defun dir-locals-collect-variables (class-variables root variables)
+(defun dir-locals-collect-variables (class-variables root variables
+                                                     &optional predicate)
   "Collect entries from CLASS-VARIABLES into VARIABLES.
 ROOT is the root directory of the project.
-Return the new variables list."
+Return the new variables list.
+If PREDICATE is given, it is used to test a symbol key in the alist
+to see whether it should be considered."
   (let* ((file-name (or (buffer-file-name)
                        ;; Handle non-file buffers, too.
                        (expand-file-name default-directory)))
@@ -3737,9 +3762,11 @@ dir-locals-collect-variables
                          (>= (length sub-file-name) (length key))
                          (string-prefix-p key sub-file-name))
                 (setq variables (dir-locals-collect-variables
-                                 (cdr entry) root variables))))
-             ((or (not key)
-                  (derived-mode-p key))
+                                 (cdr entry) root variables predicate))))
+             ((if predicate
+                  (funcall predicate key)
+                (or (not key)
+                    (derived-mode-p key)))
               (let* ((alist (cdr entry))
                      (subdirs (assq 'subdirs alist)))
                 (if (or (not subdirs)
@@ -3955,13 +3982,13 @@ enable-remote-dir-locals
 
 (defvar hack-dir-local-variables--warned-coding nil)
 
-(defun hack-dir-local-variables ()
+(defun hack-dir-local--get-variables (predicate)
   "Read per-directory local variables for the current buffer.
-Store the directory-local variables in `dir-local-variables-alist'
-and `file-local-variables-alist', without applying them.
-
-This does nothing if either `enable-local-variables' or
-`enable-dir-local-variables' are nil."
+Return a cons of the form (DIR . ALIST), where DIR is the
+directory name (maybe nil) and ALIST is an alist of all variables
+that might apply.  These will be filtered according to the
+buffer's directory, but not according to its mode.
+PREDICATE is passed to `dir-locals-collect-variables'."
   (when (and enable-local-variables
             enable-dir-local-variables
             (or enable-remote-dir-locals
@@ -3980,21 +4007,33 @@ hack-dir-local-variables
        (setq dir-name (nth 0 dir-or-cache))
        (setq class (nth 1 dir-or-cache))))
       (when class
-       (let ((variables
-              (dir-locals-collect-variables
-               (dir-locals-get-class-variables class) dir-name nil)))
-         (when variables
-           (dolist (elt variables)
-             (if (eq (car elt) 'coding)
-                  (unless hack-dir-local-variables--warned-coding
-                    (setq hack-dir-local-variables--warned-coding t)
-                    (display-warning 'files
-                                     "Coding cannot be specified by 
dir-locals"))
-               (unless (memq (car elt) '(eval mode))
-                 (setq dir-local-variables-alist
-                       (assq-delete-all (car elt) dir-local-variables-alist)))
-               (push elt dir-local-variables-alist)))
-           (hack-local-variables-filter variables dir-name)))))))
+        (cons dir-name
+              (dir-locals-collect-variables
+               (dir-locals-get-class-variables class)
+               dir-name nil predicate))))))
+
+(defun hack-dir-local-variables ()
+  "Read per-directory local variables for the current buffer.
+Store the directory-local variables in `dir-local-variables-alist'
+and `file-local-variables-alist', without applying them.
+
+This does nothing if either `enable-local-variables' or
+`enable-dir-local-variables' are nil."
+  (let* ((items (hack-dir-local--get-variables nil))
+         (dir-name (car items))
+         (variables (cdr items)))
+    (when variables
+      (dolist (elt variables)
+        (if (eq (car elt) 'coding)
+            (unless hack-dir-local-variables--warned-coding
+              (setq hack-dir-local-variables--warned-coding t)
+              (display-warning 'files
+                               "Coding cannot be specified by dir-locals"))
+          (unless (memq (car elt) '(eval mode))
+            (setq dir-local-variables-alist
+                  (assq-delete-all (car elt) dir-local-variables-alist)))
+          (push elt dir-local-variables-alist)))
+      (hack-local-variables-filter variables dir-name))))
 
 (defun hack-dir-local-variables-non-file-buffer ()
   "Apply directory-local variables to a non-file buffer.
diff --git a/test/data/files-resources/.dir-locals.el 
b/test/data/files-resources/.dir-locals.el
new file mode 100644
index 0000000..84997b8
--- /dev/null
+++ b/test/data/files-resources/.dir-locals.el
@@ -0,0 +1,2 @@
+;; This is used by files-tests.el.
+((auto-mode-alist . (("\\.quux\\'" . tcl-mode))))
diff --git a/test/data/files-resources/whatever.quux 
b/test/data/files-resources/whatever.quux
new file mode 100644
index 0000000..595583b
--- /dev/null
+++ b/test/data/files-resources/whatever.quux
@@ -0,0 +1,2 @@
+# Used by files-test.el.
+# Due to .dir-locals.el this should end up in Tcl mode.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 9d456c5..c0dd800 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -25,6 +25,11 @@
 ;; triggered.
 (defvar files-test-result nil)
 
+;; Where supplementary files can be found.
+(defvar files-tests-data-dir
+  (expand-file-name "data/files-resources/"
+                    (getenv "EMACS_TEST_DIRECTORY")))
+
 (defvar files-test-safe-result nil)
 (put 'files-test-safe-result 'safe-local-variable 'booleanp)
 
@@ -243,5 +248,10 @@ files-test-bug-18141-file
                          (concat "/:/:" subdir)))))
       (delete-directory dir 'recursive))))
 
+(ert-deftest files-test-dir-locals-auto-mode-alist ()
+  "Test an `auto-mode-alist' entry in `.dir-locals.el'"
+  (find-file (expand-file-name "whatever.quux" files-tests-data-dir))
+  (should (eq major-mode 'tcl-mode)))
+
 (provide 'files-tests)
 ;;; files-tests.el ends here