From a5a5dcd0452cadfee988a0256c10877835eefcef Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 19 Dec 2024 23:51:38 +0100 Subject: [PATCH] Match more gdbinit files * lisp/files.el (auto-mode-alist): Match more gdbinit files, including XDG, and MS-Windows. Avoid false positives. (Bug#74946) (set-auto-mode--find-matching-alist-entry): Break out function... (set-auto-mode--apply-alist): ...from here. * test/lisp/files-tests.el (files-tests-auto-mode-alist): New test. --- lisp/files.el | 56 +++++++++++++++++++++++----------------- test/lisp/files-tests.el | 17 ++++++++++++ 2 files changed, 49 insertions(+), 24 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 9f13804540b..68ce2e0c273 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3005,7 +3005,7 @@ auto-mode-alist ;; 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'. @@ -3404,6 +3404,35 @@ magic-mode-regexp-match-limit "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 @@ -3425,29 +3454,8 @@ set-auto-mode--apply-alist (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..0edc78d01e5 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1680,6 +1680,23 @@ files-tests--check-shebang (when (eq expected-mode 'sh-base-mode) (should (eq sh-shell expected-dialect)))))) +(ert-deftest files-tests-auto-mode-alist () + (cl-flet ((find (file mode &optional case-insensitive) + (eq mode (set-auto-mode--find-matching-alist-entry + auto-mode-alist (concat "/home/stefank/" file) case-insensitive)))) + (should (find ".gdbinit.in" #'gdb-script-mode)) + (should (find ".gdbinit" #'gdb-script-mode)) + (should (find "_gdbinit" #'gdb-script-mode)) ; for MS-DOS + (should (find "gdb.ini" #'gdb-script-mode)) ; likewise + (should (find "gdbinit" #'gdb-script-mode)) + (should (find "gdbinit.in" #'gdb-script-mode)) + (should (find "SOMETHING-gdbinit" #'gdb-script-mode)) + (should (find ".gdbinit.loader" #'gdb-script-mode)) + (should-not (find "gdbinit-history.exp" #'gdb-script-mode)) ; not a GDB init file + (should-not (find "gdbinit.5" #'gdb-script-mode)) ; likewise + (should-not (find "gdbinit.c" #'gdb-script-mode)) ; likewise + (should-not (find ".gdbinit.py.in" #'gdb-script-mode)))) ; likewise + (ert-deftest files-tests-auto-mode-interpreter () "Test that `set-auto-mode' deduces correct modes from shebangs." ;; Straightforward interpreter invocation. -- 2.47.1