Subject: bug#75961: set-auto-mode--apply-alist

From: Stefan Monnier <[email-masked]>
Date: Sat, 15 Feb 2025 18:53:16 -0500

>> emacs -Q --eval '(progn (define-derived-mode test-mode fundamental-mode
>> "TEST" (message "Test mode called")) (add-to-list (quote auto-mode-alist)
>> (quote ("\\.test$" test-mode t))))' file.html.test file.test
>> 
>> Buffer visiting file.html.test is in mhtml-mode, buffer visiting file.test
>> is in fundamental mode, no message is emitted. 

Yup.

The patch below seems to do the trick.  Any comment/objection?

        Stefan
diff --git a/lisp/files.el b/lisp/files.el
index a71d0c5c9d0..bf05939ebeb 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3469,7 +3469,7 @@
 If CASE-INSENSITIVE, the file system of file NAME is case-insensitive."
   (let (mode)
     (while name
-      (setq mode
+      (let ((newmode
             (if case-insensitive
                 ;; Filesystem is case-insensitive.
                 (let ((case-fold-search t))
@@ -3482,14 +3482,24 @@
                ;; 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)
+                       (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)))
+          (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 5e2c4eb2669..1e7e00ce1c0 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1680,6 +1680,16 @@ files-tests-auto-mode-alist
   (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)))
+    (with-temp-buffer
+     (setq buffer-file-name "foo.text")
+     (normal-mode)
+     (should (derived-mode-p 'text-mode))
+     (setq buffer-file-name "foo.html.text")
+     (normal-mode)
+     (should (derived-mode-p 'html-mode)))))
+
 (defvar sh-shell)
 
 (defun files-tests--check-shebang (shebang expected-mode &optional expected-dialect)