(set-auto-mode--find-matching-alist-entry): Fix bug#75961

* lisp/files.el (set-auto-mode--find-matching-alist-entry): Run the
MODE found in (REGEXP MODE t) before we replace it with something else.

* test/lisp/files-tests.el (files-tests--bug75961): New test.

(cherry picked from commit 504bdce73168257af14cd3b0200638fe9dd5c367)

diff --git a/lisp/files.el b/lisp/files.el
index 31159de824a4729e9129e5abbe784e6002afc59a..6956467dbec945bffd890e71985a6bce96a36b36 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3516,27 +3516,37 @@ Also applies to `magic-fallback-mode-alist'.")
 If CASE-INSENSITIVE, the file system of file NAME is case-insensitive."
   (let (mode)
     (while name
-      (setq mode
-            (if case-insensitive
-                ;; Filesystem is case-insensitive.
-                (let ((case-fold-search t))
+      (let ((newmode
+             (if case-insensitive
+                 ;; Filesystem is case-insensitive.
+                 (let ((case-fold-search t))
+                   (assoc-default name alist 'string-match))
+               ;; Filesystem is case-sensitive.
+               (or
+                ;; First match case-sensitively.
+                (let ((case-fold-search nil))
                   (assoc-default name 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
-               (not (functionp mode))
-               (consp mode)
-               (cadr mode))
-          (setq mode (car mode)
-                name (substring name 0 (match-beginning 0)))
-        (setq name nil)))
+                ;; Fallback to case-insensitive match.
+                (and auto-mode-case-fold
+                     (let ((case-fold-search t))
+                       (assoc-default name alist 'string-match)))))))
+        (when newmode
+          (when mode
+            ;; We had already found a mode but in a (REGEXP MODE t)
+            ;; entry, so we still have to run MODE.  Let's do it now.
+            ;; FIXME: It's kind of ugly to run the function here.
+            ;; An alternative could be to return a list of functions and
+            ;; callers.
+            (set-auto-mode-0 mode t))
+          (setq mode newmode))
+        (if (and newmode
+                 (not (functionp newmode))
+                 (consp newmode)
+                 (cadr newmode))
+            ;; It's a (REGEXP MODE t): Keep looking but remember the MODE.
+            (setq mode (car newmode)
+                  name (substring name 0 (match-beginning 0)))
+          (setq name nil))))
     mode))
 
 (defun set-auto-mode--apply-alist (alist keep-mode-if-same dir-local)

diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 5e2c4eb266997b3d3cf18578c2f68ef43734b86f..7f06c37a408f7b3a3a923970c4b3fa33440e410a 100644 (file)
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1680,6 +1680,22 @@ The door of all subtleties!
   (should-not (eq (files-tests--check-mode "gdbinit.5") #'gdb-script-mode))
   (should-not (eq (files-tests--check-mode ".gdbinit.py.in") #'gdb-script-mode)))
 
+(ert-deftest files-tests--bug75961 ()
+  (let* ((auto-mode-alist (cons '("\\.text\\'" text-mode t) auto-mode-alist))
+         (called-fun nil)
+         (fun (lambda () (setq called-fun t))))
+    (with-temp-buffer
+     (setq buffer-file-name "foo.text")
+     (normal-mode)
+     (should (derived-mode-p 'text-mode))
+     (add-hook 'text-mode-hook fun)
+     (setq buffer-file-name "foo.html.text")
+     (should (not called-fun))
+     (normal-mode)
+     (remove-hook 'text-mode-hook fun)
+     (should called-fun)
+     (should (derived-mode-p 'html-mode)))))
+
 (defvar sh-shell)
 
 (defun files-tests--check-shebang (shebang expected-mode &optional expected-dialect)