procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2025-02-16 11:49:16 -05:00
parent 4cf53c4361
commit 504bdce731
2 changed files with 46 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
lisp/files.el
View file

@ -3469,27 +3469,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)

16
test/lisp/files-tests.el
View file

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