GNU bug report logs - #75961
set-auto-mode--apply-alist

Previous Next

Full log

Message #17 received at 75961 <at> debbugs.gnu.org (full text, mbox):

From: Stefan Monnier <monnier <at> iro.umontreal.ca>
To: Eli Zaretskii <eliz <at> gnu.org>
Cc: nat chapman <nat.chapman <at> proton.me>, 75961 <at> debbugs.gnu.org, tom <at> tromey.com
Subject: Re: bug#75961: set-auto-mode--apply-alist
Date: Sat, 15 Feb 2025 18:53:16 -0500

[Message part 1 (text/plain, inline)]

>> 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

[auto-mode-alist.patch (text/x-diff, inline)]

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)

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.