From: Stefan Kangas Date: Sun, 22 Dec 2024 01:57:45 +0000 (+0100) Subject: Match more gdbinit files in auto-mode-alist X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f6d7f8b9f6e8891d3297571b9e77a0b1a50f0d40;p=emacs.git 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. (cherry picked from commit 86a8b24bdea52a7aab45abcc51db2dd47308c11f) --- diff --git a/lisp/files.el b/lisp/files.el index f22ac106a4b..ff55054a62d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3110,7 +3110,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'. @@ -3502,6 +3502,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 @@ -3523,29 +3552,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) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index ad54addf06b..78fc139025c 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -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.