Match more gdbinit files in auto-mode-alist

* lisp/files.el (auto-mode-alist): Match more gdbinit files,
including XDG, and MS-Windows.  Avoid false positives.
(set-auto-mode--find-matching-alist-entry): Break out function...
(set-auto-mode--apply-alist): ...from here.  (Bug#74946)
* test/lisp/files-tests.el (files-tests--check-mode): New function.
(files-tests-auto-mode-alist): New test.
This commit is contained in:
Stefan Kangas 2024-12-22 02:57:45 +01:00
parent d89d8715ee
commit 86a8b24bde
2 changed files with 53 additions and 24 deletions

View file

@ -3056,7 +3056,7 @@ since only a single case-insensitive search through the alist is made."
;; files, cross-debuggers can use something like
;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files
;; don't interfere with each other.
("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode)
("/[._]?[A-Za-z0-9-]*\\(?:gdbinit\\(?:\\.\\(?:ini?\\|loader\\)\\)?\\|gdb\\.ini\\)\\'" . gdb-script-mode)
;; GDB 7.5 introduced OBJFILE-gdb.gdb script files; e.g. a file
;; named 'emacs-gdb.gdb', if it exists, will be automatically
;; loaded when GDB reads an objfile called 'emacs'.
@ -3455,6 +3455,35 @@ If FUNCTION is nil, then it is not called.")
"Upper limit on `magic-mode-alist' regexp matches.
Also applies to `magic-fallback-mode-alist'.")
(defun set-auto-mode--find-matching-alist-entry (alist name case-insensitive)
"Find first matching entry in ALIST for file NAME.
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))
(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)))
mode))
(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
@ -3476,29 +3505,8 @@ extra checks should be done."
(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 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)))
(setq mode (set-auto-mode--find-matching-alist-entry
alist name case-insensitive-p))
(when (and dir-local mode
(not (set-auto-mode--dir-local-valid-p mode)))
(message "Ignoring invalid mode `%s'" mode)

View file

@ -1661,6 +1661,27 @@ The door of all subtleties!
(defvar sh-shell)
(defun files-tests--check-mode (filename)
"Return the major mode found in `auto-mode-alist' for FILENAME."
(set-auto-mode--find-matching-alist-entry
auto-mode-alist
(concat "/home/jrhacker/" filename)
nil))
(ert-deftest files-tests-auto-mode-alist ()
(should (eq (files-tests--check-mode ".gdbinit.in") #'gdb-script-mode))
(should (eq (files-tests--check-mode ".gdbinit") #'gdb-script-mode))
(should (eq (files-tests--check-mode "_gdbinit") #'gdb-script-mode)) ; for MS-DOS
(should (eq (files-tests--check-mode "gdb.ini") #'gdb-script-mode)) ; likewise
(should (eq (files-tests--check-mode "gdbinit") #'gdb-script-mode))
(should (eq (files-tests--check-mode "gdbinit.in") #'gdb-script-mode))
(should (eq (files-tests--check-mode "SOMETHING-gdbinit") #'gdb-script-mode))
(should (eq (files-tests--check-mode ".gdbinit.loader") #'gdb-script-mode))
(should-not (eq (files-tests--check-mode "gdbinit-history.exp") #'gdb-script-mode))
(should-not (eq (files-tests--check-mode "gdbinit.c") #'gdb-script-mode))
(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)))
(defun files-tests--check-shebang (shebang expected-mode &optional expected-dialect)
"Assert that mode for SHEBANG derives from EXPECTED-MODE.