commit fc174eb20b633708da778ac6cb4bdc3e29415ef6 (HEAD, refs/remotes/origin/master) Author: Juri Linkov Date: Wed Aug 11 10:10:19 2021 +0300 ; Fix typos diff --git a/lisp/files.el b/lisp/files.el index dffce2b247..6a6d5409fa 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6562,7 +6562,7 @@ details on the arguments, see `revert-buffer'." (fmakunbound 'revert-buffer-with-fine-grain-success-p))))) (defcustom revert-buffer-quick-short-answers nil - "How much confirmation to be done by the `revert-buffer-quit' command. + "How much confirmation to be done by the `revert-buffer-quick' command. If non-nil, use `y-or-n-p' instead of `yes-or-no-p'." :version "28.1" :type 'boolean) @@ -6592,6 +6592,7 @@ auto-save file, if that is more recent than the visited file." (t (revert-buffer (not auto-save))))) + (defun recover-this-file () "Recover the visited file--get contents from its last auto-save file." (interactive) @@ -6767,6 +6768,7 @@ This command is used in the special Dired buffer created by (message "No files can be recovered from this session now"))) (kill-buffer buffer)))) + (defun kill-buffer-ask (buffer) "Kill BUFFER if confirmed." (when (yes-or-no-p (format "Buffer %s %s. Kill? " @@ -8036,6 +8038,7 @@ based on existing mode bits, as in \"og+rX-w\"." (define-obsolete-variable-alias 'cache-long-line-scans 'cache-long-scans "24.4") + ;; Trashcan handling. (defcustom trash-directory nil "Directory for `move-file-to-trash' to move files and directories to. @@ -8186,6 +8189,7 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (new-fn (file-name-concat trash-files-dir files-base))) (rename-file fn new-fn overwrite))))))))) + (defsubst file-attribute-type (attributes) "The type field in ATTRIBUTES returned by `file-attributes'. The value is either t for directory, string (name linked to) for diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 8206115b15..2f82d83ceb 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -99,7 +99,7 @@ To use the element, do (apply FUNCTION ARGS) then goto the point.") (put 'help-xref-forward-stack 'permanent-local t) (defvar-local help-xref-stack-item nil - "An item for `help-follow-symbok' to push onto `help-xref-stack'. + "An item for `help-follow-symbol' to push onto `help-xref-stack'. The format is (FUNCTION ARGS...).") (put 'help-xref-stack-item 'permanent-local t) commit da8277abc19d6eb1ac5a15273daca03f4237294b Author: Juri Linkov Date: Wed Aug 11 10:06:29 2021 +0300 * lisp/replace.el (perform-replace): Use 'remove-function' (bug#49963). Don't let-bind the value of 'isearch-filter-predicate' to protect from changing the global value, since with a buffer-local value it still changes the global value. So after using 'add-function' on the global value of 'isearch-filter-predicate', call 'remove-function' to remove 'region-filter' from the global value in 'unwind-protect'. diff --git a/lisp/replace.el b/lisp/replace.el index 1d6f091dc7..69bdfe1331 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2765,9 +2765,7 @@ characters." ;; If non-nil, it is marker saying where in the buffer to stop. (limit nil) - ;; Use local binding in add-function below. - (isearch-filter-predicate isearch-filter-predicate) - (region-bounds nil) + (region-filter nil) ;; Data for the next match. If a cons, it has the same format as ;; (match-data); otherwise it is t if a match is possible at point. @@ -2791,21 +2789,22 @@ characters." ;; Unless a single contiguous chunk is selected, operate on multiple chunks. (when region-noncontiguous-p - (setq region-bounds - (mapcar (lambda (position) - (cons (copy-marker (car position)) - (copy-marker (cdr position)))) - (funcall region-extract-function 'bounds))) - (add-function :after-while isearch-filter-predicate - (lambda (start end) - (delq nil (mapcar - (lambda (bounds) - (and - (>= start (car bounds)) - (<= start (cdr bounds)) - (>= end (car bounds)) - (<= end (cdr bounds)))) - region-bounds))))) + (let ((region-bounds + (mapcar (lambda (position) + (cons (copy-marker (car position)) + (copy-marker (cdr position)))) + (funcall region-extract-function 'bounds)))) + (setq region-filter + (lambda (start end) + (delq nil (mapcar + (lambda (bounds) + (and + (>= start (car bounds)) + (<= start (cdr bounds)) + (>= end (car bounds)) + (<= end (cdr bounds)))) + region-bounds)))) + (add-function :after-while isearch-filter-predicate region-filter))) ;; If region is active, in Transient Mark mode, operate on region. (if backward @@ -3238,7 +3237,9 @@ characters." (setq next-replacement-replaced nil search-string-replaced nil last-was-act-and-show nil)))))) - (replace-dehighlight)) + (replace-dehighlight) + (when region-filter + (remove-function isearch-filter-predicate region-filter))) (or unread-command-events (message (ngettext "Replaced %d occurrence%s" "Replaced %d occurrences%s" commit a8e89964f3553f40b8807617c3b181f42cd22fd9 Author: Lars Ingebrigtsen Date: Tue Aug 10 18:21:15 2021 +0200 Use ### for outline headings in shell-script-mode * lisp/progmodes/sh-script.el (sh-mode): Use ### for outline headings. This aligns it more with emacs-lisp-mode headings. diff --git a/etc/NEWS b/etc/NEWS index b63d10fd97..3560c9d34e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2400,7 +2400,7 @@ This command, called interactively, toggles the local value of --- *** 'shell-script-mode' now supports 'outline-minor-mode'. -The outline headings have lines that start with "##". +The outline headings have lines that start with "###". +++ *** New command 'revert-buffer-quick'. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 8fcb311ff1..b6674731dd 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1532,7 +1532,7 @@ with your script for an edit-interpret-debug cycle." (setq-local add-log-current-defun-function #'sh-current-defun-name) (add-hook 'completion-at-point-functions #'sh-completion-at-point-function nil t) - (setq-local outline-regexp "##") + (setq-local outline-regexp "###") ;; Parse or insert magic number for exec, and set all variables depending ;; on the shell thus determined. (sh-set-shell commit a6bd0490317371dd49d847a774c8ae73315fe6d1 Author: Lars Ingebrigtsen Date: Tue Aug 10 17:52:26 2021 +0200 Add support for outlining in shell-script-mode * lisp/progmodes/sh-script.el (sh-mode): Set outline-regexp (bug#49346). diff --git a/etc/NEWS b/etc/NEWS index 3c41a97792..b63d10fd97 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2398,6 +2398,10 @@ This command, called interactively, toggles the local value of ** Miscellaneous +--- +*** 'shell-script-mode' now supports 'outline-minor-mode'. +The outline headings have lines that start with "##". + +++ *** New command 'revert-buffer-quick'. This is bound to 'C-x x g' and is like `revert-buffer', but prompts diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 2f98b9c53c..8fcb311ff1 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1532,6 +1532,7 @@ with your script for an edit-interpret-debug cycle." (setq-local add-log-current-defun-function #'sh-current-defun-name) (add-hook 'completion-at-point-functions #'sh-completion-at-point-function nil t) + (setq-local outline-regexp "##") ;; Parse or insert magic number for exec, and set all variables depending ;; on the shell thus determined. (sh-set-shell commit 877df4eb1ca008556572214a917fb3bef2b994b5 Author: Lars Ingebrigtsen Date: Tue Aug 10 17:29:07 2021 +0200 Add new user option `gnus-topic-prepare-topic' * doc/misc/gnus.texi (Topic Variables): Document it. * lisp/gnus/gnus-topic.el (gnus-topic-prepare-topic): New user option. (gnus-topic-prepare-topic): Use it. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 17da5071cb..5f3fba00df 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -4145,6 +4145,25 @@ The default is 2. The @code{gnus-topic-display-empty-topics} says whether to display even topics that have no unread articles in them. The default is @code{t}. +@vindex gnus-topic-display-predicate +If @code{gnus-topic-display-predicate} is non-@code{nil}, it should be +a function that says whether the topic is to be displayed or not. +The function will be called with one parameter (the name of the topic) +and should return non-@code{nil} is the topic is to be displayed. + +For instance, if you don't even want to be reminded that work exists +outside of office hours, you can gather all the work-related groups +into a topic called @samp{"Work"}, and then say something like the +following: + +@lisp +(setq gnus-topic-display-predicate + (lambda (name) + (or (not (equal name "Work")) + (< 090000 + (string-to-number (format-time-string "%H%M%S")) + 170000)))) +@end lisp @node Topic Sorting @subsection Topic Sorting diff --git a/etc/NEWS b/etc/NEWS index 34e4cd73a7..3c41a97792 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1002,6 +1002,10 @@ String or list of strings specifying switches for Git log under VC. ** Gnus ++++ +*** New user option 'gnus-topic-display-predicate'. +This can be used to inhibit the display of some topics completely. + +++ *** nnimap now supports the oauth2.el library. diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 568fbbcafb..c8bcccdfdd 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -71,6 +71,14 @@ See Info node `(gnus)Formatting Variables'." "If non-nil, display the topic lines even of topics that have no unread articles." :type 'boolean) +(defcustom gnus-topic-display-predicate nil + "If non-nil, this should be a function to control the display of the topic. +The function is called with one parameter -- the topic name, and +should return non-nil if the topic is to be displayed." + :version "28.1" + :type '(choice (const :tag "Display all topics" nil) + function)) + ;; Internal variables. (defvar gnus-topic-active-topology nil) @@ -487,18 +495,16 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." If SILENT, don't insert anything. Return the number of unread articles in the topic and its subtopics." (let* ((type (pop topicl)) + (name (car type)) (entries-level (if gnus-group-listed-groups gnus-level-killed list-level)) (all (or predicate gnus-group-listed-groups (cdr (assq 'visible - (gnus-topic-hierarchical-parameters - (car type)))))) + (gnus-topic-hierarchical-parameters name))))) (lowest (if gnus-group-listed-groups 0 lowest)) - (entries (gnus-topic-find-groups - (car type) entries-level all lowest)) - (all-groups (gnus-topic-find-groups - (car type) entries-level all lowest t)) + (entries (gnus-topic-find-groups name entries-level all lowest)) + (all-groups (gnus-topic-find-groups name entries-level all lowest t)) (visiblep (and (eq (nth 1 type) 'visible) (not silent))) (gnus-group-indentation (make-string (* gnus-topic-indent-level level) ? )) @@ -508,80 +514,84 @@ articles in the topic and its subtopics." (point-max (point-max)) (unread 0) info entry end active tick) - ;; Insert any sub-topics. - (while topicl - (cl-incf unread - (gnus-topic-prepare-topic - (pop topicl) (1+ level) list-level predicate - (not visiblep) lowest regexp))) - (setq end (point)) - (goto-char beg) - ;; Insert all the groups that belong in this topic. - (while (setq entry (pop entries)) - (when (if (stringp entry) - (gnus-group-prepare-logic - entry - (and - (or (not gnus-group-listed-groups) - (if (< list-level gnus-level-zombie) nil - (let ((entry-level - (if (member entry gnus-zombie-list) - gnus-level-zombie gnus-level-killed))) - (and (<= entry-level list-level) - (>= entry-level lowest))))) - (cond - ((stringp regexp) - (string-match regexp entry)) - ((functionp regexp) - (funcall regexp entry)) - ((null regexp) t) - (t nil)))) - (setq info (nth 1 entry)) - (gnus-group-prepare-logic - (gnus-info-group info) - (and (or (not gnus-group-listed-groups) - (let ((entry-level (gnus-info-level info))) - (and (<= entry-level list-level) - (>= entry-level lowest)))) - (or (not (functionp predicate)) - (funcall predicate info)) - (or (not (stringp regexp)) - (string-match regexp (gnus-info-group info)))))) - (when visiblep - (if (stringp entry) - ;; Dead groups. - (gnus-group-insert-group-line - entry (if (member entry gnus-zombie-list) - gnus-level-zombie gnus-level-killed) - nil (- (1+ (cdr (setq active (gnus-active entry)))) - (car active)) - nil) - ;; Living groups. - (when (setq info (nth 1 entry)) - (gnus-group-insert-group-line - (gnus-info-group info) - (gnus-info-level info) (gnus-info-marks info) - (car entry) (gnus-info-method info))))) - (when (and (listp entry) - (numberp (car entry))) - (cl-incf unread (car entry))) - (when (listp entry) - (setq tick t)))) - (goto-char beg) - ;; Insert the topic line. - (when (and (not silent) - (or gnus-topic-display-empty-topics ;We want empty topics - (not (zerop unread)) ;Non-empty - tick ;Ticked articles - (/= point-max (point-max)))) ;Inactive groups - (gnus-topic-insert-topic-line - (car type) visiblep - (not (eq (nth 2 type) 'hidden)) - level all-entries unread all-groups)) - (gnus-topic-update-unreads (car type) unread) - (gnus-group--setup-tool-bar-update beg end) - (goto-char end) - unread)) + (if (and gnus-topic-display-predicate + (not (funcall gnus-topic-display-predicate name))) + ;; We're filtering out this topic. + 0 + ;; Insert any sub-topics. + (while topicl + (cl-incf unread + (gnus-topic-prepare-topic + (pop topicl) (1+ level) list-level predicate + (not visiblep) lowest regexp))) + (setq end (point)) + (goto-char beg) + ;; Insert all the groups that belong in this topic. + (while (setq entry (pop entries)) + (when (if (stringp entry) + (gnus-group-prepare-logic + entry + (and + (or (not gnus-group-listed-groups) + (if (< list-level gnus-level-zombie) nil + (let ((entry-level + (if (member entry gnus-zombie-list) + gnus-level-zombie gnus-level-killed))) + (and (<= entry-level list-level) + (>= entry-level lowest))))) + (cond + ((stringp regexp) + (string-match regexp entry)) + ((functionp regexp) + (funcall regexp entry)) + ((null regexp) t) + (t nil)))) + (setq info (nth 1 entry)) + (gnus-group-prepare-logic + (gnus-info-group info) + (and (or (not gnus-group-listed-groups) + (let ((entry-level (gnus-info-level info))) + (and (<= entry-level list-level) + (>= entry-level lowest)))) + (or (not (functionp predicate)) + (funcall predicate info)) + (or (not (stringp regexp)) + (string-match regexp (gnus-info-group info)))))) + (when visiblep + (if (stringp entry) + ;; Dead groups. + (gnus-group-insert-group-line + entry (if (member entry gnus-zombie-list) + gnus-level-zombie gnus-level-killed) + nil (- (1+ (cdr (setq active (gnus-active entry)))) + (car active)) + nil) + ;; Living groups. + (when (setq info (nth 1 entry)) + (gnus-group-insert-group-line + (gnus-info-group info) + (gnus-info-level info) (gnus-info-marks info) + (car entry) (gnus-info-method info))))) + (when (and (listp entry) + (numberp (car entry))) + (cl-incf unread (car entry))) + (when (listp entry) + (setq tick t)))) + (goto-char beg) + ;; Insert the topic line. + (when (and (not silent) + (or gnus-topic-display-empty-topics ;We want empty topics + (not (zerop unread)) ;Non-empty + tick ;Ticked articles + (/= point-max (point-max)))) ;Inactive groups + (gnus-topic-insert-topic-line + name visiblep + (not (eq (nth 2 type) 'hidden)) + level all-entries unread all-groups)) + (gnus-topic-update-unreads name unread) + (gnus-group--setup-tool-bar-update beg end) + (goto-char end) + unread))) (defun gnus-topic-remove-topic (&optional insert total-remove _hide in-level) "Remove the current topic." commit d858a637c2ef35079fbc6cd8b2674c6b13de1e99 Author: Mattias Engdegård Date: Tue Aug 10 17:04:34 2021 +0200 More robust auto-detect of grep-highlight-matches (bug#49978) * lisp/progmodes/grep.el (grep-compute-defaults): Don't require "grep --help" to finish with exit status 0 (BSD grep does not) and check the output in a slightly more robust way. diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 8f0a5acf70..b2a9b3e320 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -696,11 +696,12 @@ The value depends on `grep-command', `grep-template', (when (eq grep-highlight-matches 'auto-detect) (setq grep-highlight-matches (with-temp-buffer - (and (grep-probe grep-program '(nil t nil "--help")) - (progn - (goto-char (point-min)) - (search-forward "--color" nil t)) - ;; Windows and DOS pipes fail `isatty' detection in Grep. + ;; The "grep --help" exit status varies; pay no attention to it. + (grep-probe grep-program '(nil t nil "--help")) + (goto-char (point-min)) + (and (let ((case-fold-search nil)) + (re-search-forward (rx "--color" (not (in "a-z"))) nil t)) + ;; Windows and DOS pipes fail `isatty' detection in Grep. (if (memq system-type '(windows-nt ms-dos)) 'always 'auto))))) commit ebaae4480eecb7e4757296d0a2b776ad0b960be8 Author: Lars Ingebrigtsen Date: Tue Aug 10 16:40:58 2021 +0200 Add a new command `revert-buffer-quick' * doc/emacs/files.texi (Reverting): Document it. * lisp/bindings.el (ctl-x-x-map): Bind `C-x x g' to `revert-buffer-quick' instead. * lisp/files.el (revert-buffer-quick-short-answers): New user option. (revert-buffer-quick): New command (bug#49869). diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 7edf4d2bbb..8304e40706 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -948,7 +948,7 @@ Manual}). For customizations, see the Custom group @code{time-stamp}. then change your mind, you can @dfn{revert} the changes and go back to the saved version of the file. To do this, type @kbd{C-x x g}. Since reverting unintentionally could lose a lot of work, Emacs asks for -confirmation first. +confirmation first if the buffer is modified. The @code{revert-buffer} command tries to position point in such a way that, if the file was edited only slightly, you will be at @@ -991,6 +991,17 @@ revert it automatically if it has changed---provided the buffer itself is not modified. (If you have edited the text, it would be wrong to discard your changes.) +@vindex revert-buffer-quick-short-answers +@findex revert-buffer-quick + The @kbd{C-x x g} keystroke is bound to the +@code{revert-buffer-quick} command. This is like the +@code{revert-buffer} command, but prompts less. Unlike +@code{revert-buffer}, it will not prompt if the current buffer visits +a file, and the buffer is not modified. It also respects the +@code{revert-buffer-quick-short-answers} user option. If this option +is non-@code{nil}, use a shorter @kbd{y/n} query instead of a longer +@kbd{yes/no} query. + You can also tell Emacs to revert buffers automatically when their visited files change on disk; @pxref{Auto Revert}. diff --git a/etc/NEWS b/etc/NEWS index 378a32e2d3..34e4cd73a7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -310,7 +310,7 @@ search buffer due to too many matches being highlighted. +++ ** A new keymap for buffer actions has been added. The 'C-x x' keymap now holds keystrokes for various buffer-oriented -commands. The new keystrokes are 'C-x x g' ('revert-buffer'), +commands. The new keystrokes are 'C-x x g' ('revert-buffer-quick'), 'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n' ('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t' ('toggle-truncate-lines') and 'C-x x f' ('font-lock-update'). @@ -2394,6 +2394,16 @@ This command, called interactively, toggles the local value of ** Miscellaneous ++++ +*** New command 'revert-buffer-quick'. +This is bound to 'C-x x g' and is like `revert-buffer', but prompts +less. + ++++ +*** New user option 'revert-buffer-quick-short-answers'. This +controls how the new 'revert-buffer-quick' (`C-x x g') command +prompts. + --- *** fileloop will now skip missing files instead of signalling an error. diff --git a/lisp/bindings.el b/lisp/bindings.el index 8e5799fbe8..0345944894 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1469,7 +1469,7 @@ if `inhibit-field-text-motion' is non-nil." (defvar ctl-x-x-map (let ((map (make-sparse-keymap))) (define-key map "f" #'font-lock-update) - (define-key map "g" #'revert-buffer) + (define-key map "g" #'revert-buffer-quick) (define-key map "r" #'rename-buffer) (define-key map "u" #'rename-uniquely) (define-key map "n" #'clone-buffer) diff --git a/lisp/files.el b/lisp/files.el index 6c366177ce..dffce2b247 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6561,6 +6561,37 @@ details on the arguments, see `revert-buffer'." (revert-buffer-with-fine-grain-success-p) (fmakunbound 'revert-buffer-with-fine-grain-success-p))))) +(defcustom revert-buffer-quick-short-answers nil + "How much confirmation to be done by the `revert-buffer-quit' command. +If non-nil, use `y-or-n-p' instead of `yes-or-no-p'." + :version "28.1" + :type 'boolean) + +(defun revert-buffer-quick (&optional auto-save) + "Like `revert-buffer', but asks for less confirmation. +If the current buffer is visiting a file, and the buffer is not +modified, no confirmation is required. + +This command heeds the `revert-buffer-quick-short-answers' user option. + +If AUTO-SAVE (the prefix argument), offer to revert from latest +auto-save file, if that is more recent than the visited file." + (interactive "P") + (cond + ;; If we've visiting a file, and we have no changes, don't ask for + ;; confirmation. + ((and buffer-file-name + (not (buffer-modified-p))) + (revert-buffer (not auto-save) t) + (message "Reverted buffer")) + ;; Heed `revert-buffer-quick-short-answers'. + (revert-buffer-quick-short-answers + (let ((use-short-answers t)) + (revert-buffer (not auto-save)))) + ;; Call `revert-buffer' normally. + (t + (revert-buffer (not auto-save))))) + (defun recover-this-file () "Recover the visited file--get contents from its last auto-save file." (interactive) commit 2656ecff96558ce2d5adf726a8574360175e6740 Author: Benjamin Riefenstahl Date: Tue Aug 10 15:47:50 2021 +0200 Fix nnrss-get-namespace-prefix (bug#34685) * lisp/gnus/nnrss.el (nnrss-get-namespace-prefix): Use the car of parameter el to match what dom-search expects. * test/lisp/gnus/nnrss-tests.el (test-nnrss-xml): Adjust to what xml-parse-region produces (bug#34685). diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 0f12ee0e9d..97c9f18a60 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -954,9 +954,10 @@ Simply ensures that the first element is rss or rdf." "Given EL (containing a parsed element) and URI (containing a string that gives the URI for which you want to retrieve the namespace prefix), return the prefix." - (let* ((prefix (car (rassoc uri (dom-attributes - (dom-search - el + (let* ((dom (car el)) + (prefix (car (rassoc uri (dom-attributes + (dom-search + dom (lambda (node) (rassoc uri (dom-attributes node)))))))) (nslist (if prefix diff --git a/test/lisp/gnus/nnrss-tests.el b/test/lisp/gnus/nnrss-tests.el index 01b374a2f6..92b7dacf18 100644 --- a/test/lisp/gnus/nnrss-tests.el +++ b/test/lisp/gnus/nnrss-tests.el @@ -27,11 +27,11 @@ "Fri, 17 Sep 2004 05:09:49 +0000"))) (defconst test-nnrss-xml - '(rss - ((version . "2.0") - (xmlns:dc . "http://purl.org/dc/elements/1.1/")) - (channel - ((xmlns:content . "http://purl.org/rss/1.0/modules/content/"))))) + '((rss + ((version . "2.0") + (xmlns:dc . "http://purl.org/dc/elements/1.1/")) + (channel + ((xmlns:content . "http://purl.org/rss/1.0/modules/content/")))))) (ert-deftest test-nnrss-namespace-top () (should (equal (nnrss-get-namespace-prefix commit 1572464b9271472b8d7a36b698541afc59b44870 Author: Mattias Engdegård Date: Tue Aug 10 15:05:51 2021 +0200 Tramp string-search and string-replace compatibility functions Add a `string-search` compatibility function for use in Tramp with Emacs version prior to 28, and fix the existing `string-replace` compatibility function so that it uses the right semantics. * lisp/net/tramp-compat.el (tramp-compat-string-replace): Use case-sensitive matching and literal replacement. (tramp-compat-string-search): New function. * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions) (tramp-do-copy-or-rename-file-out-of-band) (tramp-sh-handle-make-process, tramp-sh-handle-process-file): * lisp/net/tramp.el (tramp-handle-make-process): Use `tramp-compat-string-search` instead of `string-match-p`. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 6e46407337..b713d5eae8 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -351,7 +351,17 @@ A nil value for either argument stands for the current time." (if (fboundp 'string-replace) #'string-replace (lambda (fromstring tostring instring) - (replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) + (let ((case-fold-search nil)) + (replace-regexp-in-string + (regexp-quote fromstring) tostring instring t t))))) + +;; Function `string-search' is new in Emacs 28.1. +(defalias 'tramp-compat-string-search + (if (fboundp 'string-search) + #'string-search + (lambda (needle haystack &optional start-pos) + (let ((case-fold-search nil)) + (string-match-p (regexp-quote needle) haystack start-pos))))) ;; Function `make-lock-file-name' is new in Emacs 28.1. (defalias 'tramp-compat-make-lock-file-name diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index eff14a2912..e4f54cf4c4 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1401,7 +1401,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (unless (string-match-p "/" filename) + (unless (tramp-compat-string-search "/" filename) (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e7d2634c58..c3b8df9e57 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1740,7 +1740,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; files. (defun tramp-sh-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (unless (string-match-p "/" filename) + (unless (tramp-compat-string-search "/" filename) (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil @@ -2309,7 +2309,8 @@ The method used must be an out-of-band method." copy-args (tramp-compat-flatten-tree (mapcar - (lambda (x) (if (string-match-p " " x) (split-string x) x)) + (lambda (x) (if (tramp-compat-string-search " " x) + (split-string x) x)) copy-args)) copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec) remote-copy-program @@ -2828,7 +2829,7 @@ implementation will be used." (env (dolist (elt (cons prompt process-environment) env) (or (member elt (default-toplevel-value 'process-environment)) - (if (string-match-p "=" elt) + (if (tramp-compat-string-search "=" elt) (setq env (append env `(,elt))) (setq uenv (cons elt uenv)))))) (env (setenv-internal @@ -3039,7 +3040,7 @@ implementation will be used." ;; We use as environment the difference to toplevel `process-environment'. (dolist (elt process-environment) (or (member elt (default-toplevel-value 'process-environment)) - (if (string-match-p "=" elt) + (if (tramp-compat-string-search "=" elt) (setq env (append env `(,elt))) (setq uenv (cons elt uenv))))) (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3a392dd5f8..fd426960fd 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4130,14 +4130,14 @@ substitution. SPEC-LIST is a list of char/value pairs used for (generate-new-buffer tramp-temp-buffer-name))) (env (mapcar (lambda (elt) - (when (string-match-p "=" elt) elt)) + (when (tramp-compat-string-search "=" elt) elt)) tramp-remote-process-environment)) ;; We use as environment the difference to toplevel ;; `process-environment'. (env (dolist (elt process-environment env) (when (and - (string-match-p "=" elt) + (tramp-compat-string-search "=" elt) (not (member elt (default-toplevel-value 'process-environment))))