diff options
Diffstat (limited to 'lisp/gnus')
53 files changed, 1957 insertions, 1784 deletions
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index bcf8dd014bc..68a90989046 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -239,6 +239,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST." "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." + (declare (indent defun)) (let ((defined-p (fboundp function))) (if defined-p `(defalias ',name ',function) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index cbe3505cd10..20da295aca9 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -161,7 +161,7 @@ enable expiration per categories, topics, and groups." (defcustom gnus-agent-expire-unagentized-dirs t "Whether expiration should expire in unagentized directories. -Have gnus-agent-expire scan the directories under +Have `gnus-agent-expire' scan the directories under \(gnus-agent-directory) for groups that are no longer agentized. When found, offer to remove them." :version "22.1" @@ -475,17 +475,16 @@ manipulated as follows: (gnus-run-hooks 'gnus-agent-mode-hook (intern (format "gnus-agent-%s-mode-hook" buffer))))) -(defvar gnus-agent-group-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-group-mode-map - "Ju" gnus-agent-fetch-groups - "Jc" gnus-enter-category-buffer - "Jj" gnus-agent-toggle-plugged - "Js" gnus-agent-fetch-session - "JY" gnus-agent-synchronize-flags - "JS" gnus-group-send-queue - "Ja" gnus-agent-add-group - "Jr" gnus-agent-remove-group - "Jo" gnus-agent-toggle-group-plugged) +(defvar-keymap gnus-agent-group-mode-map + "Ju" #'gnus-agent-fetch-groups + "Jc" #'gnus-enter-category-buffer + "Jj" #'gnus-agent-toggle-plugged + "Js" #'gnus-agent-fetch-session + "JY" #'gnus-agent-synchronize-flags + "JS" #'gnus-group-send-queue + "Ja" #'gnus-agent-add-group + "Jr" #'gnus-agent-remove-group + "Jo" #'gnus-agent-toggle-group-plugged) (defun gnus-agent-group-make-menu-bar () (unless (boundp 'gnus-agent-group-menu) @@ -504,16 +503,15 @@ manipulated as follows: ["Synchronize flags" gnus-agent-synchronize-flags t] )))) -(defvar gnus-agent-summary-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-summary-mode-map - "Jj" gnus-agent-toggle-plugged - "Ju" gnus-agent-summary-fetch-group - "JS" gnus-agent-fetch-group - "Js" gnus-agent-summary-fetch-series - "J#" gnus-agent-mark-article - "J\M-#" gnus-agent-unmark-article - "@" gnus-agent-toggle-mark - "Jc" gnus-agent-catchup) +(defvar-keymap gnus-agent-summary-mode-map + "Jj" #'gnus-agent-toggle-plugged + "Ju" #'gnus-agent-summary-fetch-group + "JS" #'gnus-agent-fetch-group + "Js" #'gnus-agent-summary-fetch-series + "J#" #'gnus-agent-mark-article + "J\M-#" #'gnus-agent-unmark-article + "@" #'gnus-agent-toggle-mark + "Jc" #'gnus-agent-catchup) (defun gnus-agent-summary-make-menu-bar () (unless (boundp 'gnus-agent-summary-menu) @@ -527,11 +525,10 @@ manipulated as follows: ["Fetch downloadable" gnus-agent-summary-fetch-group t] ["Catchup undownloaded" gnus-agent-catchup t])))) -(defvar gnus-agent-server-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-server-mode-map - "Jj" gnus-agent-toggle-plugged - "Ja" gnus-agent-add-server - "Jr" gnus-agent-remove-server) +(defvar-keymap gnus-agent-server-mode-map + "Jj" #'gnus-agent-toggle-plugged + "Ja" #'gnus-agent-add-server + "Jr" #'gnus-agent-remove-server) (defun gnus-agent-server-make-menu-bar () (unless (boundp 'gnus-agent-server-menu) @@ -622,7 +619,7 @@ manipulated as follows: The gnus-agentize function is now called internally by gnus when gnus-agent is set. If you wish to avoid calling gnus-agentize, -customize gnus-agent to nil. +customize `gnus-agent' to nil. This will modify the `gnus-setup-news-hook', and `message-send-mail-real-function' variables, and install the Gnus agent @@ -1323,7 +1320,7 @@ downloaded into the agent." (gnus-agent-set-local group agent-min (1- active-min))))))) (defun gnus-agent-save-group-info (method group active) - "Update a single group's active range in the agent's copy of the server's active file." + "Update single group's active range in agent's copy of server's active file." (when (gnus-agent-method-p method) (let* ((gnus-command-method (or method gnus-command-method)) (coding-system-for-write nnheader-file-coding-system) @@ -1356,7 +1353,7 @@ downloaded into the agent." (delete-char 1))))))) (defun gnus-agent-get-group-info (method group) - "Get a single group's active range in the agent's copy of the server's active file." + "Get single group's active range in agent's copy of server's active file." (when (gnus-agent-method-p method) (let* ((gnus-command-method (or method gnus-command-method)) (coding-system-for-write nnheader-file-coding-system) @@ -1703,8 +1700,8 @@ and that there are no duplicates." (defun gnus-agent-flush-server (&optional server-or-method) "Flush all agent index files for every subscribed group within - the given SERVER-OR-METHOD. When called with nil, the current - value of gnus-command-method identifies the server." +the given SERVER-OR-METHOD. When called with nil, the current +value of gnus-command-method identifies the server." (let* ((gnus-command-method (if server-or-method (gnus-server-to-method server-or-method) gnus-command-method)) @@ -2153,8 +2150,9 @@ doesn't exist, to valid the overview buffer." (defvar gnus-agent-file-loading-local nil) (defun gnus-agent-load-local (&optional method) - "Load the METHOD'S local file. The local file contains min/max -article counts for each of the method's subscribed groups." + "Load the METHOD'S local file. +The local file contains min/max article counts for each of the +method's subscribed groups." (let ((gnus-command-method (or method gnus-command-method))) (when (or (null gnus-agent-article-local-times) (zerop gnus-agent-article-local-times) @@ -2171,9 +2169,9 @@ article counts for each of the method's subscribed groups." gnus-agent-article-local)) (defun gnus-agent-read-and-cache-local (file) - "Load and read FILE then bind its contents to -gnus-agent-article-local. If that variable had `dirty' (also known as -modified) original contents, they are first saved to their own file." + "Load and read FILE then bind its contents to `gnus-agent-article-local'. +If that variable had `dirty' (also known as modified) original +contents, they are first saved to their own file." (if (and gnus-agent-article-local (gethash "+dirty" gnus-agent-article-local)) (gnus-agent-save-local)) @@ -2224,7 +2222,7 @@ modified) original contents, they are first saved to their own file." hashtb)) (defun gnus-agent-save-local (&optional force) - "Save gnus-agent-article-local under it method's agent.lib directory." + "Save `gnus-agent-article-local' under it method's agent.lib directory." (let ((hashtb gnus-agent-article-local)) (when (and hashtb (or force (gethash "+dirty" hashtb))) @@ -2596,25 +2594,20 @@ General format specifiers can also be used. See Info node (defvar gnus-category-line-format-spec nil) (defvar gnus-category-mode-line-format-spec nil) -(defvar gnus-category-mode-map nil) - -(unless gnus-category-mode-map - (setq gnus-category-mode-map (make-sparse-keymap)) - (suppress-keymap gnus-category-mode-map) - - (gnus-define-keys gnus-category-mode-map - "q" gnus-category-exit - "k" gnus-category-kill - "c" gnus-category-copy - "a" gnus-category-add - "e" gnus-agent-customize-category - "p" gnus-category-edit-predicate - "g" gnus-category-edit-groups - "s" gnus-category-edit-score - "l" gnus-category-list - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) +(defvar-keymap gnus-category-mode-map + :suppress t + "q" #'gnus-category-exit + "k" #'gnus-category-kill + "c" #'gnus-category-copy + "a" #'gnus-category-add + "e" #'gnus-agent-customize-category + "p" #'gnus-category-edit-predicate + "g" #'gnus-category-edit-groups + "s" #'gnus-category-edit-score + "l" #'gnus-category-list + + "\C-c\C-i" #'gnus-info-find-node + "\C-c\C-b" #'gnus-bug) (defcustom gnus-category-menu-hook nil "Hook run after the creation of the menu." @@ -3552,32 +3545,13 @@ articles in every agentized group? ")) (when (and to-remove (or gnus-expert-user (gnus-y-or-n-p - "gnus-agent-expire has identified local directories that are\ - not currently required by any agentized group. Do you wish to consider\ - deleting them?"))) - (while to-remove - (let ((dir (pop to-remove))) - (if (or gnus-expert-user + "gnus-agent-expire has identified local directories that are +not currently required by any agentized group. Do you wish to consider +deleting them?"))) + (dolist (dir to-remove) + (when (or gnus-expert-user (gnus-y-or-n-p (format "Delete %s? " dir))) - (let* (delete-recursive - files f - (delete-recursive - (lambda (f-or-d) - (ignore-errors - (if (file-directory-p f-or-d) - (condition-case nil - (delete-directory f-or-d) - (file-error - (setq files (directory-files f-or-d)) - (while files - (setq f (pop files)) - (or (member f '("." "..")) - (funcall delete-recursive - (nnheader-concat - f-or-d f)))) - (delete-directory f-or-d))) - (delete-file f-or-d)))))) - (funcall delete-recursive dir))))))))) + (delete-directory dir t))))))) ;;;###autoload (defun gnus-agent-batch () diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index b989446792b..89b4a63ad92 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -610,17 +610,17 @@ The recommended coding systems are `utf-8', `iso-2022-7bit' and so on, which can safely encode any characters in text. This is used by the commands including: -* gnus-summary-save-article-file -* gnus-summary-save-article-body-file -* gnus-summary-write-article-file -* gnus-summary-write-article-body-file +* `gnus-summary-save-article-file' +* `gnus-summary-save-article-body-file' +* `gnus-summary-write-article-file' +* `gnus-summary-write-article-body-file' and the functions to which you may set `gnus-default-article-saver': -* gnus-summary-save-in-file -* gnus-summary-save-body-in-file -* gnus-summary-write-to-file -* gnus-summary-write-body-to-file +* `gnus-summary-save-in-file' +* `gnus-summary-save-body-in-file' +* `gnus-summary-write-to-file' +* `gnus-summary-write-body-to-file' Those commands and functions save just text displayed in the article buffer to a file if the value of this variable is non-nil. Note that @@ -1167,6 +1167,19 @@ predicate. See Info node `(gnus)Customizing Articles'." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) +(defcustom gnus-treat-emojize-symbols nil + "Display emoji versions of symbol. +Some symbols have both a non-emoji presentation and an emoji +presentation. This treatment will make Gnus display the latter +as emojis even when they weren't sent as such. + +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." + :version "29.1" + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + (defcustom gnus-treat-unsplit-urls nil "Remove newlines from within URLs. Valid values are nil, t, `head', `first', `last', an integer or a @@ -1650,6 +1663,7 @@ regexp." (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist '((gnus-treat-strip-cr gnus-article-remove-cr) + (gnus-treat-emojize-symbols gnus-article-emojize-symbols) (gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig) (gnus-treat-strip-banner gnus-article-strip-banner) (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body) @@ -2243,6 +2257,14 @@ This only works if the article in question is HTML." (funcall function (get-text-property start 'image-url) start end))))))) +(defun gnus-article-toggle-fonts () + "Toggle the use of proportional fonts for HTML articles." + (interactive nil gnus-article-mode gnus-summary-mode) + (gnus-with-article-buffer + (when (eq mm-text-html-renderer 'shr) + (setq-local shr-use-fonts (not shr-use-fonts)) + (gnus-summary-show-article)))) + (defun gnus-article-treat-fold-newsgroups () "Fold the Newsgroups and Followup-To message headers." (interactive nil gnus-article-mode gnus-summary-mode) @@ -2352,6 +2374,20 @@ fill width." (while (search-forward "\r" nil t) (replace-match "\n" t t))))) +(defun article-emojize-symbols () + "Display symbols (that have an emoji version) as emojis." + (interactive nil gnus-article-mode) + (when-let ((font (and (display-multi-font-p) + (car (internal-char-font nil ?😀))))) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (while (re-search-forward "[[:multibyte:]]" nil t) + ;; If there's already a grapheme cluster here, skip it. + (when (and (not (find-composition (point))) + (font-has-char-p font (char-after (match-beginning 0)))) + (insert "\N{VARIATION SELECTOR-16}"))))))) + (defun article-remove-trailing-blank-lines () "Remove all trailing blank lines from the article." (interactive nil gnus-article-mode) @@ -2519,7 +2555,7 @@ If PROMPT (the prefix), prompt for a coding system to use." format (and ctl (mail-content-type-get ctl 'format))) (when cte (setq cte (mail-header-strip-cte cte))) - (if (and ctl (not (string-match "/" (car ctl)))) + (if (and ctl (not (string-search "/" (car ctl)))) (setq ctl nil)) (goto-char (point-max))) (forward-line 1) @@ -3925,8 +3961,8 @@ This format is defined by the `gnus-article-time-format' variable." ;; No split name was found. ((null split-name) (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) "): ") + (format-prompt prompt + (file-name-nondirectory default-name)) (file-name-directory default-name) default-name)) ;; A single group name is returned. @@ -3935,8 +3971,8 @@ This format is defined by the `gnus-article-time-format' variable." (funcall function split-name headers (symbol-value variable))) (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) "): ") + (format-prompt prompt + (file-name-nondirectory default-name)) (file-name-directory default-name) default-name)) ;; A single split name was found @@ -3948,9 +3984,8 @@ This format is defined by the `gnus-article-time-format' variable." (file-name-as-directory name)) ((file-exists-p name) name) (t gnus-article-save-directory)))) - (read-file-name - (concat prompt " (default " name "): ") - dir name))) + (read-file-name (format-prompt prompt name) + dir name))) ;; A list of splits was found. (t (setq split-name (nreverse split-name)) @@ -4271,7 +4306,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (insert "Version: " (car items) "\n\n") (insert (mapconcat #'identity (cddr items) "\n")) (insert "\n-----END PGP SIGNATURE-----\n") - (let ((mm-security-handle (list (format "multipart/signed")))) + (let ((mm-security-handle (list (substring "multipart/signed")))) (mml2015-clean-buffer) (let ((coding-system-for-write (or gnus-newsgroup-charset 'iso-8859-1))) @@ -4334,6 +4369,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-fill-long-lines article-capitalize-sentences article-remove-cr + article-emojize-symbols article-remove-leading-whitespace article-display-x-face article-display-face @@ -4379,44 +4415,44 @@ If variable `gnus-use-long-file-name' is non-nil, it is ;;; Gnus article mode ;;; -(set-keymap-parent gnus-article-mode-map button-buffer-map) - -(gnus-define-keys gnus-article-mode-map - " " gnus-article-goto-next-page - [?\S-\ ] gnus-article-goto-prev-page - "\177" gnus-article-goto-prev-page - [delete] gnus-article-goto-prev-page - "\C-c^" gnus-article-refer-article - "h" gnus-article-show-summary - "s" gnus-article-show-summary - "\C-c\C-m" gnus-article-mail - "?" gnus-article-describe-briefly - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug - "R" gnus-article-reply-with-original - "F" gnus-article-followup-with-original - "\C-hk" gnus-article-describe-key - "\C-hc" gnus-article-describe-key-briefly - "\C-hb" gnus-article-describe-bindings - - "e" gnus-article-read-summary-keys - "\C-d" gnus-article-read-summary-keys - "\C-c\C-f" gnus-summary-mail-forward - "\M-*" gnus-article-read-summary-keys - "\M-#" gnus-article-read-summary-keys - "\M-^" gnus-article-read-summary-keys - "\M-g" gnus-article-read-summary-keys) +(defvar gnus-article-send-map nil) + +(define-keymap :keymap gnus-article-mode-map :suppress t + :parent button-buffer-map + " " #'gnus-article-goto-next-page + [?\S-\ ] #'gnus-article-goto-prev-page + "\177" #'gnus-article-goto-prev-page + [delete] #'gnus-article-goto-prev-page + "\C-c^" #'gnus-article-refer-article + "h" #'gnus-article-show-summary + "s" #'gnus-article-show-summary + "\C-c\C-m" #'gnus-article-mail + "?" #'gnus-article-describe-briefly + "<" #'beginning-of-buffer + ">" #'end-of-buffer + "\C-c\C-i" #'gnus-info-find-node + "\C-c\C-b" #'gnus-bug + "R" #'gnus-article-reply-with-original + "F" #'gnus-article-followup-with-original + "\C-hk" #'gnus-article-describe-key + "\C-hc" #'gnus-article-describe-key-briefly + "\C-hb" #'gnus-article-describe-bindings + + "e" #'gnus-article-read-summary-keys + "\C-d" #'gnus-article-read-summary-keys + "\C-c\C-f" #'gnus-summary-mail-forward + "\M-*" #'gnus-article-read-summary-keys + "\M-#" #'gnus-article-read-summary-keys + "\M-^" #'gnus-article-read-summary-keys + "\M-g" #'gnus-article-read-summary-keys + + "S" (define-keymap :prefix 'gnus-article-send-map + "W" #'gnus-article-wide-reply-with-original + [t] #'gnus-article-read-summary-send-keys)) (substitute-key-definition #'undefined #'gnus-article-read-summary-keys gnus-article-mode-map) -(defvar gnus-article-send-map) -(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) - "W" gnus-article-wide-reply-with-original - [t] gnus-article-read-summary-send-keys) - (defun gnus-article-make-menu-bar () (unless (boundp 'gnus-article-commands-menu) (gnus-summary-make-menu-bar)) @@ -4441,6 +4477,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Treat overstrike" gnus-article-treat-overstrike t] ["Treat ANSI sequences" gnus-article-treat-ansi-sequences t] ["Remove carriage return" gnus-article-remove-cr t] + ["Emojize Symbols" gnus-article-emojize-symbols t] ["Remove leading whitespace" gnus-article-remove-leading-whitespace t] ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] ["Remove base64" gnus-article-de-base64-unreadable t] @@ -4499,6 +4536,10 @@ commands: (gnus-set-default-directory) (buffer-disable-undo) (setq show-trailing-whitespace nil) + ;; Arrange a callback from `mm-inline-message' if we're + ;; displaying a message/rfc822 part. + (setq-local mm-inline-message-prepare-function + #'gnus-mime--inline-message-function) (mm-enable-multibyte)) (defun gnus-article-setup-buffer () @@ -6034,31 +6075,29 @@ If nil, don't show those extra buttons." (defun gnus-mime-display-mixed (handles) (mapcar #'gnus-mime-display-part handles)) +(defun gnus-mime--inline-message-function (handle charset) + (let ((handles + (let (gnus-article-mime-handles + ;; disable prepare hook + gnus-article-prepare-hook + (gnus-newsgroup-charset + ;; mm-uu might set it. + (unless (eq charset 'gnus-decoded) + (or charset gnus-newsgroup-charset)))) + (let ((gnus-original-article-buffer + (mm-handle-buffer handle))) + (run-hooks 'gnus-article-decode-hook)) + (gnus-article-prepare-display) + gnus-article-mime-handles))) + (when handles + (setq gnus-article-mime-handles + (mm-merge-handles gnus-article-mime-handles handles))))) + (defun gnus-mime-display-single (handle) (let ((type (mm-handle-media-type handle)) (ignored gnus-ignored-mime-types) (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight)) (not-attachment t) - ;; Arrange a callback from `mm-inline-message' if we're - ;; displaying a message/rfc822 part. - (mm-inline-message-prepare-function - (lambda (charset) - (let ((handles - (let (gnus-article-mime-handles - ;; disable prepare hook - gnus-article-prepare-hook - (gnus-newsgroup-charset - ;; mm-uu might set it. - (unless (eq charset 'gnus-decoded) - (or charset gnus-newsgroup-charset)))) - (let ((gnus-original-article-buffer - (mm-handle-buffer handle))) - (run-hooks 'gnus-article-decode-hook)) - (gnus-article-prepare-display) - gnus-article-mime-handles))) - (when handles - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles)))))) display text gnus-displaying-mime) (catch 'ignored @@ -6238,8 +6277,9 @@ If nil, don't show those extra buttons." (gnus-display-mime preferred) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets))) + (and (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)))) (gnus-bind-mm-vars (mm-display-part preferred)) ;; Do highlighting. (save-excursion @@ -6857,7 +6897,9 @@ KEY is a string or a vector." unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) - (describe-key (read-key-sequence nil t)))) + (describe-key (cons (read-key-sequence nil t) + (this-single-command-raw-keys)) + (current-buffer)))) (describe-key key))) (defun gnus-article-describe-key-briefly (key &optional insert) @@ -6880,7 +6922,9 @@ KEY is a string or a vector." unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) - (describe-key-briefly (read-key-sequence nil t) insert))) + (describe-key-briefly (cons (read-key-sequence nil t) + (this-single-command-raw-keys)) + insert (current-buffer)))) (describe-key-briefly key insert))) ;;`gnus-agent-mode' in gnus-agent.el will define it. @@ -7208,50 +7252,43 @@ other groups." (defvar gnus-article-edit-done-function nil) -(defvar gnus-article-edit-mode-map nil) - -;; Should we be using derived.el for this? -(unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (make-keymap)) - (set-keymap-parent gnus-article-edit-mode-map text-mode-map) - - (gnus-define-keys gnus-article-edit-mode-map - "\C-c?" describe-mode - "\C-c\C-c" gnus-article-edit-done - "\C-c\C-k" gnus-article-edit-exit - "\C-c\C-f\C-t" message-goto-to - "\C-c\C-f\C-o" message-goto-from - "\C-c\C-f\C-b" message-goto-bcc - ;;"\C-c\C-f\C-w" message-goto-fcc - "\C-c\C-f\C-c" message-goto-cc - "\C-c\C-f\C-s" message-goto-subject - "\C-c\C-f\C-r" message-goto-reply-to - "\C-c\C-f\C-n" message-goto-newsgroups - "\C-c\C-f\C-d" message-goto-distribution - "\C-c\C-f\C-f" message-goto-followup-to - "\C-c\C-f\C-m" message-goto-mail-followup-to - "\C-c\C-f\C-k" message-goto-keywords - "\C-c\C-f\C-u" message-goto-summary - "\C-c\C-f\C-i" message-insert-or-toggle-importance - "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to - "\C-c\C-b" message-goto-body - "\C-c\C-i" message-goto-signature - - "\C-c\C-t" message-insert-to - "\C-c\C-n" message-insert-newsgroups - "\C-c\C-o" message-sort-headers - "\C-c\C-e" message-elide-region - "\C-c\C-v" message-delete-not-region - "\C-c\C-z" message-kill-to-signature - "\M-\r" message-newline-and-reformat - "\C-c\C-a" mml-attach-file - "\C-a" message-beginning-of-line - "\t" message-tab - "\M-;" comment-region) - - (gnus-define-keys (gnus-article-edit-wash-map - "\C-c\C-w" gnus-article-edit-mode-map) - "f" gnus-article-edit-full-stops)) +(defvar-keymap gnus-article-edit-mode-map + :full t :parent text-mode-map + "\C-c?" #'describe-mode + "\C-c\C-c" #'gnus-article-edit-done + "\C-c\C-k" #'gnus-article-edit-exit + "\C-c\C-f\C-t" #'message-goto-to + "\C-c\C-f\C-o" #'message-goto-from + "\C-c\C-f\C-b" #'message-goto-bcc + ;;"\C-c\C-f\C-w" message-goto-fcc + "\C-c\C-f\C-c" #'message-goto-cc + "\C-c\C-f\C-s" #'message-goto-subject + "\C-c\C-f\C-r" #'message-goto-reply-to + "\C-c\C-f\C-n" #'message-goto-newsgroups + "\C-c\C-f\C-d" #'message-goto-distribution + "\C-c\C-f\C-f" #'message-goto-followup-to + "\C-c\C-f\C-m" #'message-goto-mail-followup-to + "\C-c\C-f\C-k" #'message-goto-keywords + "\C-c\C-f\C-u" #'message-goto-summary + "\C-c\C-f\C-i" #'message-insert-or-toggle-importance + "\C-c\C-f\C-a" #'message-generate-unsubscribed-mail-followup-to + "\C-c\C-b" #'message-goto-body + "\C-c\C-i" #'message-goto-signature + + "\C-c\C-t" #'message-insert-to + "\C-c\C-n" #'message-insert-newsgroups + "\C-c\C-o" #'message-sort-headers + "\C-c\C-e" #'message-elide-region + "\C-c\C-v" #'message-delete-not-region + "\C-c\C-z" #'message-kill-to-signature + "\M-\r" #'message-newline-and-reformat + "\C-c\C-a" #'mml-attach-file + "\C-a" #'message-beginning-of-line + "\t" #'message-tab + "\M-;" #'comment-region + + "\C-c\C-w" (define-keymap :prefix 'gnus-article-edit-wash-map + "f" #'gnus-article-edit-full-stops)) (easy-menu-define gnus-article-edit-mode-field-menu gnus-article-edit-mode-map "" @@ -8287,7 +8324,7 @@ url is put as the `gnus-button-url' overlay property on the button." ")" (gnus-url-unhex-string (match-string 2 url))))) ((string-match "([^)\"]+)[^\"]+" url) (setq url - (replace-regexp-in-string + (string-replace "\"" "" (replace-regexp-in-string "[\n\t ]+" " " url))) (gnus-info-find-node url)) (t (error "Can't parse %s" url)))) @@ -8510,8 +8547,7 @@ whose names match REGEXP. For example: \((\"chinese\" . gnus-decode-encoded-word-region-by-guess) mail-decode-encoded-word-region - (\"chinese\" . rfc1843-decode-region)) -") + (\"chinese\" . rfc1843-decode-region))") (defvar gnus-decode-header-methods-cache nil) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 8c2a928ab98..171da9d17a0 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -198,7 +198,9 @@ So the cdr of each bookmark is an alist too.") (defun gnus-bookmark-make-record (group message-id author date subject annotation) - "Return the record part of a new bookmark, given GROUP MESSAGE-ID AUTHOR DATE SUBJECT and ANNOTATION." + "Return the record part of a new bookmark. +Arguments GROUP MESSAGE-ID AUTHOR DATE SUBJECT and ANNOTATION +will be saved in the bookmark." (let ((the-record `((group . ,(substring-no-properties group)) (message-id . ,(substring-no-properties message-id)) @@ -416,32 +418,29 @@ That is, all information but the name." (defvar gnus-bookmark-bmenu-bookmark-column nil) (defvar gnus-bookmark-bmenu-hidden-bookmarks ()) -(defvar gnus-bookmark-bmenu-mode-map nil) - -(if gnus-bookmark-bmenu-mode-map - nil - (setq gnus-bookmark-bmenu-mode-map (make-keymap)) - (suppress-keymap gnus-bookmark-bmenu-mode-map t) - (define-key gnus-bookmark-bmenu-mode-map "q" 'quit-window) - (define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select) - (define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select) - (define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete) - (define-key gnus-bookmark-bmenu-mode-map "k" 'gnus-bookmark-bmenu-delete) - (define-key gnus-bookmark-bmenu-mode-map "\C-d" 'gnus-bookmark-bmenu-delete-backwards) - (define-key gnus-bookmark-bmenu-mode-map "x" 'gnus-bookmark-bmenu-execute-deletions) - (define-key gnus-bookmark-bmenu-mode-map " " 'next-line) - (define-key gnus-bookmark-bmenu-mode-map "n" 'next-line) - (define-key gnus-bookmark-bmenu-mode-map "p" 'previous-line) - (define-key gnus-bookmark-bmenu-mode-map "\177" 'gnus-bookmark-bmenu-backup-unmark) - (define-key gnus-bookmark-bmenu-mode-map "?" 'describe-mode) - (define-key gnus-bookmark-bmenu-mode-map "u" 'gnus-bookmark-bmenu-unmark) - (define-key gnus-bookmark-bmenu-mode-map "m" 'gnus-bookmark-bmenu-mark) - (define-key gnus-bookmark-bmenu-mode-map "l" 'gnus-bookmark-bmenu-load) - (define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save) - (define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos) - (define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details) - (define-key gnus-bookmark-bmenu-mode-map [mouse-2] - 'gnus-bookmark-bmenu-select-by-mouse)) + +(defvar-keymap gnus-bookmark-bmenu-mode-map + :full t + :suppress 'nodigits + "q" #'quit-window + "\C-m" #'gnus-bookmark-bmenu-select + "v" #'gnus-bookmark-bmenu-select + "d" #'gnus-bookmark-bmenu-delete + "k" #'gnus-bookmark-bmenu-delete + "\C-d" #'gnus-bookmark-bmenu-delete-backwards + "x" #'gnus-bookmark-bmenu-execute-deletions + " " #'next-line + "n" #'next-line + "p" #'previous-line + "\177" #'gnus-bookmark-bmenu-backup-unmark + "?" #'describe-mode + "u" #'gnus-bookmark-bmenu-unmark + "m" #'gnus-bookmark-bmenu-mark + "l" #'gnus-bookmark-bmenu-load + "s" #'gnus-bookmark-bmenu-save + "t" #'gnus-bookmark-bmenu-toggle-infos + "a" #'gnus-bookmark-bmenu-show-details + [mouse-2] #'gnus-bookmark-bmenu-select-by-mouse) ;; Bookmark Buffer Menu mode is suitable only for specially formatted ;; data. diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 34947cece89..e9c912109e2 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -839,7 +839,7 @@ See also the documentation for `gnus-article-highlight-citation'." (setq current (car loop) loop (cdr loop)) (setcdr current - (seq-difference (cdr current) numbers #'eq))))))))) + (gnus-set-difference (cdr current) numbers))))))))) (defun gnus-cite-parse-attributions () (let (al-alist) @@ -999,7 +999,7 @@ See also the documentation for `gnus-article-highlight-citation'." loop (cdr loop)) (if (eq current best) () - (setcdr current (seq-difference (cdr current) numbers #'eq)) + (setcdr current (gnus-set-difference (cdr current) numbers)) (when (null (cdr current)) (setq gnus-cite-loose-prefix-alist (delq current gnus-cite-loose-prefix-alist) diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index e2cbca9007d..7ecc97262a0 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -21,15 +21,11 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - ;;; Commentary: ;; Contents management by FCM version 0.1. -;; Description: -;; =========== - -;; gnus-diary is a utility toolkit used on top of the nndiary back end. It is +;; gnus-diary is a utility toolkit used on top of the nndiary back end. It is ;; now fully documented in the Gnus manual. ;;; Code: diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index af0b782202a..be46d3a341d 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -53,12 +53,10 @@ (autoload 'message-buffers "message") (autoload 'gnus-print-buffer "gnus-sum") -(defvar gnus-dired-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-m\C-a" 'gnus-dired-attach) - (define-key map "\C-c\C-m\C-l" 'gnus-dired-find-file-mailcap) - (define-key map "\C-c\C-m\C-p" 'gnus-dired-print) - map)) +(defvar-keymap gnus-dired-mode-map + "\C-c\C-m\C-a" #'gnus-dired-attach + "\C-c\C-m\C-l" #'gnus-dired-find-file-mailcap + "\C-c\C-m\C-p" #'gnus-dired-print) ;; FIXME: Make it customizable, change the default to `mail-user-agent' when ;; this file is renamed (e.g. to `dired-mime.el'). @@ -92,7 +90,7 @@ See `mail-user-agent' for more information." ;;;###autoload (defun turn-on-gnus-dired-mode () - "Convenience method to turn on gnus-dired-mode." + "Convenience method to turn on `gnus-dired-mode'." (interactive) (gnus-dired-mode 1)) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 9a0f21359f8..756e6d2d362 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -33,15 +33,12 @@ ;;; Draft minor mode -(defvar gnus-draft-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "Dt" gnus-draft-toggle-sending - "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' - "De" gnus-draft-edit-message - "Ds" gnus-draft-send-message - "DS" gnus-draft-send-all-messages) - map)) +(defvar-keymap gnus-draft-mode-map + "Dt" #'gnus-draft-toggle-sending + "e" #' gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' + "De" #'gnus-draft-edit-message + "Ds" #'gnus-draft-send-message + "DS" #'gnus-draft-send-all-messages) (defun gnus-draft-make-menu-bar () (unless (boundp 'gnus-draft-menu) diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index 3fd8bf51de4..b0aa58f0f28 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -48,13 +48,10 @@ (defvar gnus-edit-form-buffer "*Gnus edit form*") (defvar gnus-edit-form-done-function nil) -(defvar gnus-edit-form-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map emacs-lisp-mode-map) - (gnus-define-keys map - "\C-c\C-c" gnus-edit-form-done - "\C-c\C-k" gnus-edit-form-exit) - map)) +(defvar-keymap gnus-edit-form-mode-map + :parent emacs-lisp-mode-map + "\C-c\C-c" #'gnus-edit-form-done + "\C-c\C-k" #'gnus-edit-form-exit) (defun gnus-edit-form-make-menu-bar () (unless (boundp 'gnus-edit-form-menu) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 8bca4ffe38f..0754d7aa7b8 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -97,13 +97,14 @@ PNG format." ;;;###autoload (defun gnus--random-face-with-type (dir ext omit fun) - "Return file from DIR with extension EXT, omitting matches of OMIT, processed by FUN." + "Return file from DIR with extension EXT. +Omit matches of OMIT, and process them by FUN." (when (file-exists-p dir) (let* ((files (remove nil (mapcar (lambda (f) (unless (string-match (or omit "^$") f) f)) (directory-files dir t ext)))) - (file (nth (random (length files)) files))) + (file (and files (seq-random-elt files)))) (when file (funcall fun file))))) @@ -315,7 +316,7 @@ colors of the displayed X-Faces." (let* ((possibilities '("%02x0000" "00%02x00" "0000%02x" "%02x%02x00" "00%02x%02x" "%02x00%02x")) (format (concat "'#%02x%02x%02x' '#" - (nth (random 6) possibilities) + (seq-random-elt possibilities) "'")) (values nil)) (dotimes (i 255) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index c8b95d91856..ddc819877c1 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -118,7 +118,9 @@ If nil, only list groups that have unread articles." (defcustom gnus-group-default-list-level gnus-level-subscribed "Default listing level. -Ignored if `gnus-group-use-permanent-levels' is non-nil." +When `gnus-group-use-permanent-levels' is non-nil, this level is +used as the starting level until the user sets a different level, +and is ignored afterwards." :group 'gnus-group-listing :type '(choice (integer :tag "Level") (function :tag "Function returning level"))) @@ -571,209 +573,209 @@ simple manner." ;;; Gnus group mode ;;; -(gnus-define-keys gnus-group-mode-map - " " gnus-group-read-group - "=" gnus-group-select-group - "\r" gnus-group-select-group - "\M-\r" gnus-group-quick-select-group - "\M- " gnus-group-visible-select-group - [(meta control return)] gnus-group-select-group-ephemerally - "j" gnus-group-jump-to-group - "n" gnus-group-next-unread-group - "p" gnus-group-prev-unread-group - "\177" gnus-group-prev-unread-group - [delete] gnus-group-prev-unread-group - "N" gnus-group-next-group - "P" gnus-group-prev-group - "\M-n" gnus-group-next-unread-group-same-level - "\M-p" gnus-group-prev-unread-group-same-level - "," gnus-group-best-unread-group - "." gnus-group-first-unread-group - "u" gnus-group-unsubscribe-current-group - "U" gnus-group-unsubscribe-group - "c" gnus-group-catchup-current - "C" gnus-group-catchup-current-all - "\M-c" gnus-group-clear-data - "l" gnus-group-list-groups - "L" gnus-group-list-all-groups - "m" gnus-group-mail - "i" gnus-group-news - "g" gnus-group-get-new-news - "\M-g" gnus-group-get-new-news-this-group - "R" gnus-group-restart - "r" gnus-group-read-init-file - "B" gnus-group-browse-foreign-server - "b" gnus-group-check-bogus-groups - "F" gnus-group-find-new-groups - "\C-c\C-d" gnus-group-describe-group - "\M-d" gnus-group-describe-all-groups - "\C-c\C-a" gnus-group-apropos - "\C-c\M-\C-a" gnus-group-description-apropos - "a" gnus-group-post-news - "\ek" gnus-group-edit-local-kill - "\eK" gnus-group-edit-global-kill - "\C-k" gnus-group-kill-group - "\C-y" gnus-group-yank-group - "\C-w" gnus-group-kill-region - "\C-x\C-t" gnus-group-transpose-groups - "\C-c\C-l" gnus-group-list-killed - "\C-c\C-x" gnus-group-expire-articles - "\C-c\M-\C-x" gnus-group-expire-all-groups - "V" gnus-version - "s" gnus-group-save-newsrc - "z" gnus-group-suspend - "q" gnus-group-exit - "Q" gnus-group-quit - "?" gnus-group-describe-briefly - "\C-c\C-i" gnus-info-find-node - "\M-e" gnus-group-edit-group-method - "^" gnus-group-enter-server-mode - [mouse-2] gnus-mouse-pick-group - [follow-link] mouse-face - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-b" gnus-bug - "\C-c\C-s" gnus-group-sort-groups - "t" gnus-topic-mode - "\C-c\M-g" gnus-activate-all-groups - "\M-&" gnus-group-universal-argument - "#" gnus-group-mark-group - "\M-#" gnus-group-unmark-group) - -(gnus-define-keys (gnus-group-cloud-map "~" gnus-group-mode-map) - "u" gnus-cloud-upload-all-data - "~" gnus-cloud-upload-all-data - "d" gnus-cloud-download-all-data - "\r" gnus-cloud-download-all-data) - -(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) - "m" gnus-group-mark-group - "u" gnus-group-unmark-group - "w" gnus-group-mark-region - "b" gnus-group-mark-buffer - "r" gnus-group-mark-regexp - "U" gnus-group-unmark-all-groups) - -(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map) - "u" gnus-sieve-update - "g" gnus-sieve-generate) - -(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) - "d" gnus-group-make-directory-group - "h" gnus-group-make-help-group - "u" gnus-group-make-useful-group - "l" gnus-group-nnimap-edit-acl - "m" gnus-group-make-group - "E" gnus-group-edit-group - "e" gnus-group-edit-group-method - "p" gnus-group-edit-group-parameters - "v" gnus-group-add-to-virtual - "V" gnus-group-make-empty-virtual - "D" gnus-group-enter-directory - "f" gnus-group-make-doc-group - "w" gnus-group-make-web-group - "G" gnus-group-read-ephemeral-search-group - "g" gnus-group-make-search-group - "M" gnus-group-read-ephemeral-group - "r" gnus-group-rename-group - "R" gnus-group-make-rss-group - "c" gnus-group-customize - "z" gnus-group-compact-group - "x" gnus-group-expunge-group - "\177" gnus-group-delete-group - [delete] gnus-group-delete-group) - -(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) - "s" gnus-group-sort-groups - "a" gnus-group-sort-groups-by-alphabet - "u" gnus-group-sort-groups-by-unread - "l" gnus-group-sort-groups-by-level - "v" gnus-group-sort-groups-by-score - "r" gnus-group-sort-groups-by-rank - "m" gnus-group-sort-groups-by-method - "n" gnus-group-sort-groups-by-real-name) - -(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) - "s" gnus-group-sort-selected-groups - "a" gnus-group-sort-selected-groups-by-alphabet - "u" gnus-group-sort-selected-groups-by-unread - "l" gnus-group-sort-selected-groups-by-level - "v" gnus-group-sort-selected-groups-by-score - "r" gnus-group-sort-selected-groups-by-rank - "m" gnus-group-sort-selected-groups-by-method - "n" gnus-group-sort-selected-groups-by-real-name) - -(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) - "k" gnus-group-list-killed - "z" gnus-group-list-zombies - "s" gnus-group-list-groups - "u" gnus-group-list-all-groups - "A" gnus-group-list-active - "a" gnus-group-apropos - "d" gnus-group-description-apropos - "m" gnus-group-list-matching - "M" gnus-group-list-all-matching - "l" gnus-group-list-level - "c" gnus-group-list-cached - "?" gnus-group-list-dormant - "!" gnus-group-list-ticked) - -(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) - "k" gnus-group-list-limit - "z" gnus-group-list-limit - "s" gnus-group-list-limit - "u" gnus-group-list-limit - "A" gnus-group-list-limit - "m" gnus-group-list-limit - "M" gnus-group-list-limit - "l" gnus-group-list-limit - "c" gnus-group-list-limit - "?" gnus-group-list-limit - "!" gnus-group-list-limit) - -(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map) - "k" gnus-group-list-flush - "z" gnus-group-list-flush - "s" gnus-group-list-flush - "u" gnus-group-list-flush - "A" gnus-group-list-flush - "m" gnus-group-list-flush - "M" gnus-group-list-flush - "l" gnus-group-list-flush - "c" gnus-group-list-flush - "?" gnus-group-list-flush - "!" gnus-group-list-flush) - -(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map) - "k" gnus-group-list-plus - "z" gnus-group-list-plus - "s" gnus-group-list-plus - "u" gnus-group-list-plus - "A" gnus-group-list-plus - "m" gnus-group-list-plus - "M" gnus-group-list-plus - "l" gnus-group-list-plus - "c" gnus-group-list-plus - "?" gnus-group-list-plus - "!" gnus-group-list-plus) - -(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) - "f" gnus-score-flush-cache - "e" gnus-score-edit-all-score) - -(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "d" gnus-group-describe-group - "v" gnus-version) - -(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) - "l" gnus-group-set-current-level - "t" gnus-group-unsubscribe-current-group - "s" gnus-group-unsubscribe-group - "k" gnus-group-kill-group - "y" gnus-group-yank-group - "w" gnus-group-kill-region - "\C-k" gnus-group-kill-level - "z" gnus-group-kill-all-zombies) +(define-keymap :keymap gnus-group-mode-map + " " #'gnus-group-read-group + "=" #'gnus-group-select-group + "\r" #'gnus-group-select-group + "\M-\r" #'gnus-group-quick-select-group + "\M- " #'gnus-group-visible-select-group + [(meta control return)] #'gnus-group-select-group-ephemerally + "j" #'gnus-group-jump-to-group + "n" #'gnus-group-next-unread-group + "p" #'gnus-group-prev-unread-group + "\177" #'gnus-group-prev-unread-group + [delete] #'gnus-group-prev-unread-group + "N" #'gnus-group-next-group + "P" #'gnus-group-prev-group + "\M-n" #'gnus-group-next-unread-group-same-level + "\M-p" #'gnus-group-prev-unread-group-same-level + "," #'gnus-group-best-unread-group + "." #'gnus-group-first-unread-group + "u" #'gnus-group-toggle-subscription-at-point + "U" #'gnus-group-toggle-subscription + "c" #'gnus-group-catchup-current + "C" #'gnus-group-catchup-current-all + "\M-c" #'gnus-group-clear-data + "l" #'gnus-group-list-groups + "L" #'gnus-group-list-all-groups + "m" #'gnus-group-mail + "i" #'gnus-group-news + "g" #'gnus-group-get-new-news + "\M-g" #'gnus-group-get-new-news-this-group + "R" #'gnus-group-restart + "r" #'gnus-group-read-init-file + "B" #'gnus-group-browse-foreign-server + "b" #'gnus-group-check-bogus-groups + "F" #'gnus-group-find-new-groups + "\C-c\C-d" #'gnus-group-describe-group + "\M-d" #'gnus-group-describe-all-groups + "\C-c\C-a" #'gnus-group-apropos + "\C-c\M-\C-a" #'gnus-group-description-apropos + "a" #'gnus-group-post-news + "\ek" #'gnus-group-edit-local-kill + "\eK" #'gnus-group-edit-global-kill + "\C-k" #'gnus-group-kill-group + "\C-y" #'gnus-group-yank-group + "\C-w" #'gnus-group-kill-region + "\C-x\C-t" #'gnus-group-transpose-groups + "\C-c\C-l" #'gnus-group-list-killed + "\C-c\C-x" #'gnus-group-expire-articles + "\C-c\M-\C-x" #'gnus-group-expire-all-groups + "V" #'gnus-version + "s" #'gnus-group-save-newsrc + "z" #'gnus-group-suspend + "q" #'gnus-group-exit + "Q" #'gnus-group-quit + "?" #'gnus-group-describe-briefly + "\C-c\C-i" #'gnus-info-find-node + "\M-e" #'gnus-group-edit-group-method + "^" #'gnus-group-enter-server-mode + [mouse-2] #'gnus-mouse-pick-group + [follow-link] 'mouse-face + "<" #'beginning-of-buffer + ">" #'end-of-buffer + "\C-c\C-b" #'gnus-bug + "\C-c\C-s" #'gnus-group-sort-groups + "t" #'gnus-topic-mode + "\C-c\M-g" #'gnus-activate-all-groups + "\M-&" #'gnus-group-universal-argument + "#" #'gnus-group-mark-group + "\M-#" #'gnus-group-unmark-group + + "~" (define-keymap :prefix 'gnus-group-cloud-map + "u" #'gnus-cloud-upload-all-data + "~" #'gnus-cloud-upload-all-data + "d" #'gnus-cloud-download-all-data + "\r" #'gnus-cloud-download-all-data) + + "M" (define-keymap :prefix 'gnus-group-mark-map + "m" #'gnus-group-mark-group + "u" #'gnus-group-unmark-group + "w" #'gnus-group-mark-region + "b" #'gnus-group-mark-buffer + "r" #'gnus-group-mark-regexp + "U" #'gnus-group-unmark-all-groups) + + "D" (define-keymap :prefix 'gnus-group-sieve-map + "u" #'gnus-sieve-update + "g" #'gnus-sieve-generate) + + "G" (define-keymap :prefix 'gnus-group-group-map + "d" #'gnus-group-make-directory-group + "h" #'gnus-group-make-help-group + "u" #'gnus-group-make-useful-group + "l" #'gnus-group-nnimap-edit-acl + "m" #'gnus-group-make-group + "E" #'gnus-group-edit-group + "e" #'gnus-group-edit-group-method + "p" #'gnus-group-edit-group-parameters + "v" #'gnus-group-add-to-virtual + "V" #'gnus-group-make-empty-virtual + "D" #'gnus-group-enter-directory + "f" #'gnus-group-make-doc-group + "w" #'gnus-group-make-web-group + "G" #'gnus-group-read-ephemeral-search-group + "g" #'gnus-group-make-search-group + "M" #'gnus-group-read-ephemeral-group + "r" #'gnus-group-rename-group + "R" #'gnus-group-make-rss-group + "c" #'gnus-group-customize + "z" #'gnus-group-compact-group + "x" #'gnus-group-expunge-group + "\177" #'gnus-group-delete-group + [delete] #'gnus-group-delete-group + + "S" (define-keymap :prefix 'gnus-group-sort-map + "s" #'gnus-group-sort-groups + "a" #'gnus-group-sort-groups-by-alphabet + "u" #'gnus-group-sort-groups-by-unread + "l" #'gnus-group-sort-groups-by-level + "v" #'gnus-group-sort-groups-by-score + "r" #'gnus-group-sort-groups-by-rank + "m" #'gnus-group-sort-groups-by-method + "n" #'gnus-group-sort-groups-by-real-name) + + "P" (define-keymap :prefix 'gnus-group-sort-selected-map + "s" #'gnus-group-sort-selected-groups + "a" #'gnus-group-sort-selected-groups-by-alphabet + "u" #'gnus-group-sort-selected-groups-by-unread + "l" #'gnus-group-sort-selected-groups-by-level + "v" #'gnus-group-sort-selected-groups-by-score + "r" #'gnus-group-sort-selected-groups-by-rank + "m" #'gnus-group-sort-selected-groups-by-method + "n" #'gnus-group-sort-selected-groups-by-real-name)) + + "A" (define-keymap :prefix 'gnus-group-list-map + "k" #'gnus-group-list-killed + "z" #'gnus-group-list-zombies + "s" #'gnus-group-list-groups + "u" #'gnus-group-list-all-groups + "A" #'gnus-group-list-active + "a" #'gnus-group-apropos + "d" #'gnus-group-description-apropos + "m" #'gnus-group-list-matching + "M" #'gnus-group-list-all-matching + "l" #'gnus-group-list-level + "c" #'gnus-group-list-cached + "?" #'gnus-group-list-dormant + "!" #'gnus-group-list-ticked + + "/" (define-keymap :prefix 'gnus-group-list-limit-map + "k" #'gnus-group-list-limit + "z" #'gnus-group-list-limit + "s" #'gnus-group-list-limit + "u" #'gnus-group-list-limit + "A" #'gnus-group-list-limit + "m" #'gnus-group-list-limit + "M" #'gnus-group-list-limit + "l" #'gnus-group-list-limit + "c" #'gnus-group-list-limit + "?" #'gnus-group-list-limit + "!" #'gnus-group-list-limit) + + "f" (define-keymap :prefix 'gnus-group-list-flush-map + "k" #'gnus-group-list-flush + "z" #'gnus-group-list-flush + "s" #'gnus-group-list-flush + "u" #'gnus-group-list-flush + "A" #'gnus-group-list-flush + "m" #'gnus-group-list-flush + "M" #'gnus-group-list-flush + "l" #'gnus-group-list-flush + "c" #'gnus-group-list-flush + "?" #'gnus-group-list-flush + "!" #'gnus-group-list-flush) + + "p" (define-keymap :prefix 'gnus-group-list-plus-map + "k" #'gnus-group-list-plus + "z" #'gnus-group-list-plus + "s" #'gnus-group-list-plus + "u" #'gnus-group-list-plus + "A" #'gnus-group-list-plus + "m" #'gnus-group-list-plus + "M" #'gnus-group-list-plus + "l" #'gnus-group-list-plus + "c" #'gnus-group-list-plus + "?" #'gnus-group-list-plus + "!" #'gnus-group-list-plus)) + + "W" (define-keymap :prefix 'gnus-group-score-map + "f" #'gnus-score-flush-cache + "e" #'gnus-score-edit-all-score) + + "H" (define-keymap :prefix 'gnus-group-help-map + "d" #'gnus-group-describe-group + "v" #'gnus-version) + + "S" (define-keymap :prefix 'gnus-group-sub-map + "l" #'gnus-group-set-current-level + "t" #'gnus-group-toggle-subscription-at-point + "s" #'gnus-group-toggle-subscription + "k" #'gnus-group-kill-group + "y" #'gnus-group-yank-group + "w" #'gnus-group-kill-region + "\C-k" #'gnus-group-kill-level + "z" #'gnus-group-kill-all-zombies)) (defun gnus-topic-mode-p () "Return non-nil in `gnus-topic-mode'." @@ -814,7 +816,7 @@ simple manner." ["Check for new articles " gnus-topic-get-new-news-this-topic :included (gnus-topic-mode-p) :help "Check for new messages in current group or topic"] - ["Toggle subscription" gnus-group-unsubscribe-current-group + ["Toggle subscription" gnus-group-toggle-subscription-at-point (gnus-group-group-name)] ["Kill" gnus-group-kill-group :active (gnus-group-group-name) :help "Kill (remove) current group"] @@ -907,7 +909,7 @@ simple manner." ["Execute command" gnus-group-universal-argument (or gnus-group-marked (gnus-group-group-name))]) ("Subscribe" - ["Subscribe to a group..." gnus-group-unsubscribe-group t] + ["Toggle subscription..." gnus-group-toggle-subscription t] ["Kill all newsgroups in region" gnus-group-kill-region :active mark-active] ["Kill all zombie groups" gnus-group-kill-all-zombies @@ -1042,7 +1044,7 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and ;; (gnus-group-find-new-groups "???" nil) (gnus-group-save-newsrc "save") (gnus-group-describe-group "describe") - (gnus-group-unsubscribe-current-group "gnus/toggle-subscription") + (gnus-group-toggle-subscription-at-point "gnus/toggle-subscription") (gnus-group-prev-unread-group "left-arrow") (gnus-group-next-unread-group "right-arrow") (gnus-group-exit "exit") @@ -1119,7 +1121,7 @@ The group buffer lists (some of) the groups available. For instance, lists all zombie groups. Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe -to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. +to a group not displayed, type `\\[gnus-group-toggle-subscription]'. For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). @@ -1176,11 +1178,11 @@ The following commands are available: (defun gnus-group-default-level (&optional level number-or-nil) (cond (gnus-group-use-permanent-levels - (or (setq gnus-group-use-permanent-levels - (or level (if (numberp gnus-group-use-permanent-levels) - gnus-group-use-permanent-levels - (or (gnus-group-default-list-level) - gnus-level-subscribed)))) + (or level + (if (numberp gnus-group-use-permanent-levels) + gnus-group-use-permanent-levels + (or (gnus-group-default-list-level) + gnus-level-subscribed)) (gnus-group-default-list-level) gnus-level-subscribed)) (number-or-nil level) @@ -1228,20 +1230,23 @@ The following commands are available: (let ((charset (gnus-group-name-charset nil string))) (gnus-group-name-decode string charset))) -(defun gnus-group-list-groups (&optional level unread lowest) +(defun gnus-group-list-groups (&optional level unread lowest update-level) "List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. If argument UNREAD is non-nil, groups with no unread articles are also listed. -Also see the `gnus-group-use-permanent-levels' variable." +Also see the `gnus-group-use-permanent-levels' variable. If this +variable is non-nil, and UPDATE-LEVEL is non-nil (which is the +case interactively), the level will be updated by this command." (interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) (or (gnus-group-default-level nil t) (gnus-group-default-list-level) - gnus-level-subscribed))) + gnus-level-subscribed)) + nil nil t) gnus-group-mode) (unless level (setq level (car gnus-group-list-mode) @@ -1288,7 +1293,9 @@ Also see the `gnus-group-use-permanent-levels' variable." (goto-char (point-max)) (forward-line -1))))))) ;; Adjust cursor point. - (gnus-group-position-point))) + (gnus-group-position-point) + (when (and update-level gnus-group-use-permanent-levels) + (setq gnus-group-use-permanent-levels level)))) (defun gnus-group-list-level (level &optional all) "List groups on LEVEL. @@ -2186,7 +2193,7 @@ handle COLLECTION as a list, hash table, or vector." require-match initial-input (or hist 'gnus-group-history) def))) - (replace-regexp-in-string "\n" "" group))) + (string-replace "\n" "" group))) ;;;###autoload (defun gnus-fetch-group (group &optional articles) @@ -3857,61 +3864,90 @@ Uses the process/prefix convention." (defun gnus-group-unsubscribe (&optional n) "Unsubscribe the current group." (interactive "P" gnus-group-mode) - (gnus-group-unsubscribe-current-group n 'unsubscribe)) + (gnus-group-set-subscription-at-point n 'unsubscribe)) (defun gnus-group-subscribe (&optional n) "Subscribe the current group." (interactive "P" gnus-group-mode) - (gnus-group-unsubscribe-current-group n 'subscribe)) + (gnus-group-set-subscription-at-point n 'subscribe)) + +(defsubst gnus-group-unsubscribe-current-group (&optional n do-sub) + (if do-sub + (gnus-group-set-subscription-at-point n do-sub) + (gnus-group-toggle-subscription-at-point n))) + +(defsubst gnus-group-unsubscribe-group (group &optional level silent) + (if level + (gnus-group-set-subscription group level silent) + (gnus-group-toggle-subscription group silent))) + +(make-obsolete 'gnus-group-unsubscribe-current-group + 'gnus-group-toggle-subscription-at-point "28.1") + +(make-obsolete 'gnus-group-unsubscribe-group + 'gnus-group-toggle-subscription "28.1") -(defun gnus-group-unsubscribe-current-group (&optional n do-sub) +(defun gnus-group-toggle-subscription-at-point (&optional n) "Toggle subscription of the current group. If given numerical prefix, toggle the N next groups." (interactive "P" gnus-group-mode) + (gnus-group-set-subscription-at-point n 'toggle)) + +(defun gnus-group-set-subscription-at-point (n do-sub) + "Set subscription of the current group for next N groups." (dolist (group (gnus-group-process-prefix n)) (gnus-group-remove-mark group) - (gnus-group-unsubscribe-group + (gnus-group-set-subscription group - (cond - ((eq do-sub 'unsubscribe) - gnus-level-default-unsubscribed) - ((eq do-sub 'subscribe) - gnus-level-default-subscribed) - ((<= (gnus-group-group-level) gnus-level-subscribed) - gnus-level-default-unsubscribed) - (t - gnus-level-default-subscribed)) + (cl-case do-sub + (unsubscribe gnus-level-default-unsubscribed) + (subscribe gnus-level-default-subscribed) + (toggle (if (<= (gnus-group-group-level) gnus-level-subscribed) + gnus-level-default-unsubscribed + gnus-level-default-subscribed)) + (t (error "Unknown subscription setting %s" do-sub))) t) (gnus-group-update-group-line)) (gnus-group-next-group 1)) -(defun gnus-group-unsubscribe-group (group &optional level silent) - "Toggle subscription to GROUP. -Killed newsgroups are subscribed. If SILENT, don't try to update the -group line." +(defun gnus-group-toggle-subscription (group &optional silent) (interactive (list (gnus-group-completing-read nil nil (gnus-read-active-file-p))) gnus-group-mode) + (let* ((newsrc (gnus-group-entry group)) + (level (cond + (newsrc + ;; Toggle subscription flag. + (if (<= (gnus-info-level (nth 1 newsrc)) + gnus-level-subscribed) + (1+ gnus-level-subscribed) + gnus-level-default-subscribed)) + ((and (stringp group) + (or (not (gnus-read-active-file-p)) + (gnus-active group))) + ;; Add new newsgroup. + gnus-level-default-subscribed) + (t 'unsubscribe)))) + (gnus-group-set-subscription group level silent))) + +(defun gnus-group-set-subscription (group level &optional silent) + "Set subscription of GROUP to LEVEL. +Killed newsgroups are subscribed. If SILENT, don't try to update the +group line." (let ((newsrc (gnus-group-entry group))) (cond ((string-match "\\`[ \t]*\\'" group) (error "Empty group name")) (newsrc - ;; Toggle subscription flag. - (gnus-group-change-level - newsrc (or level (if (<= (gnus-info-level (nth 1 newsrc)) - gnus-level-subscribed) - (1+ gnus-level-subscribed) - gnus-level-default-subscribed))) + (gnus-group-change-level newsrc level) (unless silent (gnus-group-update-group group))) ((and (stringp group) (or (not (gnus-read-active-file-p)) (gnus-active group))) - ;; Add new newsgroup. (gnus-group-change-level group - (or level gnus-level-default-subscribed) + level (or (and (member group gnus-zombie-list) gnus-level-zombie) gnus-level-killed) @@ -4026,7 +4062,8 @@ of groups killed." (if (< (length out) 2) (car out) (nreverse out)))) (defun gnus-group-yank-group (&optional arg) - "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup. + "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it +before the current newsgroup. The numeric ARG specifies how many newsgroups are to be yanked. The name of the newsgroup yanked is returned, or (if several groups are yanked) a list of yanked groups is returned." @@ -4176,8 +4213,9 @@ otherwise all levels below ARG will be scanned too." (gnus-check-reasonable-setup) (gnus-run-hooks 'gnus-after-getting-new-news-hook) - (gnus-group-list-groups (and (numberp arg) - (max (car gnus-group-list-mode) arg))))) + (gnus-group-list-groups (and (numberp arg) arg)) + (when gnus-group-use-permanent-levels + (setq gnus-group-use-permanent-levels (gnus-group-default-level arg))))) (defun gnus-group-get-new-news-this-group (&optional n dont-scan) "Check for newly arrived news in the current group (and the N-1 next groups). @@ -4361,8 +4399,7 @@ If FORCE, force saving whether it is necessary or not." (defun gnus-group-restart (&optional _arg) "Force Gnus to read the .newsrc file." (interactive nil gnus-group-mode) - (when (gnus-yes-or-no-p - (format "Are you sure you want to restart Gnus? ")) + (when (gnus-yes-or-no-p "Are you sure you want to restart Gnus? ") (gnus-save-newsrc-file) (gnus-clear-system) (gnus))) @@ -4384,9 +4421,9 @@ group." (defun gnus-group-find-new-groups (&optional arg) "Search for new groups and add them. Each new group will be treated with `gnus-subscribe-newsgroup-method'. -With 1 C-u, use the `ask-server' method to query the server for new +With 1 \\[universal-argument], use the `ask-server' method to query the server for new groups. -With 2 C-u's, use most complete method possible to query the server +With 2 \\[universal-argument]'s, use most complete method possible to query the server for new groups, and subscribe the new groups as zombies." (interactive "p" gnus-group-mode) (let ((new-groups (gnus-find-new-newsgroups (or arg 1))) @@ -4437,7 +4474,7 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending." (gnus-kill-buffer buf))) (setq gnus-backlog-articles nil) (gnus-kill-gnus-frames) - ;; Closing all the backends is useful (for instance) when when the + ;; Closing all the backends is useful (for instance) when the ;; IP addresses have changed and you need to reconnect. (dolist (elem gnus-opened-servers) (gnus-close-server (car elem))) @@ -4680,7 +4717,8 @@ or `gnus-group-catchup-group-hook'." (gnus-group-get-parameter group 'timestamp t)) (defun gnus-group-timestamp-delta (group) - "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." + "Return the offset in seconds from the timestamp for GROUP to the current time. +Return value is a floating point number." ;; FIXME: This should return a Lisp integer, not a Lisp float, ;; since it is always an integer. (let* ((time (or (gnus-group-timestamp group) 0)) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index be62bfd81f5..c1815d3486c 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -71,21 +71,17 @@ fit these criteria." :group 'gnus-art :type 'float) -(defvar gnus-html-image-map - (let ((map (make-sparse-keymap))) - (define-key map "u" 'gnus-article-copy-string) - (define-key map "i" 'gnus-html-insert-image) - (define-key map "v" 'gnus-html-browse-url) - map)) - -(defvar gnus-html-displayed-image-map - (let ((map (make-sparse-keymap))) - (define-key map "a" 'gnus-html-show-alt-text) - (define-key map "i" 'gnus-html-browse-image) - (define-key map "\r" 'gnus-html-browse-url) - (define-key map "u" 'gnus-article-copy-string) - (define-key map [tab] 'button-forward) - map)) +(defvar-keymap gnus-html-image-map + "u" #'gnus-article-copy-string + "i" #'gnus-html-insert-image + "v" #'gnus-html-browse-url) + +(defvar-keymap gnus-html-displayed-image-map + "a" #'gnus-html-show-alt-text + "i" #'gnus-html-browse-image + "\r" #'gnus-html-browse-url + "u" #'gnus-article-copy-string + [tab] #'forward-button) (defun gnus-html-encode-url (url) "Encode URL." diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 1b2743c1484..81e46d7a51e 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -107,19 +107,19 @@ :accessor gnus-icalendar-event:opt-participants :initform nil :type (or null t))) - "generic iCalendar Event class") + "Generic iCalendar Event class.") (defclass gnus-icalendar-event-request (gnus-icalendar-event) nil - "iCalendar class for REQUEST events") + "iCalendar class for REQUEST events.") (defclass gnus-icalendar-event-cancel (gnus-icalendar-event) nil - "iCalendar class for CANCEL events") + "iCalendar class for CANCEL events.") (defclass gnus-icalendar-event-reply (gnus-icalendar-event) nil - "iCalendar class for REPLY events") + "iCalendar class for REPLY events.") (cl-defmethod gnus-icalendar-event:recurring-p ((event gnus-icalendar-event)) "Return t if EVENT is recurring." @@ -194,7 +194,11 @@ (caddr event)))) (cl-labels - ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) + ((attendee-role (prop) + ;; RFC5546: default ROLE is REQ-PARTICIPANT + (and prop + (or (plist-get (cadr prop) 'ROLE) + "REQ-PARTICIPANT"))) (attendee-name (prop) (or (plist-get (cadr prop) 'CN) @@ -222,28 +226,35 @@ (uid . UID))) (method (caddr (assoc 'METHOD (caddr (car (nreverse ical)))))) (attendee (when attendee-name-or-email - (gnus-icalendar-event--find-attendee ical attendee-name-or-email))) + (gnus-icalendar-event--find-attendee + ical attendee-name-or-email))) (attendee-names (gnus-icalendar-event--get-attendee-names ical)) - (role (plist-get (cadr attendee) 'ROLE)) + ;; RFC5546: default ROLE is REQ-PARTICIPANT + (role (and attendee + (or (plist-get (cadr attendee) 'ROLE) + "REQ-PARTICIPANT"))) (participation-type (pcase role - ("REQ-PARTICIPANT" 'required) - ("OPT-PARTICIPANT" 'optional) - (_ 'non-participant))) + ("REQ-PARTICIPANT" 'required) + ("OPT-PARTICIPANT" 'optional) + (_ 'non-participant))) (zone-map (icalendar--convert-all-timezones ical)) - (args (list :method method - :organizer organizer - :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map) - :end-time (gnus-icalendar-event--decode-datefield event 'DTEND zone-map) - :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE") - :participation-type participation-type - :req-participants (car attendee-names) - :opt-participants (cadr attendee-names))) - (event-class (cond - ((string= method "REQUEST") 'gnus-icalendar-event-request) - ((string= method "CANCEL") 'gnus-icalendar-event-cancel) - ((string= method "REPLY") 'gnus-icalendar-event-reply) - (t 'gnus-icalendar-event)))) - + (args + (list :method method + :organizer organizer + :start-time (gnus-icalendar-event--decode-datefield + event 'DTSTART zone-map) + :end-time (gnus-icalendar-event--decode-datefield + event 'DTEND zone-map) + :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE") + :participation-type participation-type + :req-participants (car attendee-names) + :opt-participants (cadr attendee-names))) + (event-class + (cond + ((string= method "REQUEST") 'gnus-icalendar-event-request) + ((string= method "CANCEL") 'gnus-icalendar-event-cancel) + ((string= method "REPLY") 'gnus-icalendar-event-reply) + (t 'gnus-icalendar-event)))) (cl-labels ((map-property (prop) @@ -252,10 +263,10 @@ ;; ugly, but cannot get ;;replace-regexp-in-string work with "\\" as ;;REP, plus we should also handle "\\;" - (replace-regexp-in-string - "\\\\," "," - (replace-regexp-in-string - "\\\\n" "\n" (substring-no-properties value)))))) + (string-replace + "\\," "," + (string-replace + "\\n" "\n" (substring-no-properties value)))))) (accumulate-args (mapping) (cl-destructuring-bind (slot . ical-property) mapping @@ -271,7 +282,11 @@ for keyword = (intern (format ":%s" (eieio-slot-descriptor-name slot))) when (plist-member args keyword) - append (list keyword (plist-get args keyword))))))) + append (list keyword + (if (eq keyword :uid) + ;; The UID has to be a string. + (or (plist-get args keyword) "") + (plist-get args keyword)))))))) (defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) "Parse RFC5545 iCalendar in buffer BUF and return an event object. @@ -337,10 +352,16 @@ status will be retrieved from the first matching attendee record." (mapc #'process-event-line (split-string ical-request "\n")) + ;; RFC5546 refers to uninvited attendees as "party crashers". + ;; This situation is common if the invitation is sent to a group + ;; of people via a mailing list. (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) reply-event-lines) (lwarn 'gnus-icalendar :warning - "Could not find an event attendee matching given identity")) + "Could not find an event attendee matching given identity") + (push (format "ATTENDEE;RSVP=TRUE;PARTSTAT=%s;CN=%s:MAILTO:%s" + attendee-status user-full-name user-mail-address) + reply-event-lines)) (mapconcat #'identity `("BEGIN:VEVENT" ,@(nreverse reply-event-lines) @@ -839,10 +860,14 @@ These will be used to retrieve the RSVP information from ical events." button t gnus-data ,data)))) -(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject) +(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject organizer) (let ((message-signature nil)) (with-current-buffer gnus-summary-buffer (gnus-summary-reply) + ;; Reply to the organizer, not to whoever sent the invitation. person + ;; Some calendar systems use specific email address as organizer to + ;; receive these responses. + (message-replace-header "To" organizer) (message-goto-body) (mml-insert-multipart "alternative") (mml-insert-empty-tag 'part 'type "text/plain") @@ -858,7 +883,8 @@ These will be used to retrieve the RSVP information from ical events." (event (caddr data)) (reply (gnus-icalendar-with-decoded-handle handle (gnus-icalendar-event-reply-from-buffer - (current-buffer) status (gnus-icalendar-identities))))) + (current-buffer) status (gnus-icalendar-identities)))) + (organizer (gnus-icalendar-event:organizer event))) (when reply (cl-labels @@ -875,7 +901,7 @@ These will be used to retrieve the RSVP information from ical events." (delete-region (point-min) (point-max)) (insert reply) (fold-icalendar-buffer) - (gnus-icalendar-send-buffer-by-mail (buffer-name) subject)) + (gnus-icalendar-send-buffer-by-mail (buffer-name) subject organizer)) ;; Back in article buffer (setq-local gnus-icalendar-reply-status status) @@ -889,10 +915,16 @@ These will be used to retrieve the RSVP information from ical events." (gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status)) (cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) - (when (gnus-icalendar-event:rsvp event) - `(("Accept" gnus-icalendar-reply (,handle accepted ,event)) - ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) - ("Decline" gnus-icalendar-reply (,handle declined ,event))))) + (let ((accept-btn "Accept") + (tentative-btn "Tentative") + (decline-btn "Decline")) + (unless (gnus-icalendar-event:rsvp event) + (setq accept-btn "Uninvited Accept" + tentative-btn "Uninvited Tentative" + decline-btn "Uninvited Decline")) + `((,accept-btn gnus-icalendar-reply (,handle accepted ,event)) + (,tentative-btn gnus-icalendar-reply (,handle tentative ,event)) + (,decline-btn gnus-icalendar-reply (,handle declined ,event))))) (cl-defmethod gnus-icalendar-event:inline-reply-buttons ((_event gnus-icalendar-event-reply) _handle) "No buttons for REPLY events." @@ -1030,13 +1062,14 @@ These will be used to retrieve the RSVP information from ical events." (add-to-list 'mm-automatic-display "text/calendar") (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity)) - (gnus-define-keys (gnus-summary-calendar-map "i" gnus-summary-mode-map) - "a" gnus-icalendar-reply-accept - "t" gnus-icalendar-reply-tentative - "d" gnus-icalendar-reply-decline - "c" gnus-icalendar-event-check-agenda - "e" gnus-icalendar-event-export - "s" gnus-icalendar-event-show) + (define-key gnus-summary-mode-map "i" + (define-keymap :prefix 'gnus-summary-calendar-map + "a" #'gnus-icalendar-reply-accept + "t" #'gnus-icalendar-reply-tentative + "d" #'gnus-icalendar-reply-decline + "c" #'gnus-icalendar-event-check-agenda + "e" #'gnus-icalendar-event-export + "s" #'gnus-icalendar-event-show)) (require 'gnus-art) (add-to-list 'gnus-mime-action-alist diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 01053797b3a..255c11f137c 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -613,8 +613,7 @@ If BUFFER, insert the article in that group." Returns the article number of the message. If GROUP is not already selected, the message will be the only one in -the group's summary. -" +the group's summary." ;; TODO: is there a way to know at this point whether the group will ;; be newly-selected? If so we could clean up the logic at the end ;; diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index f73627a6480..7e589c54e97 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -66,18 +66,15 @@ of time." ;;; Gnus Kill File Mode ;;; -(defvar gnus-kill-file-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map emacs-lisp-mode-map) - (gnus-define-keymap map - "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject - "\C-c\C-k\C-a" gnus-kill-file-kill-by-author - "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread - "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref - "\C-c\C-a" gnus-kill-file-apply-buffer - "\C-c\C-e" gnus-kill-file-apply-last-sexp - "\C-c\C-c" gnus-kill-file-exit) - map)) +(defvar-keymap gnus-kill-file-mode-map + :parent emacs-lisp-mode-map + "\C-c\C-k\C-s" #'gnus-kill-file-kill-by-subject + "\C-c\C-k\C-a" #'gnus-kill-file-kill-by-author + "\C-c\C-k\C-t" #'gnus-kill-file-kill-by-thread + "\C-c\C-k\C-x" #'gnus-kill-file-kill-by-xref + "\C-c\C-a" #'gnus-kill-file-apply-buffer + "\C-c\C-e" #'gnus-kill-file-apply-last-sexp + "\C-c\C-c" #'gnus-kill-file-exit) (define-derived-mode gnus-kill-file-mode emacs-lisp-mode "Kill" "Major mode for editing kill files. @@ -435,7 +432,7 @@ Returns the number of articles marked as read." ;; The "f:+" command marks everything *but* the matches as read, ;; so we simply first match everything as read, and then unmark ;; PATTERN later. - (when (string-match "\\+" commands) + (when (string-search "+" commands) (gnus-kill "from" ".") (setq commands "m")) diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index 3b2b5a07c1d..bf33194cf75 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -31,16 +31,13 @@ ;;; Mailing list minor mode -(defvar gnus-mailing-list-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "\C-c\C-nh" gnus-mailing-list-help - "\C-c\C-ns" gnus-mailing-list-subscribe - "\C-c\C-nu" gnus-mailing-list-unsubscribe - "\C-c\C-np" gnus-mailing-list-post - "\C-c\C-no" gnus-mailing-list-owner - "\C-c\C-na" gnus-mailing-list-archive) - map)) +(defvar-keymap gnus-mailing-list-mode-map + "\C-c\C-nh" #'gnus-mailing-list-help + "\C-c\C-ns" #'gnus-mailing-list-subscribe + "\C-c\C-nu" #'gnus-mailing-list-unsubscribe + "\C-c\C-np" #'gnus-mailing-list-post + "\C-c\C-no" #'gnus-mailing-list-owner + "\C-c\C-na" #'gnus-mailing-list-archive) (defvar gnus-mailing-list-menu) @@ -127,7 +124,7 @@ If FORCE is non-nil, replace the old ones." (t (gnus-message 1 "no list-unsubscribe in this group"))))) (defun gnus-mailing-list-post () - "Post message (really useful ?)" + "Post message (really useful ?)." (interactive) (let ((list-post (with-current-buffer gnus-original-article-buffer diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index d42f0971259..878e879cd70 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -75,7 +75,7 @@ match any of the group-specified splitting rules. See ;;;###autoload (defun gnus-group-split-update (&optional catch-all) - "Computes nnmail-split-fancy from group params and CATCH-ALL. + "Computes `nnmail-split-fancy' from group params and CATCH-ALL. It does this by calling (gnus-group-split-fancy nil nil CATCH-ALL). If CATCH-ALL is nil, `gnus-group-split-default-catch-all-group' is used @@ -169,7 +169,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: (when (not (null params)) (let ((split-spec (assoc 'split-spec params)) group-clean) ;; Remove backend from group name - (setq group-clean (string-match ":" group)) + (setq group-clean (string-search ":" group)) (setq group-clean (if group-clean (substring group (1+ group-clean)) @@ -209,7 +209,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: "\\)")) ;; Now create the new SPLIT (let ((split-regexp-with-list-ids - (replace-regexp-in-string "@" "[@.]" split-regexp t t)) + (string-replace "@" "[@.]" split-regexp)) (exclude ;; Generate RESTRICTs for SPLIT-EXCLUDEs. (if (listp split-exclude) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index db54237a767..e88aa8f7d09 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -33,7 +33,7 @@ (require 'gnus-util) (defcustom gnus-post-method 'current - "Preferred method for posting USENET news. + "Preferred method for posting Usenet news. If this variable is `current' (which is the default), Gnus will use the \"current\" select method when posting. If it is `native', Gnus @@ -303,7 +303,7 @@ If nil, the address field will always be empty after invoking (defcustom gnus-message-highlight-citation t ;; gnus-treat-highlight-citation ;; gnus-cite dependency - "Enable highlighting of different citation levels in message-mode." + "Enable highlighting of different citation levels in `message-mode'." :version "23.1" ;; No Gnus :group 'gnus-cite :group 'gnus-message @@ -349,39 +349,39 @@ only affect the Gcc copy, but not the original message." ;;; Gnus Posting Functions ;;; -(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map) - "p" gnus-summary-post-news - "i" gnus-summary-news-other-window - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "c" gnus-summary-cancel-article - "s" gnus-summary-supersede-article - "r" gnus-summary-reply - "y" gnus-summary-yank-message - "R" gnus-summary-reply-with-original - "L" gnus-summary-reply-to-list-with-original - "w" gnus-summary-wide-reply - "W" gnus-summary-wide-reply-with-original - "v" gnus-summary-very-wide-reply - "V" gnus-summary-very-wide-reply-with-original - "n" gnus-summary-followup-to-mail - "N" gnus-summary-followup-to-mail-with-original - "m" gnus-summary-mail-other-window - "u" gnus-uu-post-news - "A" gnus-summary-attach-article - "\M-c" gnus-summary-mail-crosspost-complaint - "Br" gnus-summary-reply-broken-reply-to - "BR" gnus-summary-reply-broken-reply-to-with-original - "om" gnus-summary-mail-forward - "op" gnus-summary-post-forward - "Om" gnus-uu-digest-mail-forward - "Op" gnus-uu-digest-post-forward) - -(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) - "b" gnus-summary-resend-bounced-mail - ;; "c" gnus-summary-send-draft - "r" gnus-summary-resend-message - "e" gnus-summary-resend-message-edit) +(define-keymap :prefix 'gnus-summary-send-map + "p" #'gnus-summary-post-news + "i" #'gnus-summary-news-other-window + "f" #'gnus-summary-followup + "F" #'gnus-summary-followup-with-original + "c" #'gnus-summary-cancel-article + "s" #'gnus-summary-supersede-article + "r" #'gnus-summary-reply + "y" #'gnus-summary-yank-message + "R" #'gnus-summary-reply-with-original + "L" #'gnus-summary-reply-to-list-with-original + "w" #'gnus-summary-wide-reply + "W" #'gnus-summary-wide-reply-with-original + "v" #'gnus-summary-very-wide-reply + "V" #'gnus-summary-very-wide-reply-with-original + "n" #'gnus-summary-followup-to-mail + "N" #'gnus-summary-followup-to-mail-with-original + "m" #'gnus-summary-mail-other-window + "u" #'gnus-uu-post-news + "A" #'gnus-summary-attach-article + "\M-c" #'gnus-summary-mail-crosspost-complaint + "Br" #'gnus-summary-reply-broken-reply-to + "BR" #'gnus-summary-reply-broken-reply-to-with-original + "om" #'gnus-summary-mail-forward + "op" #'gnus-summary-post-forward + "Om" #'gnus-uu-digest-mail-forward + "Op" #'gnus-uu-digest-post-forward + + "D" (define-keymap :prefix 'gnus-send-bounce-map + "b" #'gnus-summary-resend-bounced-mail + ;; "c" gnus-summary-send-draft + "r" #'gnus-summary-resend-message + "e" #'gnus-summary-resend-message-edit)) ;;; Internal functions. @@ -1303,15 +1303,9 @@ For the \"inline\" alternatives, also see the variable (defun gnus-summary-resend-message-insert-gcc () "Insert Gcc header according to `gnus-gcc-self-resent-messages'." (gnus-inews-insert-gcc) - (let ((gcc (mapcar - (lambda (group) - (encode-coding-string - group - (gnus-group-name-charset (gnus-inews-group-method group) - group))) - (message-unquote-tokens + (let ((gcc (message-unquote-tokens (message-tokenize-header (mail-fetch-field "gcc" nil t) - " ,")))) + " ,"))) (self (with-current-buffer gnus-summary-buffer gnus-gcc-self-resent-messages))) (message-remove-header "gcc") @@ -1322,12 +1316,9 @@ For the \"inline\" alternatives, also see the variable (insert "Gcc: \"" gnus-newsgroup-name "\"\n")) ((stringp self) (insert "Gcc: " - (encode-coding-string - (if (string-match " " self) - (concat "\"" self "\"") - self) - (gnus-group-name-charset (gnus-inews-group-method self) - self)) + (if (string-search " " self) + (concat "\"" self "\"") + self) "\n")) ((null self) (insert "Gcc: " (mapconcat #'identity gcc ", ") "\n")) @@ -1584,10 +1575,7 @@ this is a reply." (message-tokenize-header gcc " ,\n\t"))) ;; Copy the article over to some group(s). (while (setq group (pop groups)) - (setq method (gnus-inews-group-method group) - group (encode-coding-string - group - (gnus-group-name-charset method group))) + (setq method (gnus-inews-group-method group)) (unless (gnus-check-server method) (error "Can't open server %s" (if (stringp method) method (car method)))) @@ -1681,7 +1669,7 @@ this is a reply." (gnus-group-find-parameter group 'gcc-self t))) (gcc-self-get (lambda (gcc-self-val group) (if (stringp gcc-self-val) - (if (string-match " " gcc-self-val) + (if (string-search " " gcc-self-val) (concat "\"" gcc-self-val "\"") gcc-self-val) ;; In nndoc groups, we use the parent group name @@ -1689,7 +1677,7 @@ this is a reply." (let ((group (or (gnus-group-find-parameter gnus-newsgroup-name 'parent-group) group))) - (if (string-match " " group) + (if (string-search " " group) (concat "\"" group "\"") group))))) result @@ -1752,11 +1740,11 @@ this is a reply." (gnus-delete-line))) ;; Use the list of groups. (while (setq name (pop groups)) - (let ((str (if (string-match ":" name) + (let ((str (if (string-search ":" name) name (gnus-group-prefixed-name name gnus-message-archive-method)))) - (insert (if (string-match " " str) + (insert (if (string-search " " str) (concat "\"" str "\"") str))) (when groups diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index 7d12ae9fdcc..a8f09b63711 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -40,10 +40,17 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE." (define-obsolete-function-alias 'gnus-copy-sequence 'copy-tree "27.1") +;;; We could be using `seq-difference' here, but it's much slower +;;; on these data sets. See bug#50877. (defun gnus-set-difference (list1 list2) "Return a list of elements of LIST1 that do not appear in LIST2." - (declare (obsolete seq-difference "28.1")) - (seq-difference list1 list2 #'eq)) + (let ((hash2 (make-hash-table :test 'eq)) + (result nil)) + (dolist (elt list2) (puthash elt t hash2)) + (dolist (elt list1) + (unless (gethash elt hash2) + (setq result (cons elt result)))) + (nreverse result))) (defun gnus-range-nconcat (&rest ranges) "Return a range comprising all the RANGES, which are pre-sorted. diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 0468d72edd0..8ce88dc81e4 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -772,7 +772,7 @@ possible. Uses `gnus-registry-split-strategy'." nil)))) (defun gnus-registry-follow-group-p (group) - "Determines if a group name should be followed. + "Determine if a group name should be followed. Consults `gnus-registry-unfollowed-groups' and `nnmail-split-fancy-with-parent-ignore-groups'." (and group @@ -789,7 +789,7 @@ Consults `gnus-registry-unfollowed-groups' and ;; we do special logic for ignoring to accept regular expressions and ;; nnmail-split-fancy-with-parent-ignore-groups as well (defun gnus-registry-ignore-group-p (group) - "Determines if a group name should be ignored. + "Determine if a group name should be ignored. Consults `gnus-registry-ignored-groups' and `nnmail-split-fancy-with-parent-ignore-groups'." (and group @@ -990,9 +990,9 @@ Uses `gnus-registry-marks' to find what shortcuts to install." gnus-registry-misc-menus) (gnus-message 9 "Defined mark handling function %s" function-name)))))) - (gnus-define-keys-1 - '(gnus-registry-mark-map "M" gnus-summary-mark-map) - keys-plist) + (define-key gnus-summary-mark-map "M" + (apply #'define-keymap :prefix 'gnus-summary-mark-map + keys-plist)) (add-hook 'gnus-summary-menu-hook (lambda () (easy-menu-add-item @@ -1142,7 +1142,7 @@ non-nil." entry) (while (car-safe old) (cl-incf count) - ;; don't use progress reporters for backwards compatibility + ;; todo: use progress reporters. (when (and (< 0 expected) (= 0 (mod count 100))) (message "importing: %d of %d (%.2f%%)" diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el index 5697c870888..c135ecea369 100644 --- a/lisp/gnus/gnus-rfc1843.el +++ b/lisp/gnus/gnus-rfc1843.el @@ -44,7 +44,7 @@ (case-fold-search t) (ct (message-fetch-field "Content-Type" t)) (ctl (and ct (mail-header-parse-content-type ct)))) - (if (and ctl (not (string-match "/" (car ctl)))) + (if (and ctl (not (string-search "/" (car ctl)))) (setq ctl nil)) (goto-char (point-max)) (widen) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 5b746a8efa9..8ffe4a4c573 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -51,7 +51,7 @@ (defcustom gnus-pick-elegant-flow t "If non-nil, `gnus-pick-start-reading' runs - `gnus-summary-next-group' when no articles have been picked." +`gnus-summary-next-group' when no articles have been picked." :type 'boolean :group 'gnus-summary-pick) @@ -64,15 +64,12 @@ It accepts the same format specs that `gnus-summary-line-format' does." ;;; Internal variables. -(defvar gnus-pick-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - " " gnus-pick-next-page - "u" gnus-pick-unmark-article-or-thread - "." gnus-pick-article-or-thread - [down-mouse-2] gnus-pick-mouse-pick-region - "\r" gnus-pick-start-reading) - map)) +(defvar-keymap gnus-pick-mode-map + " " #'gnus-pick-next-page + "u" #'gnus-pick-unmark-article-or-thread + "." #'gnus-pick-article-or-thread + [down-mouse-2] #'gnus-pick-mouse-pick-region + "\r" #'gnus-pick-start-reading) (defun gnus-pick-make-menu-bar () (unless (boundp 'gnus-pick-menu) @@ -315,11 +312,8 @@ This must be bound to a button-down mouse event." (defvar gnus-binary-mode-hook nil "Hook run in summary binary mode buffers.") -(defvar gnus-binary-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "g" gnus-binary-show-article) - map)) +(defvar-keymap gnus-binary-mode-map + "g" #'gnus-binary-show-article) (defun gnus-binary-make-menu-bar () (unless (boundp 'gnus-binary-menu) @@ -424,21 +418,17 @@ Two predefined functions are available: (defvar gnus-tree-displayed-thread nil) (defvar gnus-tree-inhibit nil) -(defvar gnus-tree-mode-map - (let ((map (make-keymap))) - (suppress-keymap map) - (gnus-define-keys - map - "\r" gnus-tree-select-article - [mouse-2] gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - "h" gnus-tree-show-summary - - "\C-c\C-i" gnus-info-find-node) - - (substitute-key-definition - 'undefined 'gnus-tree-read-summary-keys map) - map)) +(defvar-keymap gnus-tree-mode-map + :full t :suppress t + "\r" #'gnus-tree-select-article + [mouse-2] #'gnus-tree-pick-article + "\C-?" #'gnus-tree-read-summary-keys + "h" #'gnus-tree-show-summary + + "\C-c\C-i" #'gnus-info-find-node) + +(substitute-key-definition 'undefined #'gnus-tree-read-summary-keys + gnus-tree-mode-map) (defun gnus-tree-make-menu-bar () (unless (boundp 'gnus-tree-menu) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index f40da9e9c4c..2ca25802957 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -502,19 +502,20 @@ of the last successful match.") ;;; Summary mode score maps. -(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map) - "s" gnus-summary-set-score - "S" gnus-summary-current-score - "c" gnus-score-change-score-file - "C" gnus-score-customize - "m" gnus-score-set-mark-below - "x" gnus-score-set-expunge-below - "R" gnus-summary-rescore - "e" gnus-score-edit-current-scores - "f" gnus-score-edit-file - "F" gnus-score-flush-cache - "t" gnus-score-find-trace - "w" gnus-score-find-favorite-words) +(define-key gnus-summary-mode-map "V" + (define-keymap :prefix 'gnus-summary-score-map + "s" #'gnus-summary-set-score + "S" #'gnus-summary-current-score + "c" #'gnus-score-change-score-file + "C" #'gnus-score-customize + "m" #'gnus-score-set-mark-below + "x" #'gnus-score-set-expunge-below + "R" #'gnus-summary-rescore + "e" #'gnus-score-edit-current-scores + "f" #'gnus-score-edit-file + "F" #'gnus-score-flush-cache + "t" #'gnus-score-find-trace + "w" #'gnus-score-find-favorite-words)) ;; Summary score file commands @@ -1093,7 +1094,7 @@ EXTRA is the possible non-standard header." (defun gnus-summary-current-score (arg) "Return the score of the current article. - With prefix ARG, return the total score of the current (sub)thread." +With prefix ARG, return the total score of the current (sub)thread." (interactive "P" gnus-article-mode gnus-summary-mode) (message "%s" (if arg (gnus-thread-total-score @@ -3115,7 +3116,9 @@ If ADAPT, return the home adaptive file instead." ;;; (defun gnus-decay-score (score) - "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." + "Decay SCORE according to decay variables. +The decay variables are `gnus-score-decay-constant' and +`gnus-score-decay-scale'." (floor (- score (* (if (< score 0) -1 1) (min (abs score) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 39bde837b30..31573588046 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -132,7 +132,7 @@ transformed." (defcustom gnus-search-ignored-newsgroups "" "A regexp to match newsgroups in the active file that should - be skipped when searching." +be skipped when searching." :version "24.1" :type 'regexp) @@ -172,8 +172,7 @@ This variable can also be set per-server." :type 'regexp) (defcustom gnus-search-swish++-raw-queries-p nil - "If t, all Swish++ engines will only accept raw search query - strings." + "If t, all Swish++ engines will only accept raw search query strings." :type 'boolean :version "28.1") @@ -217,8 +216,7 @@ This variable can also be set per-server." :version "28.1") (defcustom gnus-search-swish-e-raw-queries-p nil - "If t, all Swish-e engines will only accept raw search query - strings." + "If t, all Swish-e engines will only accept raw search query strings." :type 'boolean :version "28.1") @@ -266,8 +264,7 @@ This variable can also be set per-server." :version "28.1") (defcustom gnus-search-namazu-raw-queries-p nil - "If t, all Namazu engines will only accept raw search query - strings." + "If t, all Namazu engines will only accept raw search query strings." :type 'boolean :version "28.1") @@ -305,14 +302,12 @@ This variable can also be set per-server." :version "28.1") (defcustom gnus-search-notmuch-raw-queries-p nil - "If t, all Notmuch engines will only accept raw search query - strings." + "If t, all Notmuch engines will only accept raw search query strings." :type 'boolean :version "28.1") (defcustom gnus-search-imap-raw-queries-p nil - "If t, all IMAP engines will only accept raw search query - strings." + "If t, all IMAP engines will only accept raw search query strings." :version "28.1" :type 'boolean) @@ -350,8 +345,7 @@ This variable can also be set per-server." :type 'regexp) (defcustom gnus-search-mairix-raw-queries-p nil - "If t, all Mairix engines will only accept raw search query - strings." + "If t, all Mairix engines will only accept raw search query strings." :version "28.1" :type 'boolean) @@ -403,7 +397,7 @@ expressions. Key is most often a mail header, but there are other keys. Value is a string, quoted if it contains spaces. Key and value are separated by a colon, no space. Expressions are implicitly ANDed; the \"or\" keyword can be used to -OR. \"not\" will negate the following expression, or keys can be +OR. \"not\" will negate the following expression, or keys can be prefixed with a \"-\". The \"near\" operator will work for engines that understand it; other engines will convert it to \"or\". Parenthetical groups work as expected. @@ -413,7 +407,7 @@ header. Search keys can be expanded with TAB during entry, or left abbreviated so long as they remain unambiguous, ie \"f\" will -search the \"from\" header. \"s\" will raise an error. +search the \"from\" header. \"s\" will raise an error. Other keys: @@ -433,7 +427,7 @@ It's also possible to use Gnus' internal marks, ie \"mark:R\" will be interpreted as mark:read. \"tag\" will search tags -- right now that's translated to -\"keyword\" in IMAP, and left as \"tag\" for notmuch. At some +\"keyword\" in IMAP, and left as \"tag\" for notmuch. At some point this should also be used to search marks in the Gnus registry. @@ -572,7 +566,7 @@ nil. If VALUE is a relative time, interpret it as relative to REL-DATE, or (current-time) if REL-DATE is nil." ;; Time parsing doesn't seem to work with slashes. - (let ((value (replace-regexp-in-string "/" "-" value)) + (let ((value (string-replace "/" "-" value)) (now (append '(0 0 0) (seq-subseq (decode-time (or rel-date (current-time))) @@ -980,7 +974,7 @@ Responsible for handling and, or, and parenthetical expressions.") ;; Most search engines use implicit ANDs. (cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine) - (_expr (eql and))) + (_expr (eql 'and))) nil) ;; Most search engines use explicit infixed ORs. @@ -1090,7 +1084,8 @@ Responsible for handling and, or, and parenthetical expressions.") Currently takes into account support for the LITERAL+ capability. Other capabilities could be tested here." (with-slots (literal-plus) engine - (when literal-plus + (when (and literal-plus + (string-match-p "\n" query)) (setq query (split-string query "\n"))) (cond ((consp query) @@ -1358,6 +1353,7 @@ Returns a list of [group article score] vectors." server query &optional groups) (let ((prefix (or (slot-value engine 'remove-prefix) "")) + (groups (mapcar #'gnus-group-short-name groups)) artlist article group) (goto-char (point-min)) ;; Prep prefix, we want to at least be removing the root @@ -1384,7 +1380,6 @@ Returns a list of [group article score] vectors." nil t) nil t) nil t)) - (setq group (gnus-group-full-name group server)) (setq article (file-name-nondirectory f-name) article ;; TODO: Provide a cleaner way of producing final @@ -1392,7 +1387,7 @@ Returns a list of [group article score] vectors." (if (string-match-p "\\`[[:digit:]]+\\'" article) (string-to-number article) (nnmaildir-base-name-to-article-number - (substring article 0 (string-match ":" article)) + (substring article 0 (string-search ":" article)) group (string-remove-prefix "nnmaildir:" server)))) (when (and (numberp article) (or (null groups) @@ -1404,10 +1399,12 @@ Returns a list of [group article score] vectors." (setq artlist (gnus-search-grep-search engine artlist grep-reg))) ;; Munge into the list of vectors expected by nnselect. (mapcar (pcase-lambda (`(,_ ,article ,group ,score)) - (vector group article - (if (numberp score) - score - (string-to-number score)))) + (vector + (gnus-group-full-name group server) + article + (if (numberp score) + score + (string-to-number score)))) artlist))) (cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed)) @@ -1667,7 +1664,7 @@ cross our fingers for the rest of it." Mairix negation requires a \"~\" preceding string search terms, and \"-\" before marks." (let ((next (gnus-search-transform-expression engine (cadr expr)))) - (replace-regexp-in-string + (string-replace ":" (if (eql (caadr expr) 'mark) ":-" @@ -1861,9 +1858,9 @@ Assume \"size\" key is equal to \"larger\"." group (if (file-directory-p (setq group - (replace-regexp-in-string - "\\." "/" - group nil t))) + (string-replace + "." "/" + group))) group)))))) (unless group (signal 'gnus-search-config-error @@ -2134,7 +2131,7 @@ article came from is also searched." ;; If the value contains spaces, make sure it's ;; quoted. (when (and (memql status '(exact finished)) - (or (string-match-p " " str) + (or (string-search " " str) in-string)) (unless (looking-at-p "\\s\"") (insert "\"")) diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el index eeedf7ff35c..d173decbb6a 100644 --- a/lisp/gnus/gnus-sieve.el +++ b/lisp/gnus/gnus-sieve.el @@ -61,8 +61,9 @@ For example: \"nnimap:mailbox\"" :type 'boolean) (defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s" - "Shell command to execute after updating your Sieve script. The following -formatting characters are recognized: + "Shell command to execute after updating your Sieve script. + +The following formatting characters are recognized: %f Script's file name (gnus-sieve-file) %s Server name (from gnus-sieve-select-method)" diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index cb60108ea9c..59c6956ac2f 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -582,7 +582,7 @@ or to characters when given a pad value." ((string= fstring "") nil) ;; Not a format string. - ((not (string-match "%" fstring)) + ((not (string-search "%" fstring)) (list fstring)) ;; A format string with just a single string spec. ((string= fstring "%s") diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index f66f8427eab..f2ffb067b8e 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -103,7 +103,43 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar gnus-server-mode-line-format-spec nil) (defvar gnus-server-killed-servers nil) -(defvar gnus-server-mode-map nil) +(defvar-keymap gnus-server-mode-map + :full t :suppress t + " " #'gnus-server-read-server-in-server-buffer + "\r" #'gnus-server-read-server + [mouse-2] #'gnus-server-pick-server + "q" #'gnus-server-exit + "l" #'gnus-server-list-servers + "k" #'gnus-server-kill-server + "y" #'gnus-server-yank-server + "c" #'gnus-server-copy-server + "a" #'gnus-server-add-server + "e" #'gnus-server-edit-server + "S" #'gnus-server-show-server + "s" #'gnus-server-scan-server + + "O" #'gnus-server-open-server + "\M-o" #'gnus-server-open-all-servers + "C" #'gnus-server-close-server + "\M-c" #'gnus-server-close-all-servers + "D" #'gnus-server-deny-server + "L" #'gnus-server-offline-server + "R" #'gnus-server-remove-denials + + "n" #'next-line + "p" #'previous-line + + "g" #'gnus-server-regenerate-server + + "G" #'gnus-group-read-ephemeral-search-group + + "z" #'gnus-server-compact-server + + "i" #'gnus-server-toggle-cloud-server + "I" #'gnus-server-set-cloud-method-server + + "\C-c\C-i" #'gnus-info-find-node + "\C-c\C-b" #'gnus-bug) (defcustom gnus-server-menu-hook nil "Hook run after the creation of the server mode menu." @@ -145,47 +181,6 @@ If nil, a faster, but more primitive, buffer is used instead." (gnus-run-hooks 'gnus-server-menu-hook))) -(unless gnus-server-mode-map - (setq gnus-server-mode-map (make-keymap)) - (suppress-keymap gnus-server-mode-map) - - (gnus-define-keys gnus-server-mode-map - " " gnus-server-read-server-in-server-buffer - "\r" gnus-server-read-server - [mouse-2] gnus-server-pick-server - "q" gnus-server-exit - "l" gnus-server-list-servers - "k" gnus-server-kill-server - "y" gnus-server-yank-server - "c" gnus-server-copy-server - "a" gnus-server-add-server - "e" gnus-server-edit-server - "S" gnus-server-show-server - "s" gnus-server-scan-server - - "O" gnus-server-open-server - "\M-o" gnus-server-open-all-servers - "C" gnus-server-close-server - "\M-c" gnus-server-close-all-servers - "D" gnus-server-deny-server - "L" gnus-server-offline-server - "R" gnus-server-remove-denials - - "n" next-line - "p" previous-line - - "g" gnus-server-regenerate-server - - "G" gnus-group-read-ephemeral-search-group - - "z" gnus-server-compact-server - - "i" gnus-server-toggle-cloud-server - "I" gnus-server-set-cloud-method-server - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - (defface gnus-server-agent '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t)) (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) @@ -204,7 +199,7 @@ If nil, a faster, but more primitive, buffer is used instead." '((((class color) (background light)) (:foreground "ForestGreen" :inverse-video t :italic t)) (((class color) (background dark)) (:foreground "PaleGreen" :inverse-video t :italic t)) (t (:inverse-video t :italic t))) - "Face used for displaying the Cloud Host" + "Face used for displaying the Cloud Host." :group 'gnus-server-visual) (defface gnus-server-opened @@ -570,7 +565,7 @@ The following commands are available: (when (assoc to gnus-server-alist) (error "%s already exists" to)) (unless (gnus-server-to-method from) - (error "%s: no such server" from)) + (error "%s: No such server" from)) (let ((to-entry (cons from (copy-tree (gnus-server-to-method from))))) (setcar to-entry to) @@ -697,37 +692,31 @@ claim them." function (repeat function))) -(defvar gnus-browse-mode-map nil) - -(unless gnus-browse-mode-map - (setq gnus-browse-mode-map (make-keymap)) - (suppress-keymap gnus-browse-mode-map) - - (gnus-define-keys - gnus-browse-mode-map - " " gnus-browse-read-group - "=" gnus-browse-select-group - "n" gnus-browse-next-group - "p" gnus-browse-prev-group - "\177" gnus-browse-prev-group - [delete] gnus-browse-prev-group - "N" gnus-browse-next-group - "P" gnus-browse-prev-group - "\M-n" gnus-browse-next-group - "\M-p" gnus-browse-prev-group - "\r" gnus-browse-select-group - "u" gnus-browse-unsubscribe-current-group - "l" gnus-browse-exit - "L" gnus-browse-exit - "q" gnus-browse-exit - "Q" gnus-browse-exit - "d" gnus-browse-describe-group - [delete] gnus-browse-delete-group - "\C-c\C-c" gnus-browse-exit - "?" gnus-browse-describe-briefly - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) +(defvar-keymap gnus-browse-mode-map + :full t :suppress t + " " #'gnus-browse-read-group + "=" #'gnus-browse-select-group + "n" #'gnus-browse-next-group + "p" #'gnus-browse-prev-group + "\177" #'gnus-browse-prev-group + [delete] #'gnus-browse-prev-group + "N" #'gnus-browse-next-group + "P" #'gnus-browse-prev-group + "\M-n" #'gnus-browse-next-group + "\M-p" #'gnus-browse-prev-group + "\r" #'gnus-browse-select-group + "u" #'gnus-browse-toggle-subscription-at-point + "l" #'gnus-browse-exit + "L" #'gnus-browse-exit + "q" #'gnus-browse-exit + "Q" #'gnus-browse-exit + "d" #'gnus-browse-describe-group + [delete] #'gnus-browse-delete-group + "\C-c\C-c" #'gnus-browse-exit + "?" #'gnus-browse-describe-briefly + + "\C-c\C-i" #'gnus-info-find-node + "\C-c\C-b" #'gnus-bug) (defun gnus-browse-make-menu-bar () (gnus-turn-off-edit-menu 'browse) @@ -735,7 +724,7 @@ claim them." (easy-menu-define gnus-browse-menu gnus-browse-mode-map "" '("Browse" - ["Subscribe" gnus-browse-unsubscribe-current-group t] + ["Toggle Subscribe" gnus-browse-toggle-subscription-at-point t] ["Read" gnus-browse-read-group t] ["Select" gnus-browse-select-group t] ["Describe" gnus-browse-describe-group t] @@ -881,9 +870,9 @@ All normal editing commands are switched off. \\<gnus-browse-mode-map> The only things you can do in this buffer is -1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. -The group will be inserted into the group buffer upon exit from this -buffer. +1) `\\[gnus-browse-toggle-subscription-at-point]' to subscribe or unsubscribe to +a group. The group will be inserted into the group buffer upon exit from +this buffer. 2) `\\[gnus-browse-read-group]' to read a group ephemerally. @@ -933,7 +922,12 @@ If NUMBER, fetch this number of articles." (interactive "p" gnus-browse-mode) (gnus-browse-next-group (- n))) -(defun gnus-browse-unsubscribe-current-group (arg) +(define-obsolete-function-alias 'gnus-browse-unsubscribe-current-group + 'gnus-browse-toggle-subscription-at-point "28.1") +(define-obsolete-function-alias 'gnus-browse-unsubscribe-group + 'gnus-browse-toggle-subscription "28.1") + +(defun gnus-browse-toggle-subscription-at-point (arg) "(Un)subscribe to the next ARG groups. The variable `gnus-browse-subscribe-newsgroup-method' determines how new groups will be entered into the group buffer." @@ -944,7 +938,7 @@ how new groups will be entered into the group buffer." (arg (abs arg))) (while (and (> arg 0) (not (eobp)) - (gnus-browse-unsubscribe-group) + (gnus-browse-toggle-subscription) (zerop (gnus-browse-next-group ward))) (cl-decf arg)) (gnus-group-position-point) @@ -976,7 +970,7 @@ doing the deletion." gnus-browse-mode) (gnus-group-delete-group group force)) -(defun gnus-browse-unsubscribe-group () +(defun gnus-browse-toggle-subscription () "Toggle subscription of the current group in the browse buffer." (let ((sub nil) (buffer-read-only nil) @@ -1123,7 +1117,7 @@ Requesting compaction of %s... (this may take a long time)" (customize-set-variable 'gnus-cloud-method server) ;; Note we can't use `Custom-save' here. (when (gnus-yes-or-no-p - (format "The new cloud host server is %S now. Save it? " server)) + (format "The new cloud host server is `%S' now. Save it?" server)) (customize-save-variable 'gnus-cloud-method server))) (when (gnus-yes-or-no-p (format "Upload Cloud data to %S now? " server)) (gnus-message 1 "Uploading all data to Emacs Cloud server %S" server) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 44e97d54846..606bd3a39a4 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -663,6 +663,7 @@ the first newsgroup." (defvar mail-sources) (defvar nnmail-scan-directory-mail-source-once) (defvar nnmail-split-history) +(defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-close-all-servers () "Close all servers." @@ -707,6 +708,7 @@ the first newsgroup." gnus-current-select-method nil nnmail-split-history nil gnus-extended-servers nil + gnus-save-newsrc-file-last-timestamp nil gnus-ephemeral-servers nil) (gnus-shutdown 'gnus) ;; Kill the startup file. @@ -715,6 +717,9 @@ the first newsgroup." (kill-buffer (get-file-buffer gnus-current-startup-file))) ;; Clear the dribble buffer. (gnus-dribble-clear) + ;; Reset the level when Gnus is restarted. + (when (numberp gnus-group-use-permanent-levels) + (setq gnus-group-use-permanent-levels t)) ;; Kill global KILL file buffer. (when (get-file-buffer (gnus-newsgroup-kill-file nil)) (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) @@ -854,7 +859,7 @@ If REGEXP is given, lines that match it will be deleted." (goto-char (point-max)) ;; Make sure that each dribble entry is a single line, so that ;; the "remove" code above works. - (insert (replace-regexp-in-string "\n" "\\\\n" string) "\n") + (insert (string-replace "\n" "\\n" string) "\n") (bury-buffer gnus-dribble-buffer) (with-current-buffer gnus-group-buffer (gnus-group-set-mode-line))))) @@ -1065,9 +1070,9 @@ If no function returns `non-nil', call `gnus-subscribe-zombies'." Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'. The `-n' option line from .newsrc is respected. -With 1 C-u, use the `ask-server' method to query the server for new +With 1 \\[universal-argument], use the `ask-server' method to query the server for new groups. -With 2 C-u's, use most complete method possible to query the server +With 2 \\[universal-argument]'s, use most complete method possible to query the server for new groups, and subscribe the new groups as zombies." (interactive "p" gnus-group-mode) (let* ((gnus-subscribe-newsgroup-method @@ -2337,9 +2342,9 @@ If FORCE is non-nil, the .newsrc file is read." (defun gnus-convert-mark-converter-prompt (converter no-prompt) "Indicate whether CONVERTER requires `gnus-convert-old-newsrc' to - display the conversion prompt. NO-PROMPT may be nil (prompt), - t (no prompt), or any form that can be called as a function. - The form should return either t or nil." +display the conversion prompt. NO-PROMPT may be nil (prompt), +t (no prompt), or any form that can be called as a function. +The form should return either t or nil." (put converter 'gnus-convert-no-prompt no-prompt)) (defun gnus-convert-converter-needs-prompt (converter) @@ -2728,7 +2733,6 @@ If FORCE is non-nil, the .newsrc file is read." 'msdos-long-file-names (lambda () t)))) -(defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-save-newsrc-file (&optional force) "Save .newsrc file. Use the group string names in `gnus-group-list' to pull info @@ -2931,7 +2935,7 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." (nreverse olist))) (defun gnus-gnus-to-newsrc-format (&optional foreign-ok) - (interactive (list (gnus-y-or-n-p "write foreign groups too? "))) + (interactive (list (gnus-y-or-n-p "Write foreign groups too?"))) ;; Generate and save the .newsrc file. (with-current-buffer (create-file-buffer gnus-current-startup-file) (let ((standard-output (current-buffer)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4bdc2023eb4..3beeace8979 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1723,8 +1723,7 @@ For example: \(setq gnus-newsgroup-variables \\='(message-use-followup-to (gnus-visible-headers . - \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\"))) -") + \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))") (eval-when-compile ;; Bind features so that require will believe that gnus-sum has @@ -1908,484 +1907,483 @@ increase the score of each group you read." ;; Non-orthogonal keys -(gnus-define-keys gnus-summary-mode-map - " " gnus-summary-next-page - [?\S-\ ] gnus-summary-prev-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\M-\C-n" gnus-summary-next-same-subject - "\M-\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "." gnus-summary-first-unread-article - "," gnus-summary-best-unread-article - "[" gnus-summary-prev-unseen-article - "]" gnus-summary-next-unseen-article - "\M-s\M-s" gnus-summary-search-article-forward - "\M-s\M-r" gnus-summary-search-article-backward - "\M-r" gnus-summary-search-article-backward - "\M-S" gnus-summary-repeat-search-article-forward - "\M-R" gnus-summary-repeat-search-article-backward - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "j" gnus-summary-goto-article - "^" gnus-summary-refer-parent-article - "\M-^" gnus-summary-refer-article - "u" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "U" gnus-summary-tick-article-backward - "d" gnus-summary-mark-as-read-forward - "D" gnus-summary-mark-as-read-backward - "E" gnus-summary-mark-as-expirable - "\M-u" gnus-summary-clear-mark-forward - "\M-U" gnus-summary-clear-mark-backward - "k" gnus-summary-kill-same-subject-and-select - "\C-k" gnus-summary-kill-same-subject - "\M-\C-k" gnus-summary-kill-thread - "\M-\C-l" gnus-summary-lower-thread - "e" gnus-summary-edit-article - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "\M-\C-t" gnus-summary-toggle-threads - "\M-\C-s" gnus-summary-show-thread - "\M-\C-h" gnus-summary-hide-thread - "\M-\C-f" gnus-summary-next-thread - "\M-\C-b" gnus-summary-prev-thread - [(meta down)] gnus-summary-next-thread - [(meta up)] gnus-summary-prev-thread - "\M-\C-u" gnus-summary-up-thread - "\M-\C-d" gnus-summary-down-thread - "&" gnus-summary-execute-command - "c" gnus-summary-catchup-and-exit - "\C-w" gnus-summary-mark-region-as-read - "\C-t" toggle-truncate-lines - "?" gnus-summary-mark-as-dormant - "\C-c\M-\C-s" gnus-summary-limit-include-expunged - "\C-c\C-s\C-n" gnus-summary-sort-by-number - "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number - "\C-c\C-s\C-l" gnus-summary-sort-by-lines - "\C-c\C-s\C-c" gnus-summary-sort-by-chars - "\C-c\C-s\C-m\C-m" gnus-summary-sort-by-marks - "\C-c\C-s\C-a" gnus-summary-sort-by-author - "\C-c\C-s\C-t" gnus-summary-sort-by-recipient - "\C-c\C-s\C-s" gnus-summary-sort-by-subject - "\C-c\C-s\C-d" gnus-summary-sort-by-date - "\C-c\C-s\C-m\C-d" gnus-summary-sort-by-most-recent-date - "\C-c\C-s\C-i" gnus-summary-sort-by-score - "\C-c\C-s\C-o" gnus-summary-sort-by-original - "\C-c\C-s\C-r" gnus-summary-sort-by-random - "\C-c\C-s\C-u" gnus-summary-sort-by-newsgroups - "\C-c\C-s\C-x" gnus-summary-sort-by-extra - "=" gnus-summary-expand-window - "\C-x\C-s" gnus-summary-reselect-current-group - "\M-g" gnus-summary-rescan-group - "\C-c\C-r" gnus-summary-caesar-message - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "C" gnus-summary-cancel-article - "r" gnus-summary-reply - "R" gnus-summary-reply-with-original - "\C-c\C-f" gnus-summary-mail-forward - "o" gnus-summary-save-article - "\C-o" gnus-summary-save-article-mail - "|" gnus-summary-pipe-output - "\M-k" gnus-summary-edit-local-kill - "\M-K" gnus-summary-edit-global-kill +(define-keymap :keymap gnus-summary-mode-map + " " #'gnus-summary-next-page + [?\S-\ ] #'gnus-summary-prev-page + "\177" #'gnus-summary-prev-page + [delete] #'gnus-summary-prev-page + "\r" #'gnus-summary-scroll-up + "\M-\r" #'gnus-summary-scroll-down + "n" #'gnus-summary-next-unread-article + "p" #'gnus-summary-prev-unread-article + "N" #'gnus-summary-next-article + "P" #'gnus-summary-prev-article + "\M-\C-n" #'gnus-summary-next-same-subject + "\M-\C-p" #'gnus-summary-prev-same-subject + "\M-n" #'gnus-summary-next-unread-subject + "\M-p" #'gnus-summary-prev-unread-subject + "." #'gnus-summary-first-unread-article + "," #'gnus-summary-best-unread-article + "[" #'gnus-summary-prev-unseen-article + "]" #'gnus-summary-next-unseen-article + "\M-s\M-s" #'gnus-summary-search-article-forward + "\M-s\M-r" #'gnus-summary-search-article-backward + "\M-r" #'gnus-summary-search-article-backward + "\M-S" #'gnus-summary-repeat-search-article-forward + "\M-R" #'gnus-summary-repeat-search-article-backward + "<" #'gnus-summary-beginning-of-article + ">" #'gnus-summary-end-of-article + "j" #'gnus-summary-goto-article + "^" #'gnus-summary-refer-parent-article + "\M-^" #'gnus-summary-refer-article + "u" #'gnus-summary-tick-article-forward + "!" #'gnus-summary-tick-article-forward + "U" #'gnus-summary-tick-article-backward + "d" #'gnus-summary-mark-as-read-forward + "D" #'gnus-summary-mark-as-read-backward + "E" #'gnus-summary-mark-as-expirable + "\M-u" #'gnus-summary-clear-mark-forward + "\M-U" #'gnus-summary-clear-mark-backward + "k" #'gnus-summary-kill-same-subject-and-select + "\C-k" #'gnus-summary-kill-same-subject + "\M-\C-k" #'gnus-summary-kill-thread + "\M-\C-l" #'gnus-summary-lower-thread + "e" #'gnus-summary-edit-article + "#" #'gnus-summary-mark-as-processable + "\M-#" #'gnus-summary-unmark-as-processable + "\M-\C-t" #'gnus-summary-toggle-threads + "\M-\C-s" #'gnus-summary-show-thread + "\M-\C-h" #'gnus-summary-hide-thread + "\M-\C-f" #'gnus-summary-next-thread + "\M-\C-b" #'gnus-summary-prev-thread + [(meta down)] #'gnus-summary-next-thread + [(meta up)] #'gnus-summary-prev-thread + "\M-\C-u" #'gnus-summary-up-thread + "\M-\C-d" #'gnus-summary-down-thread + "&" #'gnus-summary-execute-command + "c" #'gnus-summary-catchup-and-exit + "\C-w" #'gnus-summary-mark-region-as-read + "\C-t" #'toggle-truncate-lines + "?" #'gnus-summary-mark-as-dormant + "\C-c\M-\C-s" #'gnus-summary-limit-include-expunged + "\C-c\C-s\C-n" #'gnus-summary-sort-by-number + "\C-c\C-s\C-m\C-n" #'gnus-summary-sort-by-most-recent-number + "\C-c\C-s\C-l" #'gnus-summary-sort-by-lines + "\C-c\C-s\C-c" #'gnus-summary-sort-by-chars + "\C-c\C-s\C-m\C-m" #'gnus-summary-sort-by-marks + "\C-c\C-s\C-a" #'gnus-summary-sort-by-author + "\C-c\C-s\C-t" #'gnus-summary-sort-by-recipient + "\C-c\C-s\C-s" #'gnus-summary-sort-by-subject + "\C-c\C-s\C-d" #'gnus-summary-sort-by-date + "\C-c\C-s\C-m\C-d" #'gnus-summary-sort-by-most-recent-date + "\C-c\C-s\C-i" #'gnus-summary-sort-by-score + "\C-c\C-s\C-o" #'gnus-summary-sort-by-original + "\C-c\C-s\C-r" #'gnus-summary-sort-by-random + "\C-c\C-s\C-u" #'gnus-summary-sort-by-newsgroups + "\C-c\C-s\C-x" #'gnus-summary-sort-by-extra + "=" #'gnus-summary-expand-window + "\C-x\C-s" #'gnus-summary-reselect-current-group + "\M-g" #'gnus-summary-rescan-group + "\C-c\C-r" #'gnus-summary-caesar-message + "f" #'gnus-summary-followup + "F" #'gnus-summary-followup-with-original + "C" #'gnus-summary-cancel-article + "r" #'gnus-summary-reply + "R" #'gnus-summary-reply-with-original + "\C-c\C-f" #'gnus-summary-mail-forward + "o" #'gnus-summary-save-article + "\C-o" #'gnus-summary-save-article-mail + "|" #'gnus-summary-pipe-output + "\M-k" #'gnus-summary-edit-local-kill + "\M-K" #'gnus-summary-edit-global-kill ;; "V" gnus-version - "\C-c\C-d" gnus-summary-describe-group - "\C-c\C-p" gnus-summary-make-group-from-search - "q" gnus-summary-exit - "Q" gnus-summary-exit-no-update - "\C-c\C-i" gnus-info-find-node - [mouse-2] gnus-mouse-pick-article - [follow-link] mouse-face - "m" gnus-summary-mail-other-window - "a" gnus-summary-post-news - "x" gnus-summary-limit-to-unread - "s" gnus-summary-isearch-article - "\t" gnus-summary-button-forward - [backtab] gnus-summary-button-backward - "w" gnus-summary-browse-url - "t" gnus-summary-toggle-header - "g" gnus-summary-show-article - "l" gnus-summary-goto-last-article - "\C-c\C-v\C-v" gnus-uu-decode-uu-view - "\C-d" gnus-summary-enter-digest-group - "\M-\C-d" gnus-summary-read-document - "\M-\C-e" gnus-summary-edit-parameters - "\M-\C-a" gnus-summary-customize-parameters - "\C-c\C-b" gnus-bug - "*" gnus-cache-enter-article - "\M-*" gnus-cache-remove-article - "\M-&" gnus-summary-universal-argument - "\C-l" gnus-recenter - "I" gnus-summary-increase-score - "L" gnus-summary-lower-score - "\M-i" gnus-symbolic-argument - "h" gnus-summary-select-article-buffer - - "b" gnus-article-view-part - "\M-t" gnus-summary-toggle-display-buttonized - - "V" gnus-summary-score-map - "X" gnus-uu-extract-map - "S" gnus-summary-send-map) - -;; Sort of orthogonal keymap -(gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) - "t" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "d" gnus-summary-mark-as-read-forward - "r" gnus-summary-mark-as-read-forward - "c" gnus-summary-clear-mark-forward - " " gnus-summary-clear-mark-forward - "e" gnus-summary-mark-as-expirable - "x" gnus-summary-mark-as-expirable - "?" gnus-summary-mark-as-dormant - "b" gnus-summary-set-bookmark - "B" gnus-summary-remove-bookmark - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "S" gnus-summary-limit-include-expunged - "C" gnus-summary-catchup - "H" gnus-summary-catchup-to-here - "h" gnus-summary-catchup-from-here - "\C-c" gnus-summary-catchup-all - "k" gnus-summary-kill-same-subject-and-select - "K" gnus-summary-kill-same-subject - "P" gnus-uu-mark-map) - -(gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map) - "c" gnus-summary-clear-above - "u" gnus-summary-tick-above - "m" gnus-summary-mark-above - "k" gnus-summary-kill-below) - -(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) - "/" gnus-summary-limit-to-subject - "n" gnus-summary-limit-to-articles - "b" gnus-summary-limit-to-bodies - "h" gnus-summary-limit-to-headers - "w" gnus-summary-pop-limit - "s" gnus-summary-limit-to-subject - "a" gnus-summary-limit-to-author - "u" gnus-summary-limit-to-unread - "m" gnus-summary-limit-to-marks - "M" gnus-summary-limit-exclude-marks - "v" gnus-summary-limit-to-score - "*" gnus-summary-limit-include-cached - "D" gnus-summary-limit-include-dormant - "T" gnus-summary-limit-include-thread - "d" gnus-summary-limit-exclude-dormant - "t" gnus-summary-limit-to-age - "." gnus-summary-limit-to-unseen - "x" gnus-summary-limit-to-extra - "p" gnus-summary-limit-to-display-predicate - "E" gnus-summary-limit-include-expunged - "c" gnus-summary-limit-exclude-childless-dormant - "C" gnus-summary-limit-mark-excluded-as-read - "o" gnus-summary-insert-old-articles - "N" gnus-summary-insert-new-articles - "S" gnus-summary-limit-to-singletons - "r" gnus-summary-limit-to-replied - "R" gnus-summary-limit-to-recipient - "A" gnus-summary-limit-to-address) - -(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\C-n" gnus-summary-next-same-subject - "\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "f" gnus-summary-first-unread-article - "b" gnus-summary-best-unread-article - "u" gnus-summary-next-unseen-article - "U" gnus-summary-prev-unseen-article - "j" gnus-summary-goto-article - "g" gnus-summary-goto-subject - "l" gnus-summary-goto-last-article - "o" gnus-summary-pop-article) - -(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) - "k" gnus-summary-kill-thread - "E" gnus-summary-expire-thread - "l" gnus-summary-lower-thread - "i" gnus-summary-raise-thread - "T" gnus-summary-toggle-threads - "t" gnus-summary-rethread-current - "^" gnus-summary-reparent-thread - "\M-^" gnus-summary-reparent-children - "s" gnus-summary-show-thread - "S" gnus-summary-show-all-threads - "h" gnus-summary-hide-thread - "H" gnus-summary-hide-all-threads - "n" gnus-summary-next-thread - "p" gnus-summary-prev-thread - "u" gnus-summary-up-thread - "o" gnus-summary-top-thread - "d" gnus-summary-down-thread - "#" gnus-uu-mark-thread - "\M-#" gnus-uu-unmark-thread) - -(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) - "g" gnus-summary-prepare - "c" gnus-summary-insert-cached-articles - "d" gnus-summary-insert-dormant-articles - "t" gnus-summary-insert-ticked-articles) - -(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) - "c" gnus-summary-catchup-and-exit - "C" gnus-summary-catchup-all-and-exit - "E" gnus-summary-exit-no-update - "Q" gnus-summary-exit - "Z" gnus-summary-exit - "n" gnus-summary-catchup-and-goto-next-group - "p" gnus-summary-catchup-and-goto-prev-group - "R" gnus-summary-reselect-current-group - "G" gnus-summary-rescan-group - "N" gnus-summary-next-group - "s" gnus-summary-save-newsrc - "P" gnus-summary-prev-group) - -(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) - " " gnus-summary-next-page - "n" gnus-summary-next-page - [?\S-\ ] gnus-summary-prev-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "p" gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "b" gnus-summary-beginning-of-article - "e" gnus-summary-end-of-article - "^" gnus-summary-refer-parent-article - "r" gnus-summary-refer-parent-article - "C" gnus-summary-show-complete-article - "D" gnus-summary-enter-digest-group - "R" gnus-summary-refer-references - "T" gnus-summary-refer-thread - "W" gnus-warp-to-article - "g" gnus-summary-show-article - "s" gnus-summary-isearch-article - "\t" gnus-summary-button-forward - [backtab] gnus-summary-button-backward - "w" gnus-summary-browse-url - "P" gnus-summary-print-article - "S" gnus-sticky-article - "M" gnus-mailing-list-insinuate - "t" gnus-article-babel) - -(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) - "b" gnus-article-add-buttons - "B" gnus-article-add-buttons-to-head - "o" gnus-article-treat-overstrike - "e" gnus-article-emphasize - "w" gnus-article-fill-cited-article - "Q" gnus-article-fill-long-lines - "L" gnus-article-toggle-truncate-lines - "C" gnus-article-capitalize-sentences - "c" gnus-article-remove-cr - "q" gnus-article-de-quoted-unreadable - "6" gnus-article-de-base64-unreadable - "Z" gnus-article-decode-HZ - "A" gnus-article-treat-ansi-sequences - "h" gnus-article-wash-html - "u" gnus-article-unsplit-urls - "s" gnus-summary-force-verify-and-decrypt - "f" gnus-article-display-x-face - "l" gnus-summary-stop-page-breaking - "r" gnus-summary-caesar-message - "m" gnus-summary-morse-message - "t" gnus-summary-toggle-header - "g" gnus-treat-smiley - "v" gnus-summary-verbose-headers - "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive - "p" gnus-article-verify-x-pgp-sig - "d" gnus-article-treat-smartquotes - "U" gnus-article-treat-non-ascii - "i" gnus-summary-idna-message) - -(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map) - ;; mnemonic: deuglif*Y* - "u" gnus-article-outlook-unwrap-lines - "a" gnus-article-outlook-repair-attribution - "c" gnus-article-outlook-rearrange-citation - "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify - -(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) - "a" gnus-article-hide - "h" gnus-article-hide-headers - "b" gnus-article-hide-boring-headers - "s" gnus-article-hide-signature - "c" gnus-article-hide-citation - "C" gnus-article-hide-citation-in-followups - "l" gnus-article-hide-list-identifiers - "B" gnus-article-strip-banner - "P" gnus-article-hide-pem - "\C-c" gnus-article-hide-citation-maybe) - -(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) - "a" gnus-article-highlight - "h" gnus-article-highlight-headers - "c" gnus-article-highlight-citation - "s" gnus-article-highlight-signature) - -(gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map) - "f" gnus-article-treat-fold-headers - "u" gnus-article-treat-unfold-headers - "n" gnus-article-treat-fold-newsgroups) - -(gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map) - "x" gnus-article-display-x-face - "d" gnus-article-display-face - "s" gnus-treat-smiley - "D" gnus-article-remove-images - "W" gnus-article-show-images - "f" gnus-treat-from-picon - "m" gnus-treat-mail-picon - "n" gnus-treat-newsgroups-picon - "g" gnus-treat-from-gravatar - "h" gnus-treat-mail-gravatar) - -(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) - "w" gnus-article-decode-mime-words - "c" gnus-article-decode-charset - "h" gnus-mime-buttonize-attachments-in-header - "v" gnus-mime-view-all-parts - "b" gnus-article-view-part) - -(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) - "z" gnus-article-date-ut - "u" gnus-article-date-ut - "l" gnus-article-date-local - "p" gnus-article-date-english - "e" gnus-article-date-lapsed - "o" gnus-article-date-original - "i" gnus-article-date-iso8601 - "s" gnus-article-date-user) - -(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) - "t" gnus-article-remove-trailing-blank-lines - "l" gnus-article-strip-leading-blank-lines - "m" gnus-article-strip-multiple-blank-lines - "a" gnus-article-strip-blank-lines - "A" gnus-article-strip-all-blank-lines - "s" gnus-article-strip-leading-space - "e" gnus-article-strip-trailing-space - "w" gnus-article-remove-leading-whitespace) - -(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) - "v" gnus-version - "d" gnus-summary-describe-group - "h" gnus-summary-describe-briefly - "i" gnus-info-find-node) - -(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) - "e" gnus-summary-expire-articles - "\M-\C-e" gnus-summary-expire-articles-now - "\177" gnus-summary-delete-article - [delete] gnus-summary-delete-article - [backspace] gnus-summary-delete-article - "m" gnus-summary-move-article - "r" gnus-summary-respool-article - "w" gnus-summary-edit-article - "c" gnus-summary-copy-article - "B" gnus-summary-crosspost-article - "q" gnus-summary-respool-query - "t" gnus-summary-respool-trace - "i" gnus-summary-import-article - "I" gnus-summary-create-article - "p" gnus-summary-article-posted-p) - -(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) - "o" gnus-summary-save-article - "m" gnus-summary-save-article-mail - "F" gnus-summary-write-article-file - "r" gnus-summary-save-article-rmail - "f" gnus-summary-save-article-file - "b" gnus-summary-save-article-body-file - "B" gnus-summary-write-article-body-file - "h" gnus-summary-save-article-folder - "v" gnus-summary-save-article-vm - "p" gnus-summary-pipe-output - "P" gnus-summary-muttprint) - -(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) - "b" gnus-summary-display-buttonized - "m" gnus-summary-repair-multipart - "v" gnus-article-view-part - "o" gnus-article-save-part - "O" gnus-article-save-part-and-strip - "r" gnus-article-replace-part - "d" gnus-article-delete-part - "t" gnus-article-view-part-as-type - "j" gnus-article-jump-to-part - "c" gnus-article-copy-part - "C" gnus-article-view-part-as-charset - "e" gnus-article-view-part-externally - "H" gnus-article-browse-html-article - "E" gnus-article-encrypt-body - "i" gnus-article-inline-part - "|" gnus-article-pipe-part) - -(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map) - "p" gnus-summary-mark-as-processable - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "s" gnus-uu-mark-series - "r" gnus-uu-mark-region - "g" gnus-uu-unmark-region - "R" gnus-uu-mark-by-regexp - "G" gnus-uu-unmark-by-regexp - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - "a" gnus-uu-mark-all - "b" gnus-uu-mark-buffer - "S" gnus-uu-mark-sparse - "k" gnus-summary-kill-process-mark - "y" gnus-summary-yank-process-mark - "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable) - -(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) - ;;"x" gnus-uu-extract-any - "m" gnus-summary-save-parts - "u" gnus-uu-decode-uu - "U" gnus-uu-decode-uu-and-save - "s" gnus-uu-decode-unshar - "S" gnus-uu-decode-unshar-and-save - "o" gnus-uu-decode-save - "O" gnus-uu-decode-save - "b" gnus-uu-decode-binhex - "B" gnus-uu-decode-binhex - "Y" gnus-uu-decode-yenc - "p" gnus-uu-decode-postscript - "P" gnus-uu-decode-postscript-and-save) - -(gnus-define-keys - (gnus-uu-extract-view-map "v" gnus-uu-extract-map) - "u" gnus-uu-decode-uu-view - "U" gnus-uu-decode-uu-and-save-view - "s" gnus-uu-decode-unshar-view - "S" gnus-uu-decode-unshar-and-save-view - "o" gnus-uu-decode-save-view - "O" gnus-uu-decode-save-view - "b" gnus-uu-decode-binhex-view - "B" gnus-uu-decode-binhex-view - "p" gnus-uu-decode-postscript-view - "P" gnus-uu-decode-postscript-and-save-view) + "\C-c\C-d" #'gnus-summary-describe-group + "\C-c\C-p" #'gnus-summary-make-group-from-search + "q" #'gnus-summary-exit + "Q" #'gnus-summary-exit-no-update + "\C-c\C-i" #'gnus-info-find-node + [mouse-2] #'gnus-mouse-pick-article + [follow-link] 'mouse-face + "m" #'gnus-summary-mail-other-window + "a" #'gnus-summary-post-news + "x" #'gnus-summary-limit-to-unread + "s" #'gnus-summary-isearch-article + "\t" #'gnus-summary-button-forward + [backtab] #'gnus-summary-button-backward + "w" #'gnus-summary-browse-url + "t" #'gnus-summary-toggle-header + "g" #'gnus-summary-show-article + "l" #'gnus-summary-goto-last-article + "\C-c\C-v\C-v" #'gnus-uu-decode-uu-view + "\C-d" #'gnus-summary-enter-digest-group + "\M-\C-d" #'gnus-summary-read-document + "\M-\C-e" #'gnus-summary-edit-parameters + "\M-\C-a" #'gnus-summary-customize-parameters + "\C-c\C-b" #'gnus-bug + "*" #'gnus-cache-enter-article + "\M-*" #'gnus-cache-remove-article + "\M-&" #'gnus-summary-universal-argument + "\C-l" #'gnus-recenter + "I" #'gnus-summary-increase-score + "L" #'gnus-summary-lower-score + "\M-i" #'gnus-symbolic-argument + "h" #'gnus-summary-select-article-buffer + + "b" #'gnus-article-view-part + "\M-t" #'gnus-summary-toggle-display-buttonized + + "S" #'gnus-summary-send-map + + ;; Sort of orthogonal keymaps. + "M" (define-keymap :prefix 'gnus-summary-mark-map + "t" #'gnus-summary-tick-article-forward + "!" #'gnus-summary-tick-article-forward + "d" #'gnus-summary-mark-as-read-forward + "r" #'gnus-summary-mark-as-read-forward + "c" #'gnus-summary-clear-mark-forward + " " #'gnus-summary-clear-mark-forward + "e" #'gnus-summary-mark-as-expirable + "x" #'gnus-summary-mark-as-expirable + "?" #'gnus-summary-mark-as-dormant + "b" #'gnus-summary-set-bookmark + "B" #'gnus-summary-remove-bookmark + "#" #'gnus-summary-mark-as-processable + "\M-#" #'gnus-summary-unmark-as-processable + "S" #'gnus-summary-limit-include-expunged + "C" #'gnus-summary-catchup + "H" #'gnus-summary-catchup-to-here + "h" #'gnus-summary-catchup-from-here + "\C-c" #'gnus-summary-catchup-all + "k" #'gnus-summary-kill-same-subject-and-select + "K" #'gnus-summary-kill-same-subject + + "P" (define-keymap :prefix 'gnus-uu-mark-map + "p" #'gnus-summary-mark-as-processable + "u" #'gnus-summary-unmark-as-processable + "U" #'gnus-summary-unmark-all-processable + "v" #'gnus-uu-mark-over + "s" #'gnus-uu-mark-series + "r" #'gnus-uu-mark-region + "g" #'gnus-uu-unmark-region + "R" #'gnus-uu-mark-by-regexp + "G" #'gnus-uu-unmark-by-regexp + "t" #'gnus-uu-mark-thread + "T" #'gnus-uu-unmark-thread + "a" #'gnus-uu-mark-all + "b" #'gnus-uu-mark-buffer + "S" #'gnus-uu-mark-sparse + "k" #'gnus-summary-kill-process-mark + "y" #'gnus-summary-yank-process-mark + "w" #'gnus-summary-save-process-mark + "i" #'gnus-uu-invert-processable) + + "V" (define-keymap :prefix 'gnus-summary-mscore-map + "c" #'gnus-summary-clear-above + "u" #'gnus-summary-tick-above + "m" #'gnus-summary-mark-above + "k" #'gnus-summary-kill-below)) + + "/" (define-keymap :prefix 'gnus-summary-limit-map + "/" #'gnus-summary-limit-to-subject + "n" #'gnus-summary-limit-to-articles + "b" #'gnus-summary-limit-to-bodies + "h" #'gnus-summary-limit-to-headers + "w" #'gnus-summary-pop-limit + "s" #'gnus-summary-limit-to-subject + "a" #'gnus-summary-limit-to-author + "u" #'gnus-summary-limit-to-unread + "m" #'gnus-summary-limit-to-marks + "M" #'gnus-summary-limit-exclude-marks + "v" #'gnus-summary-limit-to-score + "*" #'gnus-summary-limit-include-cached + "D" #'gnus-summary-limit-include-dormant + "T" #'gnus-summary-limit-include-thread + "d" #'gnus-summary-limit-exclude-dormant + "t" #'gnus-summary-limit-to-age + "." #'gnus-summary-limit-to-unseen + "x" #'gnus-summary-limit-to-extra + "p" #'gnus-summary-limit-to-display-predicate + "E" #'gnus-summary-limit-include-expunged + "c" #'gnus-summary-limit-exclude-childless-dormant + "C" #'gnus-summary-limit-mark-excluded-as-read + "o" #'gnus-summary-insert-old-articles + "N" #'gnus-summary-insert-new-articles + "S" #'gnus-summary-limit-to-singletons + "r" #'gnus-summary-limit-to-replied + "R" #'gnus-summary-limit-to-recipient + "A" #'gnus-summary-limit-to-address) + + "G" (define-keymap :prefix 'gnus-summary-goto-map + "n" #'gnus-summary-next-unread-article + "p" #'gnus-summary-prev-unread-article + "N" #'gnus-summary-next-article + "P" #'gnus-summary-prev-article + "\C-n" #'gnus-summary-next-same-subject + "\C-p" #'gnus-summary-prev-same-subject + "\M-n" #'gnus-summary-next-unread-subject + "\M-p" #'gnus-summary-prev-unread-subject + "f" #'gnus-summary-first-unread-article + "b" #'gnus-summary-best-unread-article + "u" #'gnus-summary-next-unseen-article + "U" #'gnus-summary-prev-unseen-article + "j" #'gnus-summary-goto-article + "g" #'gnus-summary-goto-subject + "l" #'gnus-summary-goto-last-article + "o" #'gnus-summary-pop-article) + + "T" (define-keymap :prefix 'gnus-summary-thread-map + "k" #'gnus-summary-kill-thread + "E" #'gnus-summary-expire-thread + "l" #'gnus-summary-lower-thread + "i" #'gnus-summary-raise-thread + "T" #'gnus-summary-toggle-threads + "t" #'gnus-summary-rethread-current + "^" #'gnus-summary-reparent-thread + "\M-^" #'gnus-summary-reparent-children + "s" #'gnus-summary-show-thread + "S" #'gnus-summary-show-all-threads + "h" #'gnus-summary-hide-thread + "H" #'gnus-summary-hide-all-threads + "n" #'gnus-summary-next-thread + "p" #'gnus-summary-prev-thread + "u" #'gnus-summary-up-thread + "o" #'gnus-summary-top-thread + "d" #'gnus-summary-down-thread + "#" #'gnus-uu-mark-thread + "\M-#" #'gnus-uu-unmark-thread) + + "Y" (define-keymap :prefix 'gnus-summary-buffer-map + "g" #'gnus-summary-prepare + "c" #'gnus-summary-insert-cached-articles + "d" #'gnus-summary-insert-dormant-articles + "t" #'gnus-summary-insert-ticked-articles) + + "Z" (define-keymap :prefix 'gnus-summary-exit-map + "c" #'gnus-summary-catchup-and-exit + "C" #'gnus-summary-catchup-all-and-exit + "E" #'gnus-summary-exit-no-update + "Q" #'gnus-summary-exit + "Z" #'gnus-summary-exit + "n" #'gnus-summary-catchup-and-goto-next-group + "p" #'gnus-summary-catchup-and-goto-prev-group + "R" #'gnus-summary-reselect-current-group + "G" #'gnus-summary-rescan-group + "N" #'gnus-summary-next-group + "s" #'gnus-summary-save-newsrc + "P" #'gnus-summary-prev-group) + + "A" (define-keymap :prefix 'gnus-summary-article-map + " " #'gnus-summary-next-page + "n" #'gnus-summary-next-page + [?\S-\ ] #'gnus-summary-prev-page + "\177" #'gnus-summary-prev-page + [delete] #'gnus-summary-prev-page + "p" #'gnus-summary-prev-page + "\r" #'gnus-summary-scroll-up + "\M-\r" #'gnus-summary-scroll-down + "<" #'gnus-summary-beginning-of-article + ">" #'gnus-summary-end-of-article + "b" #'gnus-summary-beginning-of-article + "e" #'gnus-summary-end-of-article + "^" #'gnus-summary-refer-parent-article + "r" #'gnus-summary-refer-parent-article + "C" #'gnus-summary-show-complete-article + "D" #'gnus-summary-enter-digest-group + "R" #'gnus-summary-refer-references + "T" #'gnus-summary-refer-thread + "W" #'gnus-warp-to-article + "g" #'gnus-summary-show-article + "s" #'gnus-summary-isearch-article + "\t" #'gnus-summary-button-forward + [backtab] #'gnus-summary-button-backward + "w" #'gnus-summary-browse-url + "P" #'gnus-summary-print-article + "S" #'gnus-sticky-article + "M" #'gnus-mailing-list-insinuate + "t" #'gnus-article-babel) + + "W" (define-keymap :prefix 'gnus-summary-wash-map + "b" #'gnus-article-add-buttons + "B" #'gnus-article-add-buttons-to-head + "o" #'gnus-article-treat-overstrike + "e" #'gnus-article-emphasize + "w" #'gnus-article-fill-cited-article + "Q" #'gnus-article-fill-long-lines + "L" #'gnus-article-toggle-truncate-lines + "C" #'gnus-article-capitalize-sentences + "c" #'gnus-article-remove-cr + "q" #'gnus-article-de-quoted-unreadable + "6" #'gnus-article-de-base64-unreadable + "Z" #'gnus-article-decode-HZ + "A" #'gnus-article-treat-ansi-sequences + "h" #'gnus-article-wash-html + "u" #'gnus-article-unsplit-urls + "s" #'gnus-summary-force-verify-and-decrypt + "f" #'gnus-article-display-x-face + "l" #'gnus-summary-stop-page-breaking + "r" #'gnus-summary-caesar-message + "m" #'gnus-summary-morse-message + "t" #'gnus-summary-toggle-header + "g" #'gnus-treat-smiley + "v" #'gnus-summary-verbose-headers + "a" #'gnus-article-strip-headers-in-body ;; mnemonic: wash archive + "p" #'gnus-article-verify-x-pgp-sig + "d" #'gnus-article-treat-smartquotes + "U" #'gnus-article-treat-non-ascii + "i" #'gnus-summary-idna-message + + "Y" (define-keymap :prefix 'gnus-summary-wash-deuglify-map + ;; mnemonic: deuglif*Y* + "u" #'gnus-article-outlook-unwrap-lines + "a" #'gnus-article-outlook-repair-attribution + "c" #'gnus-article-outlook-rearrange-citation + ;; mnemonic: full deuglify + "f" #'gnus-article-outlook-deuglify-article) + + "W" (define-keymap :prefix 'gnus-summary-wash-hide-map + "a" #'gnus-article-hide + "h" #'gnus-article-hide-headers + "b" #'gnus-article-hide-boring-headers + "s" #'gnus-article-hide-signature + "c" #'gnus-article-hide-citation + "C" #'gnus-article-hide-citation-in-followups + "l" #'gnus-article-hide-list-identifiers + "B" #'gnus-article-strip-banner + "P" #'gnus-article-hide-pem + "\C-c" #'gnus-article-hide-citation-maybe) + + "H" (define-keymap :prefix 'gnus-summary-wash-highlight-map + "a" #'gnus-article-highlight + "h" #'gnus-article-highlight-headers + "c" #'gnus-article-highlight-citation + "s" #'gnus-article-highlight-signature) + + "G" (define-keymap :prefix 'gnus-summary-wash-header-map + "f" #'gnus-article-treat-fold-headers + "u" #'gnus-article-treat-unfold-headers + "n" #'gnus-article-treat-fold-newsgroups) + + "D" (define-keymap :prefix 'gnus-summary-wash-display-map + "x" #'gnus-article-display-x-face + "d" #'gnus-article-display-face + "s" #'gnus-treat-smiley + "e" #'gnus-article-emojize-symbols + "D" #'gnus-article-remove-images + "W" #'gnus-article-show-images + "F" #'gnus-article-toggle-fonts + "f" #'gnus-treat-from-picon + "m" #'gnus-treat-mail-picon + "n" #'gnus-treat-newsgroups-picon + "g" #'gnus-treat-from-gravatar + "h" #'gnus-treat-mail-gravatar) + + "M" (define-keymap :prefix 'gnus-summary-wash-mime-map + "w" #'gnus-article-decode-mime-words + "c" #'gnus-article-decode-charset + "h" #'gnus-mime-buttonize-attachments-in-header + "v" #'gnus-mime-view-all-parts + "b" #'gnus-article-view-part) + + "T" (define-keymap :prefix 'gnus-summary-wash-time-map + "z" #'gnus-article-date-ut + "u" #'gnus-article-date-ut + "l" #'gnus-article-date-local + "p" #'gnus-article-date-english + "e" #'gnus-article-date-lapsed + "o" #'gnus-article-date-original + "i" #'gnus-article-date-iso8601 + "s" #'gnus-article-date-user) + + "E" (define-keymap :prefix 'gnus-summary-wash-empty-map + "t" #'gnus-article-remove-trailing-blank-lines + "l" #'gnus-article-strip-leading-blank-lines + "m" #'gnus-article-strip-multiple-blank-lines + "a" #'gnus-article-strip-blank-lines + "A" #'gnus-article-strip-all-blank-lines + "s" #'gnus-article-strip-leading-space + "e" #'gnus-article-strip-trailing-space + "w" #'gnus-article-remove-leading-whitespace)) + + "H" (define-keymap :prefix 'gnus-summary-help-map + "v" #'gnus-version + "d" #'gnus-summary-describe-group + "h" #'gnus-summary-describe-briefly + "i" #'gnus-info-find-node) + + "B" (define-keymap :prefix 'gnus-summary-backend-map + "e" #'gnus-summary-expire-articles + "\M-\C-e" #'gnus-summary-expire-articles-now + "\177" #'gnus-summary-delete-article + [delete] #'gnus-summary-delete-article + [backspace] #'gnus-summary-delete-article + "m" #'gnus-summary-move-article + "r" #'gnus-summary-respool-article + "w" #'gnus-summary-edit-article + "c" #'gnus-summary-copy-article + "B" #'gnus-summary-crosspost-article + "q" #'gnus-summary-respool-query + "t" #'gnus-summary-respool-trace + "i" #'gnus-summary-import-article + "I" #'gnus-summary-create-article + "p" #'gnus-summary-article-posted-p) + + "O" (define-keymap :prefix 'gnus-summary-save-map + "o" #'gnus-summary-save-article + "m" #'gnus-summary-save-article-mail + "F" #'gnus-summary-write-article-file + "r" #'gnus-summary-save-article-rmail + "f" #'gnus-summary-save-article-file + "b" #'gnus-summary-save-article-body-file + "B" #'gnus-summary-write-article-body-file + "h" #'gnus-summary-save-article-folder + "v" #'gnus-summary-save-article-vm + "p" #'gnus-summary-pipe-output + "P" #'gnus-summary-muttprint) + + "K" (define-keymap :prefix 'gnus-summary-mime-map + "b" #'gnus-summary-display-buttonized + "m" #'gnus-summary-repair-multipart + "v" #'gnus-article-view-part + "o" #'gnus-article-save-part + "O" #'gnus-article-save-part-and-strip + "r" #'gnus-article-replace-part + "d" #'gnus-article-delete-part + "t" #'gnus-article-view-part-as-type + "j" #'gnus-article-jump-to-part + "c" #'gnus-article-copy-part + "C" #'gnus-article-view-part-as-charset + "e" #'gnus-article-view-part-externally + "H" #'gnus-article-browse-html-article + "E" #'gnus-article-encrypt-body + "i" #'gnus-article-inline-part + "|" #'gnus-article-pipe-part) + + "X" (define-keymap :prefix 'gnus-uu-extract-map + ;;"x" gnus-uu-extract-any + "m" #'gnus-summary-save-parts + "u" #'gnus-uu-decode-uu + "U" #'gnus-uu-decode-uu-and-save + "s" #'gnus-uu-decode-unshar + "S" #'gnus-uu-decode-unshar-and-save + "o" #'gnus-uu-decode-save + "O" #'gnus-uu-decode-save + "b" #'gnus-uu-decode-binhex + "B" #'gnus-uu-decode-binhex + "Y" #'gnus-uu-decode-yenc + "p" #'gnus-uu-decode-postscript + "P" #'gnus-uu-decode-postscript-and-save + + "v" (define-keymap :prefix 'gnus-uu-extract-view-map + "u" #'gnus-uu-decode-uu-view + "U" #'gnus-uu-decode-uu-and-save-view + "s" #'gnus-uu-decode-unshar-view + "S" #'gnus-uu-decode-unshar-and-save-view + "o" #'gnus-uu-decode-save-view + "O" #'gnus-uu-decode-save-view + "b" #'gnus-uu-decode-binhex-view + "B" #'gnus-uu-decode-binhex-view + "p" #'gnus-uu-decode-postscript-view + "P" #'gnus-uu-decode-postscript-and-save-view))) (defvar gnus-article-post-menu nil) @@ -2561,6 +2559,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Unfold headers" gnus-article-treat-unfold-headers t] ["Fold newsgroups" gnus-article-treat-fold-newsgroups t] ["Html" gnus-article-wash-html t] + ["Toggle HTML fonts" gnus-article-toggle-fonts t] ["Unsplit URLs" gnus-article-unsplit-urls t] ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] ["Decode HZ" gnus-article-decode-HZ t] @@ -3144,8 +3143,9 @@ You can also post articles and send mail from this buffer. To follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author of an article, type `\\[gnus-summary-reply]'. -There are approx. one gazillion commands you can execute in this -buffer; read the Info manual for more information (`\\[gnus-info-find-node]'). +There are approximately one gazillion commands you can execute in +this buffer; read the Info manual for more +information (`\\[gnus-info-find-node]'). The following commands are available: @@ -4355,7 +4355,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." result)) (defun gnus-sort-gathered-threads (threads) - "Sort subthreads inside each gathered thread by `gnus-sort-gathered-threads-function'." + "Sort subthreads inside each gathered thread. +Sorting is done by `gnus-sort-gathered-threads-function'." (let ((result threads)) (while threads (when (stringp (caar threads)) @@ -5171,7 +5172,7 @@ Unscored articles will be counted as having a score of zero." (gnus-article-sort-by-number h1 h2)) (defun gnus-thread-sort-by-most-recent-number (h1 h2) - "Sort threads such that the thread with the most recently arrived article comes first." + "Sort threads such that the thread with most recently arrived article is first." (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2))) (defun gnus-thread-highest-number (thread) @@ -5185,7 +5186,7 @@ Unscored articles will be counted as having a score of zero." (gnus-article-sort-by-date h1 h2)) (defun gnus-thread-sort-by-most-recent-date (h1 h2) - "Sort threads such that the thread with the most recently dated article comes first." + "Sort threads such that the thread with most recently dated article is first." (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2))) (defsubst gnus-article-sort-by-newsgroups (h1 h2) @@ -5649,7 +5650,7 @@ or a straight list of headers." gnus-list-identifiers))) (defun gnus-summary-remove-list-identifiers () - "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." + "Remove identifiers in `gnus-list-identifiers' from articles in current group." (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) changed subject) (when regexp @@ -6841,7 +6842,7 @@ Also do horizontal recentering." (defun gnus-forward-line-ignore-invisible (n) "Move N lines forward (backward if N is negative). -Like forward-line, but skip over (and don't count) invisible lines." +Like `forward-line', but skip over (and don't count) invisible lines." (let (done) (while (and (> n 0) (not done)) ;; If the following character is currently invisible, @@ -8064,9 +8065,7 @@ Return nil if there are no unread articles." Return nil if there are no unread articles." (interactive nil gnus-summary-mode) (prog1 - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t)) + (gnus-summary--goto-and-possibly-unhide t) (gnus-summary-position-point))) (defun gnus-summary-next-unseen-article (&optional backward) @@ -8100,23 +8099,27 @@ Return nil if there are no unread articles." Return nil if there are no unseen articles." (interactive nil gnus-summary-mode) (prog1 - (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) + (gnus-summary--goto-and-possibly-unhide) (gnus-summary-position-point))) +(defun gnus-summary--goto-and-possibly-unhide (&optional unread undownloaded + unseen) + (let ((first (gnus-summary-first-subject unread undownloaded unseen))) + (if (and first + (not (= first (gnus-summary-article-number)))) + (progn + (gnus-summary-show-thread) + (gnus-summary-first-subject unread undownloaded unseen)) + first))) + (defun gnus-summary-first-unseen-or-unread-subject () "Place the point on the subject line of the first unseen and unread article. If all articles have been seen, on the subject line of the first unread article." (interactive nil gnus-summary-mode) (prog1 - (unless (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t))) + (unless (gnus-summary--goto-and-possibly-unhide nil nil t) + (gnus-summary-first-subject t)) (gnus-summary-position-point))) (defun gnus-summary-first-article () @@ -8587,9 +8590,8 @@ If UNREPLIED (the prefix), limit to unreplied articles." (interactive "P" gnus-summary-mode) (if unreplied (gnus-summary-limit - (seq-difference gnus-newsgroup-articles - gnus-newsgroup-replied - #'eq)) + (gnus-set-difference gnus-newsgroup-articles + gnus-newsgroup-replied)) (gnus-summary-limit gnus-newsgroup-replied)) (gnus-summary-position-point)) @@ -9191,7 +9193,7 @@ specified by the `gnus-refer-thread-limit' variable." (interactive "sMessage-ID: " gnus-summary-mode) (when (and (stringp message-id) (not (zerop (length message-id)))) - (setq message-id (replace-regexp-in-string " " "" message-id)) + (setq message-id (string-replace " " "" message-id)) ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. (unless (string-match "^<" message-id) @@ -9199,7 +9201,7 @@ specified by the `gnus-refer-thread-limit' variable." (unless (string-match ">$" message-id) (setq message-id (concat message-id ">"))) ;; People often post MIDs from URLs, so unhex it: - (unless (string-match "@" message-id) + (unless (string-search "@" message-id) (setq message-id (gnus-url-unhex-string message-id))) (let* ((header (gnus-id-to-header message-id)) (sparse (and header @@ -9837,11 +9839,11 @@ article currently." "Force redisplaying of the current article. If ARG (the prefix) is a number, show the article with the charset defined in `gnus-summary-show-article-charset-alist', or the charset -input. +input.\\<gnus-summary-mode-map> If ARG (the prefix) is non-nil and not a number, show the article, but without running any of the article treatment functions -article. Normally, the keystroke is `C-u g'. When using `C-u -C-u g', show the raw article." +article. Normally, the keystroke is `\\[universal-argument] \\[gnus-summary-show-article]'. When using `\\[universal-argument] +\\[universal-argument] \\[gnus-summary-show-article]', show the raw article." (interactive "P" gnus-summary-mode) (cond ((numberp arg) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 568fbbcafb1..e78dd1542c8 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." @@ -1046,63 +1056,56 @@ articles in the topic and its subtopics." ;;; Topic mode, commands and keymap. -(defvar gnus-topic-mode-map nil) -(defvar gnus-group-topic-map nil) - -(unless gnus-topic-mode-map - (setq gnus-topic-mode-map (make-sparse-keymap)) - +(defvar-keymap gnus-topic-mode-map ;; Override certain group mode keys. - (gnus-define-keys gnus-topic-mode-map - "=" gnus-topic-select-group - "\r" gnus-topic-select-group - " " gnus-topic-read-group - "\C-c\C-x" gnus-topic-expire-articles - "c" gnus-topic-catchup-articles - "\C-k" gnus-topic-kill-group - "\C-y" gnus-topic-yank-group - "\M-g" gnus-topic-get-new-news-this-topic - "AT" gnus-topic-list-active - "Gp" gnus-topic-edit-parameters - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - [tab] gnus-topic-indent - [(meta tab)] gnus-topic-unindent - "\C-i" gnus-topic-indent - "\M-\C-i" gnus-topic-unindent - [mouse-2] gnus-mouse-pick-topic) - - ;; Define a new submap. - (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map) - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - "n" gnus-topic-create-topic - "m" gnus-topic-move-group - "D" gnus-topic-remove-group - "c" gnus-topic-copy-group - "h" gnus-topic-hide-topic - "s" gnus-topic-show-topic - "j" gnus-topic-jump-to-topic - "M" gnus-topic-move-matching - "C" gnus-topic-copy-matching - "\M-p" gnus-topic-goto-previous-topic - "\M-n" gnus-topic-goto-next-topic - "\C-i" gnus-topic-indent - [tab] gnus-topic-indent - "r" gnus-topic-rename - "\177" gnus-topic-delete - [delete] gnus-topic-delete - "H" gnus-topic-toggle-display-empty-topics) - - (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map) - "s" gnus-topic-sort-groups - "a" gnus-topic-sort-groups-by-alphabet - "u" gnus-topic-sort-groups-by-unread - "l" gnus-topic-sort-groups-by-level - "e" gnus-topic-sort-groups-by-server - "v" gnus-topic-sort-groups-by-score - "r" gnus-topic-sort-groups-by-rank - "m" gnus-topic-sort-groups-by-method)) + "=" #'gnus-topic-select-group + "\r" #'gnus-topic-select-group + " " #'gnus-topic-read-group + "\C-c\C-x" #'gnus-topic-expire-articles + "c" #'gnus-topic-catchup-articles + "\C-k" #'gnus-topic-kill-group + "\C-y" #'gnus-topic-yank-group + "\M-g" #'gnus-topic-get-new-news-this-topic + "AT" #'gnus-topic-list-active + "Gp" #'gnus-topic-edit-parameters + "#" #'gnus-topic-mark-topic + "\M-#" #'gnus-topic-unmark-topic + [tab] #'gnus-topic-indent + [(meta tab)] #'gnus-topic-unindent + "\C-i" #'gnus-topic-indent + "\M-\C-i" #'gnus-topic-unindent + [mouse-2] #'gnus-mouse-pick-topic + + "T" (define-keymap :prefix 'gnus-group-topic-map + "#" #'gnus-topic-mark-topic + "\M-#" #'gnus-topic-unmark-topic + "n" #'gnus-topic-create-topic + "m" #'gnus-topic-move-group + "D" #'gnus-topic-remove-group + "c" #'gnus-topic-copy-group + "h" #'gnus-topic-hide-topic + "s" #'gnus-topic-show-topic + "j" #'gnus-topic-jump-to-topic + "M" #'gnus-topic-move-matching + "C" #'gnus-topic-copy-matching + "\M-p" #'gnus-topic-goto-previous-topic + "\M-n" #'gnus-topic-goto-next-topic + "\C-i" #'gnus-topic-indent + [tab] #'gnus-topic-indent + "r" #'gnus-topic-rename + "\177" #'gnus-topic-delete + [delete] #'gnus-topic-delete + "H" #'gnus-topic-toggle-display-empty-topics + + "S" (define-keymap :prefix 'gnus-topic-sort-map + "s" #'gnus-topic-sort-groups + "a" #'gnus-topic-sort-groups-by-alphabet + "u" #'gnus-topic-sort-groups-by-unread + "l" #'gnus-topic-sort-groups-by-level + "e" #'gnus-topic-sort-groups-by-server + "v" #'gnus-topic-sort-groups-by-score + "r" #'gnus-topic-sort-groups-by-rank + "m" #'gnus-topic-sort-groups-by-method))) (defun gnus-topic-make-menu-bar () (unless (boundp 'gnus-topic-menu) diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index 64ed2bbad6b..0717a7ccfba 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -75,15 +75,12 @@ ;;; Minor mode definition. -(defvar gnus-undo-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "\M-\C-_" gnus-undo - "\C-_" gnus-undo - "\C-xu" gnus-undo - ;; many people are used to type `C-/' on X terminals and get `C-_'. - [(control /)] gnus-undo) - map)) +(defvar-keymap gnus-undo-mode-map + "\M-\C-_" #'gnus-undo + "\C-_" #'gnus-undo + "\C-xu" #'gnus-undo + ;; many people are used to type `C-/' on GUI frames and get `C-_'. + [(control /)] #'gnus-undo) (defun gnus-undo-make-menu-bar () ;; This is disabled for the time being. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index be0284515dc..a777157f894 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -154,7 +154,7 @@ is slower." (and (string-match "(.+)" from) (setq name (substring from (1+ (match-beginning 0)) (1- (match-end 0))))) - (and (string-match "()" from) + (and (string-search "()" from) (setq name address)) ;; XOVER might not support folded From headers. (and (string-match "(.*" from) @@ -265,7 +265,7 @@ If END is non-nil, use the end of the span instead." (defun gnus-newsgroup-directory-form (newsgroup) "Make hierarchical directory name from NEWSGROUP name." (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup)) - (idx (string-match ":" newsgroup))) + (idx (string-search ":" newsgroup))) (concat (if idx (substring newsgroup 0 idx)) (if idx "/") @@ -300,25 +300,26 @@ Symbols are also allowed; their print names are used instead." (defmacro gnus-local-set-keys (&rest plist) "Set the keys in PLIST in the current keymap." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 (current-local-map) ',plist)) (defmacro gnus-define-keys (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 ,(if (symbolp keymap) keymap `',keymap) (quote ,plist))) (defmacro gnus-define-keys-safe (keymap &rest plist) "Define all keys in PLIST in KEYMAP without overwriting previous definitions." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) (defmacro gnus-define-keymap (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 ,keymap (quote ,plist))) (defun gnus-define-keys-1 (keymap plist &optional safe) + (declare (obsolete define-keymap "29.1")) (when (null keymap) (error "Can't set keys in a null keymap")) (cond ((symbolp keymap) (error "First arg should be a keymap object")) @@ -408,7 +409,7 @@ Cache the result as a text property stored in DATE." (defun gnus-mode-string-quote (string) "Quote all \"%\"'s in STRING." - (replace-regexp-in-string "%" "%%" string)) + (string-replace "%" "%%" string)) (defsubst gnus-make-hashtable (&optional size) "Make a hash table of SIZE, testing on `equal'." @@ -533,7 +534,7 @@ ARGS are passed to `message'." (defun gnus-extract-references (references) "Return a list of Message-IDs in REFERENCES (in In-Reply-To - format), trimmed to only contain the Message-IDs." +format), trimmed to only contain the Message-IDs." (let ((ids (gnus-split-references references)) refs) (dolist (id ids) @@ -1310,9 +1311,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', initial-input history def) "Call `gnus-completing-read-function'." (funcall gnus-completing-read-function - (concat prompt (when def - (concat " (default " def ")")) - ": ") + (format-prompt prompt def) collection require-match initial-input history def)) (defun gnus-emacs-completing-read (prompt collection &optional require-match @@ -1528,8 +1527,8 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp (t emacs-version)))) (defun gnus-rename-file (old-path new-path &optional trim) - "Rename OLD-PATH as NEW-PATH. If TRIM, recursively delete -empty directories from OLD-PATH." + "Rename OLD-PATH as NEW-PATH. +If TRIM, recursively delete empty directories from OLD-PATH." (when (file-exists-p old-path) (let* ((old-dir (file-name-directory old-path)) ;; (old-name (file-name-nondirectory old-path)) @@ -1549,7 +1548,7 @@ empty directories from OLD-PATH." (concat old-dir ".."))))))))) (defun gnus-set-file-modes (filename mode &optional flag) - "Wrapper for set-file-modes." + "Wrapper for `set-file-modes'." (ignore-errors (set-file-modes filename mode flag))) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index ceb2ebcdcb1..778a8a3ea03 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -354,12 +354,12 @@ didn't work, and overwrite existing files. Otherwise, ask each time." ;; Commands. (defun gnus-uu-decode-uu (&optional n) - "Uudecodes the current article." + "Uudecode the current article." (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-uustrip-article n)) (defun gnus-uu-decode-uu-and-save (n dir) - "Decodes and saves the resulting file." + "Decode and save the resulting file." (interactive (list current-prefix-arg (file-name-as-directory @@ -370,12 +370,12 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-decode-with-method #'gnus-uu-uustrip-article n dir nil nil t)) (defun gnus-uu-decode-unshar (&optional n) - "Unshars the current article." + "Unshar the current article." (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-unshar-article n nil nil 'scan t)) (defun gnus-uu-decode-unshar-and-save (n dir) - "Unshars and saves the current article." + "Unshar and save the current article." (interactive (list current-prefix-arg (file-name-as-directory @@ -386,7 +386,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-decode-with-method #'gnus-uu-unshar-article n dir nil 'scan t)) (defun gnus-uu-decode-save (n file) - "Saves the current article." + "Save the current article." (interactive (list current-prefix-arg (if gnus-uu-save-separate-articles @@ -399,7 +399,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-decode-with-method #'gnus-uu-save-article n nil t)) (defun gnus-uu-decode-binhex (n dir) - "Unbinhexes the current article." + "Unbinhex the current article." (interactive (list current-prefix-arg (file-name-as-directory @@ -425,13 +425,13 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-decode-with-method #'gnus-uu-yenc-article n dir nil t)) (defun gnus-uu-decode-uu-view (&optional n) - "Uudecodes and views the current article." + "Uudecode and view the current article." (interactive "P" gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu n))) (defun gnus-uu-decode-uu-and-save-view (n dir) - "Decodes, views and saves the resulting file." + "Decode, view and save the resulting file." (interactive (list current-prefix-arg (read-file-name "Uudecode, view and save in dir: " @@ -442,13 +442,13 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-decode-uu-and-save n dir))) (defun gnus-uu-decode-unshar-view (&optional n) - "Unshars and views the current article." + "Unshar and view the current article." (interactive "P" gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-unshar n))) (defun gnus-uu-decode-unshar-and-save-view (n dir) - "Unshars and saves the current article." + "Unshar and save the current article." (interactive (list current-prefix-arg (read-file-name "Unshar, view and save in dir: " @@ -459,7 +459,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-decode-unshar-and-save n dir))) (defun gnus-uu-decode-save-view (n file) - "Saves and views the current article." + "Save and view the current article." (interactive (list current-prefix-arg (if gnus-uu-save-separate-articles @@ -472,7 +472,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-decode-save n file))) (defun gnus-uu-decode-binhex-view (n file) - "Unbinhexes and views the current article." + "Unbinhex and view the current article." (interactive (list current-prefix-arg (read-file-name "Unbinhex, view and save in dir: " @@ -488,7 +488,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." ;; Digest and forward articles (defun gnus-uu-digest-mail-forward (&optional n post) - "Digests and forwards all articles in this series." + "Digest and forward all articles in this series." (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-initialize) (let ((gnus-uu-save-in-digest t) @@ -579,7 +579,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-new-processable (unmarkp articles) (if unmarkp (nreverse (seq-intersection gnus-newsgroup-processable articles #'eq)) - (seq-difference articles gnus-newsgroup-processable #'eq))) + (gnus-set-difference articles gnus-newsgroup-processable))) (defun gnus-uu-mark-by-regexp (regexp &optional unmark) "Set the process mark on articles whose subjects match REGEXP. @@ -643,7 +643,7 @@ When called interactively, prompt for REGEXP." (gnus-uu-mark-region (point-min) (point-max) t)) (defun gnus-uu-mark-thread () - "Marks all articles downwards in this thread." + "Mark all articles downwards in this thread." (interactive nil gnus-article-mode gnus-summary-mode) (gnus-save-hidden-threads (let ((level (gnus-summary-thread-level))) @@ -654,7 +654,7 @@ When called interactively, prompt for REGEXP." (gnus-summary-position-point)) (defun gnus-uu-unmark-thread () - "Unmarks all articles downwards in this thread." + "Unmark all articles downwards in this thread." (interactive nil gnus-article-mode gnus-summary-mode) (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-remove-process-mark @@ -747,7 +747,7 @@ When called interactively, prompt for REGEXP." (gnus-uu-decode-postscript n))) (defun gnus-uu-decode-postscript-and-save (n dir) - "Extracts PostScript and saves the current article." + "Extract PostScript and save the current article." (interactive (list current-prefix-arg (file-name-as-directory (read-directory-name "Save in dir: " @@ -758,7 +758,7 @@ When called interactively, prompt for REGEXP." n dir nil nil t)) (defun gnus-uu-decode-postscript-and-save-view (n dir) - "Decodes, views and saves the resulting file." + "Decode, view and save the resulting file." (interactive (list current-prefix-arg (read-file-name "Where do you want to save the file(s)? " gnus-uu-default-dir @@ -1434,7 +1434,7 @@ When called interactively, prompt for REGEXP." "View FILE using the gnus-uu methods." (let ((action (gnus-uu-get-action file))) (gnus-execute-command - (if (string-match "%" action) + (if (string-search "%" action) (format action file) (concat action " " file)) (eq gnus-view-pseudos 'not-confirm)))) @@ -1606,7 +1606,7 @@ Gnus might fail to display all of it.") gnus-uu-unshar-warning)) (goto-char (point-min)) (display-buffer buffer) - (yes-or-no-p "This is a shell archive, unshar it? ")) + (yes-or-no-p "This is a shell archive, unshar it?")) (kill-buffer buffer)) (setq state (list 'error)))))) (unless (memq 'error state) @@ -1925,7 +1925,7 @@ is t." (gnus-uu-post-insert-binary))))) (defun gnus-uu-post-insert-binary-in-article () - "Inserts an encoded file in the buffer. + "Insert an encoded file in the buffer. The user will be asked for a file name." (interactive) (save-excursion diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 7dde799a5b8..9b3181fd4d0 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -525,25 +525,26 @@ be set in `.emacs' instead." ;; Summary mode faces. -(defface gnus-summary-selected '((t (:underline t))) +(defface gnus-summary-selected '((t (:underline t :extend t))) "Face used for selected articles." :group 'gnus-summary) (defface gnus-summary-cancelled '((((class color)) - (:foreground "yellow" :background "black"))) + (:foreground "yellow" :background "black" :extend t)) + (t (:extend t))) "Face used for canceled articles." :group 'gnus-summary) (defface gnus-summary-normal-ticked '((((class color) (background dark)) - (:foreground "pink")) + (:foreground "pink" :extend t)) (((class color) (background light)) - (:foreground "firebrick")) + (:foreground "firebrick" :extend t)) (t - ())) + (:extend t))) "Face used for normal interest ticked articles." :group 'gnus-summary) @@ -560,12 +561,12 @@ be set in `.emacs' instead." (defface gnus-summary-normal-ancient '((((class color) (background dark)) - (:foreground "SkyBlue")) + (:foreground "SkyBlue" :extend t)) (((class color) (background light)) - (:foreground "RoyalBlue")) + (:foreground "RoyalBlue" :extend t)) (t - ())) + (:extend t))) "Face used for normal interest ancient articles." :group 'gnus-summary) @@ -582,10 +583,10 @@ be set in `.emacs' instead." (defface gnus-summary-normal-undownloaded '((((class color) (background light)) - (:foreground "cyan4" :bold nil)) + (:foreground "cyan4" :bold nil :extend t)) (((class color) (background dark)) - (:foreground "LightGray" :bold nil)) - (t (:inverse-video t))) + (:foreground "LightGray" :bold nil :extend t)) + (t (:inverse-video t :extend t))) "Face used for normal interest uncached articles." :group 'gnus-summary) @@ -601,7 +602,7 @@ be set in `.emacs' instead." (defface gnus-summary-normal-unread '((t - ())) + (:extend t))) "Face used for normal interest unread articles." :group 'gnus-summary) @@ -618,12 +619,12 @@ be set in `.emacs' instead." (defface gnus-summary-normal-read '((((class color) (background dark)) - (:foreground "PaleGreen")) + (:foreground "PaleGreen" :extend t)) (((class color) (background light)) - (:foreground "DarkGreen")) + (:foreground "DarkGreen" :extend t)) (t - ())) + (:extend t))) "Face used for normal interest read articles." :group 'gnus-summary) @@ -797,7 +798,7 @@ be used directly.") (goto-char (point-min)) t))) (insert - (format " + " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -816,7 +817,7 @@ be used directly.") _ __ -")) +") ;; And then hack it. (gnus-indent-rigidly (point-min) (point-max) (/ (max (- (window-width) (or x 46)) 0) 2)) @@ -1113,7 +1114,7 @@ that case, just return a fully prefixed name of the group -- (defcustom gnus-secondary-servers nil "List of NNTP servers that the user can choose between interactively. To make Gnus query you for a server, you have to give `gnus' a -non-numeric prefix - `C-u M-x gnus', in short." +non-numeric prefix - `\\[universal-argument] \\[gnus]', in short." :group 'gnus-server :type '(repeat string)) (make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1") @@ -2139,8 +2140,9 @@ instance, to switch off all visual things except menus, you can say: Valid elements include `summary-highlight', `group-highlight', `article-highlight', `mouse-face', `summary-menu', `group-menu', -`article-menu', `tree-highlight', `menu', `highlight', `browse-menu', -`server-menu', `page-marker', `tree-menu', `binary-menu', and`pick-menu'." +`article-menu', `tree-highlight', `menu', `highlight', +`browse-menu', `server-menu', `page-marker', `tree-menu', +`binary-menu', and `pick-menu'." :group 'gnus-meta :group 'gnus-visual :type '(set (const summary-highlight) @@ -2215,7 +2217,7 @@ covered by that variable." (defcustom gnus-agent t "Whether we want to use the Gnus agent or not. -You may customize gnus-agent to disable its use. However, some +You may customize `gnus-agent' to disable its use. However, some back ends have started to use the agent as a client-side cache. Disabling the agent may result in noticeable loss of performance." :version "22.1" @@ -2535,7 +2537,7 @@ are always t.") ;; Only used in gnus-util, which has an autoload. ("rmailsum" rmail-update-summary) ("gnus-xmas" gnus-xmas-splash) - ("score-mode" :interactive t gnus-score-mode) + ("score-mode" :interactive t gnus-score-mode gnus-score-edit-all-score) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder) @@ -2607,7 +2609,11 @@ are always t.") gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view gnus-uu-unmark-thread - gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable) + gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable + gnus-uu-decode-postscript-and-save-view + gnus-uu-decode-postscript-view gnus-uu-decode-postscript-and-save + gnus-uu-decode-yenc gnus-uu-unmark-by-regexp gnus-uu-unmark-region + gnus-uu-decode-postscript) ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) gnus-article-mail gnus-copy-article-buffer gnus-extended-version) @@ -2654,6 +2660,7 @@ are always t.") gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-remove-cr gnus-article-remove-trailing-blank-lines + gnus-article-emojize-symbols gnus-article-display-x-face gnus-article-de-quoted-unreadable gnus-article-de-base64-unreadable gnus-article-decode-HZ @@ -2665,7 +2672,34 @@ are always t.") gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done gnus-article-decode-encoded-words gnus-start-date-timer gnus-stop-date-timer - gnus-mime-view-all-parts) + gnus-mime-view-all-parts gnus-article-pipe-part + gnus-article-inline-part gnus-article-encrypt-body + gnus-article-browse-html-article gnus-article-view-part-externally + gnus-article-view-part-as-charset gnus-article-copy-part + gnus-article-jump-to-part gnus-article-view-part-as-type + gnus-article-delete-part gnus-article-replace-part + gnus-article-save-part-and-strip gnus-article-save-part + gnus-article-remove-leading-whitespace gnus-article-strip-trailing-space + gnus-article-strip-leading-space gnus-article-strip-all-blank-lines + gnus-article-strip-blank-lines gnus-article-strip-multiple-blank-lines + gnus-article-date-user gnus-article-date-iso8601 + gnus-article-date-english gnus-article-date-ut + gnus-article-decode-charset gnus-article-decode-mime-words + gnus-article-toggle-fonts gnus-article-show-images + gnus-article-remove-images gnus-article-display-face + gnus-article-treat-fold-newsgroups gnus-article-treat-unfold-headers + gnus-article-treat-fold-headers gnus-article-highlight-signature + gnus-article-highlight-headers gnus-article-highlight + gnus-article-strip-banner gnus-article-hide-list-identifiers + gnus-article-hide gnus-article-outlook-rearrange-citation + gnus-article-treat-non-ascii gnus-article-treat-smartquotes + gnus-article-verify-x-pgp-sig gnus-article-strip-headers-in-body + gnus-treat-smiley gnus-article-treat-ansi-sequences + gnus-article-capitalize-sentences gnus-article-toggle-truncate-lines + gnus-article-fill-long-lines gnus-article-emphasize + gnus-article-add-buttons-to-head gnus-article-add-button + gnus-article-babel gnus-sticky-article gnus-article-view-part + gnus-article-add-buttons) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch @@ -3525,7 +3559,7 @@ You should probably use `gnus-find-method-for-group' instead." (defun gnus-group-native-p (group) "Say whether the group is native or not." - (not (string-match ":" group))) + (not (string-search ":" group))) (defun gnus-group-secondary-p (group) "Say whether the group is secondary or not." @@ -3741,17 +3775,19 @@ just the host name." ;; Separate foreign select method from group name and collapse. ;; If method contains a server, collapse to non-domain server name, ;; otherwise collapse to select method. - (let* ((colon (string-match ":" group)) + (let* ((colon (string-search ":" group)) (server (and colon (substring group 0 colon))) - (plus (and server (string-match "\\+" server)))) + (plus (and server (string-search "+" server)))) (when server (if plus (setq foreign (substring server (+ 1 plus) - (string-match "\\." server)) + (string-search "." server)) group (substring group (+ 1 colon))) (setq foreign server group (substring group (+ 1 colon)))) (setq foreign (concat foreign ":"))) + ;; Remove braces from name (common in IMAP groups). + (setq group (replace-regexp-in-string "[][]+" "" group)) ;; Collapse group name leaving LEVELS uncollapsed elements (let* ((slist (split-string group "/")) (slen (length slist)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 9baf09b0268..77e8fcdfd16 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -48,6 +48,8 @@ (require 'puny) (require 'rmc) ; read-multiple-choice (require 'subr-x) +(require 'yank-media) +(require 'mailcap) (autoload 'mailclient-send-it "mailclient") @@ -2395,6 +2397,8 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." (save-excursion ;; add to the end of the region first, otherwise end would be invalid (goto-char end) + (unless (bolp) + (insert "\n")) (insert (if verbatim "#v-\n" message-mark-insert-end)) (goto-char beg) (insert (if verbatim "#v+\n" message-mark-insert-begin)))) @@ -2868,84 +2872,78 @@ Consider adding this function to `message-header-setup-hook'" ;;; Set up keymap. -(defvar message-mode-map nil) - -(unless message-mode-map - (setq message-mode-map (make-keymap)) - (set-keymap-parent message-mode-map text-mode-map) - (define-key message-mode-map "\C-c?" #'describe-mode) - - (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to) - (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from) - (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc) - (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc) - (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc) - (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to) - (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups) - (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution) - (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to) - (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to) - (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords) - (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary) - (define-key message-mode-map "\C-c\C-f\C-i" - #'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\C-f\C-a" - #'message-generate-unsubscribed-mail-followup-to) +(defvar-keymap message-mode-map + :full t :parent text-mode-map + :doc "Message Mode keymap." + "\C-c?" #'describe-mode + + "\C-c\C-f\C-t" #'message-goto-to + "\C-c\C-f\C-o" #'message-goto-from + "\C-c\C-f\C-b" #'message-goto-bcc + "\C-c\C-f\C-w" #'message-goto-fcc + "\C-c\C-f\C-c" #'message-goto-cc + "\C-c\C-f\C-s" #'message-goto-subject + "\C-c\C-f\C-r" #'message-goto-reply-to + "\C-c\C-f\C-n" #'message-goto-newsgroups + "\C-c\C-f\C-d" #'message-goto-distribution + "\C-c\C-f\C-f" #'message-goto-followup-to + "\C-c\C-f\C-m" #'message-goto-mail-followup-to + "\C-c\C-f\C-k" #'message-goto-keywords + "\C-c\C-f\C-u" #'message-goto-summary + "\C-c\C-f\C-i" #'message-insert-or-toggle-importance + "\C-c\C-f\C-a" #'message-generate-unsubscribed-mail-followup-to ;; modify headers (and insert notes in body) - (define-key message-mode-map "\C-c\C-fs" #'message-change-subject) + "\C-c\C-fs" #'message-change-subject ;; - (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to) + "\C-c\C-fx" #'message-cross-post-followup-to ;; prefix+message-cross-post-followup-to = same w/o cross-post - (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc) - (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header) + "\C-c\C-ft" #'message-reduce-to-to-cc + "\C-c\C-fa" #'message-add-archive-header ;; mark inserted text - (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region) - (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file) - - (define-key message-mode-map "\C-c\C-b" #'message-goto-body) - (define-key message-mode-map "\C-c\C-i" #'message-goto-signature) - - (define-key message-mode-map "\C-c\C-t" #'message-insert-to) - (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply) - (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups) - (define-key message-mode-map "\C-c\C-l" #'message-to-list-only) - (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires) - - (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\M-n" - #'message-insert-disposition-notification-to) - - (define-key message-mode-map "\C-c\C-y" #'message-yank-original) - (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer) - (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" #'message-insert-signature) - (define-key message-mode-map "\C-c\M-h" #'message-insert-headers) - (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" #'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer) - - (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit) - (define-key message-mode-map "\C-c\C-s" #'message-send) - (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer) - (define-key message-mode-map "\C-c\C-d" #'message-dont-send) - (define-key message-mode-map "\C-c\n" #'gnus-delay-article) - - (define-key message-mode-map "\C-c\M-k" #'message-kill-address) - (define-key message-mode-map "\C-c\C-e" #'message-elide-region) - (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region) - (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature) - (define-key message-mode-map "\M-\r" #'message-newline-and-reformat) - (define-key message-mode-map [remap split-line] #'message-split-line) - - (define-key message-mode-map "\C-c\C-a" #'mml-attach-file) - (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot) - - (define-key message-mode-map "\C-a" #'message-beginning-of-line) - (define-key message-mode-map "\t" #'message-tab) - - (define-key message-mode-map "\M-n" #'message-display-abbrev)) + "\C-c\M-m" #'message-mark-inserted-region + "\C-c\M-f" #'message-mark-insert-file + + "\C-c\C-b" #'message-goto-body + "\C-c\C-i" #'message-goto-signature + + "\C-c\C-t" #'message-insert-to + "\C-c\C-fw" #'message-insert-wide-reply + "\C-c\C-n" #'message-insert-newsgroups + "\C-c\C-l" #'message-to-list-only + "\C-c\C-f\C-e" #'message-insert-expires + "\C-c\C-u" #'message-insert-or-toggle-importance + "\C-c\M-n" #'message-insert-disposition-notification-to + + "\C-c\C-y" #'message-yank-original + "\C-c\M-\C-y" #'message-yank-buffer + "\C-c\C-q" #'message-fill-yanked-message + "\C-c\C-w" #'message-insert-signature + "\C-c\M-h" #'message-insert-headers + "\C-c\C-r" #'message-caesar-buffer-body + "\C-c\C-o" #'message-sort-headers + "\C-c\M-r" #'message-rename-buffer + + "\C-c\C-c" #'message-send-and-exit + "\C-c\C-s" #'message-send + "\C-c\C-k" #'message-kill-buffer + "\C-c\C-d" #'message-dont-send + "\C-c\n" #'gnus-delay-article + + "\C-c\M-k" #'message-kill-address + "\C-c\C-e" #'message-elide-region + "\C-c\C-v" #'message-delete-not-region + "\C-c\C-z" #'message-kill-to-signature + "\M-\r" #'message-newline-and-reformat + [remap split-line] #'message-split-line + + "\C-c\C-a" #'mml-attach-file + "\C-c\C-p" #'message-insert-screenshot + + "\C-a" #'message-beginning-of-line + "\t" #'message-tab + + "\M-n" #'message-display-abbrev) (easy-menu-define message-mode-menu message-mode-map "Message Menu." @@ -3159,6 +3157,7 @@ Like `text-mode', but with these additional commands: (setq-local message-checksum nil) (setq-local message-mime-part 0) (message-setup-fill-variables) + (yank-media-handler "image/.*" #'message--yank-media-image-handler) (when message-fill-column (setq fill-column message-fill-column) (turn-on-auto-fill)) @@ -3572,8 +3571,18 @@ Prefix arg means justify as well." (when (looking-at message-cite-prefix-regexp) (setq quoted (match-string 0)) (goto-char (match-end 0)) - (looking-at "[ \t]*") - (setq leading-space (match-string 0))) + (let ((after (point))) + ;; This is a line with no text after the cite prefix. In that + ;; case, the trailing space is commonly not present, so look + ;; around for other lines that have some data. + (when (looking-at-p "\n") + (let ((regexp (concat "^" message-cite-prefix-regexp "[ \t]"))) + (when (or (re-search-backward regexp nil t) + (re-search-forward regexp nil t)) + (goto-char (1- (match-end 0)))))) + (looking-at "[ \t]*") + (setq leading-space (match-string 0)) + (goto-char after))) (if (and quoted (not not-break) (not bolp) @@ -3590,7 +3599,7 @@ Prefix arg means justify as well." (equal quoted (match-string 0))) (goto-char (match-end 0)) (looking-at "[ \t]*") - (when (< (length leading-space) (length (match-string 0))) + (when (> (length leading-space) (length (match-string 0))) (setq leading-space (match-string 0))) (forward-line 1)) (setq end (point)) @@ -3841,7 +3850,7 @@ text was killed." "Caesar rotate all letters in the current buffer by 13 places. Used to encode/decode possibly offensive messages (commonly in rec.humor). With prefix arg, specifies the number of places to rotate each letter forward. -Mail and USENET news headers are not rotated unless WIDE is non-nil." +Mail and Usenet news headers are not rotated unless WIDE is non-nil." (interactive (if current-prefix-arg (list (prefix-numeric-value current-prefix-arg)) (list nil)) @@ -5340,13 +5349,13 @@ Otherwise, generate and save a value for `canlock-password' first." (followup-to (message-fetch-field "followup-to")) to) (when (and newsgroups - (string-match "," newsgroups) + (string-search "," newsgroups) (not followup-to) (not (zerop (length (setq to (completing-read - "Followups to (default no Followup-To header): " + (format-prompt "Followups to" "no Followup-To header") (mapcar #'list (cons "poster" (message-tokenize-header @@ -5357,7 +5366,7 @@ Otherwise, generate and save a value for `canlock-password' first." ;; Check "Shoot me". (message-check 'shoot (if (re-search-forward - "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t) + "Message-ID.*.mail-host-address-is-not-set" nil t) (y-or-n-p "You appear to have a misconfigured system. Really post? ") t)) ;; Check for Approved. @@ -5371,11 +5380,11 @@ Otherwise, generate and save a value for `canlock-password' first." (message-id (message-fetch-field "message-id" t))) (or (not message-id) ;; Is there an @ in the ID? - (and (string-match "@" message-id) + (and (string-search "@" message-id) ;; Is there a dot in the ID? (string-match "@[^.]*\\." message-id) ;; Does the ID end with a dot? - (not (string-match "\\.>" message-id))) + (not (string-search ".>" message-id))) (y-or-n-p (format "The Message-ID looks strange: \"%s\". Really post? " message-id))))) @@ -5497,8 +5506,8 @@ Otherwise, generate and save a value for `canlock-password' first." "@[^\\.]*\\." (setq ad (nth 1 (mail-extract-address-components from))))) ;larsi@ifi - (string-match "\\.\\." ad) ;larsi@ifi..uio - (string-match "@\\." ad) ;larsi@.ifi.uio + (string-search ".." ad) ;larsi@ifi..uio + (string-search "@." ad) ;larsi@.ifi.uio (string-match "\\.$" ad) ;larsi@ifi.uio. (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio (string-match "(.*).*(.*)" from)) ;(lars) (lars) @@ -5523,7 +5532,7 @@ Otherwise, generate and save a value for `canlock-password' first." (cond ((not reply-to) t) - ((string-match "," reply-to) + ((string-search "," reply-to) (y-or-n-p (format "Multiple Reply-To addresses: \"%s\". Really post? " reply-to))) @@ -5531,8 +5540,8 @@ Otherwise, generate and save a value for `canlock-password' first." "@[^\\.]*\\." (setq ad (nth 1 (mail-extract-address-components reply-to))))) ;larsi@ifi - (string-match "\\.\\." ad) ;larsi@ifi..uio - (string-match "@\\." ad) ;larsi@.ifi.uio + (string-search ".." ad) ;larsi@ifi..uio + (string-search "@." ad) ;larsi@.ifi.uio (string-match "\\.$" ad) ;larsi@ifi.uio. (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars) @@ -5806,7 +5815,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (mail-header-subject message-reply-headers)) (message-strip-subject-re psubject)))) (and psupersedes - (string-match "_-_@" psupersedes))) + (string-search "_-_@" psupersedes))) "_-_" "")) "@" (message-make-fqdn) ">")) @@ -6022,7 +6031,7 @@ give as trustworthy answer as possible." "Return the pertinent part of `user-mail-address'." (when (and user-mail-address (string-match "@.*\\." user-mail-address)) - (if (string-match " " user-mail-address) + (if (string-search " " user-mail-address) (nth 1 (mail-extract-address-components user-mail-address)) user-mail-address))) @@ -6053,7 +6062,7 @@ give as trustworthy answer as possible." message-user-fqdn) ;; A system name without any dots is unlikely to be a good fully ;; qualified domain name. - ((and (string-match "[.]" sysname) + ((and (string-search "." sysname) (not (string-match message-bogus-system-names sysname))) ;; `system-name' returned the right result. sysname) @@ -6068,8 +6077,7 @@ give as trustworthy answer as possible." user-domain) ;; Default to this bogus thing. (t - (concat sysname - ".i-did-not-set--mail-host-address--so-tickle-me"))))) + (concat sysname ".mail-host-address-is-not-set"))))) (defun message-make-domain () "Return the domain name." @@ -7054,7 +7062,7 @@ article, it has the value of " mft " -which directs your response to " (if (string-match "," mft) +which directs your response to " (if (string-search "," mft) "the specified addresses" "that address only") ". @@ -7358,7 +7366,7 @@ want to get rid of this query permanently.")) You should normally obey the Followup-To: header. `Followup-To: " followup-to "' -directs your response to " (if (string-match "," followup-to) +directs your response to " (if (string-search "," followup-to) "the specified newsgroups" "that newsgroup only") ". @@ -8600,7 +8608,7 @@ From headers in the original article." (let ((value (message-field-value header))) (dolist (string (mail-header-parse-addresses value 'raw)) (setq string - (replace-regexp-in-string + (string-replace "\n" "" (replace-regexp-in-string "^ +\\| +$" "" string))) (ecomplete-add-item 'mail (car (mail-header-parse-address string)) @@ -8868,29 +8876,34 @@ used to take the screenshot." (car message-screenshot-command) nil (current-buffer) nil (cdr message-screenshot-command)) (buffer-string)))) - (set-mark (point)) - (insert-image - (create-image image 'png t - :max-width (truncate (* (frame-pixel-width) 0.8)) - :max-height (truncate (* (frame-pixel-height) 0.8)) - :scale 1) - (format "<#part type=\"image/png\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>" - ;; Get a base64 version of the image -- this avoids later - ;; complications if we're auto-saving the buffer and - ;; restoring from a file. - (with-temp-buffer - (set-buffer-multibyte nil) - (insert image) - (base64-encode-region (point-min) (point-max) t) - (buffer-string)))) - (insert "\n\n") + (message--yank-media-image-handler 'image/png image) (message ""))) +(defun message--yank-media-image-handler (type image) + (set-mark (point)) + (insert-image + (create-image image (mailcap-mime-type-to-extension type) t + :max-width (truncate (* (frame-pixel-width) 0.8)) + :max-height (truncate (* (frame-pixel-height) 0.8)) + :scale 1) + (format "<#part type=\"%s\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>" + type + ;; Get a base64 version of the image -- this avoids later + ;; complications if we're auto-saving the buffer and + ;; restoring from a file. + (with-temp-buffer + (set-buffer-multibyte nil) + (insert image) + (base64-encode-region (point-min) (point-max) t) + (buffer-string))) + nil nil t) + (insert "\n\n")) + (declare-function gnus-url-unhex-string "gnus-util") (defun message-parse-mailto-url (url) "Parse a mailto: url." - (setq url (replace-regexp-in-string "\n" " " url)) + (setq url (string-replace "\n" " " url)) (when (string-match "mailto:/*\\(.*\\)" url) (setq url (substring url (match-beginning 1) nil))) (setq url (if (string-match "^\\?" url) @@ -8932,9 +8945,9 @@ will then start up Emacs ready to compose mail. For emacsclient use (dolist (arg args) (unless (equal (car arg) "body") (message-position-on-field (capitalize (car arg))) - (insert (replace-regexp-in-string + (insert (string-replace "\r\n" "\n" - (mapconcat #'identity (reverse (cdr arg)) ", ") nil t)))) + (mapconcat #'identity (reverse (cdr arg)) ", "))))) (when (assoc "body" args) (message-goto-body) (dolist (body (cdr (assoc "body" args))) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 02cd6af0c98..aca4bf2062d 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -649,7 +649,7 @@ MIME-Version header before proceeding." (setq description (mail-decode-encoded-word-string description))))) (if (or (not ctl) - (not (string-match "/" (car ctl)))) + (not (string-search "/" (car ctl)))) (mm-dissect-singlepart (list mm-dissect-default-type) (and cte (intern (downcase (mail-header-strip-cte cte)))) @@ -1676,8 +1676,7 @@ If RECURSIVE, search recursively." ((eq mm-decrypt-option 'never) nil) ((eq mm-decrypt-option 'always) t) ((eq mm-decrypt-option 'known) t) - (t (y-or-n-p - (format "Decrypt (S/MIME) part? ")))) + (t (y-or-n-p "Decrypt (S/MIME) part? "))) (mm-view-pkcs7 parts from)) (goto-char (point-min)) ;; The encrypted document is a MIME part, and may use either diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 9d4c4bfead7..a52613a092c 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -145,6 +145,14 @@ This can be either \"inline\" or \"attachment\".") ,#'mm-uu-pgp-key-extract ,#'mm-uu-gpg-key-skip-to-last nil) + (markdown-emacs-sources + "^```\\(?:elisp\\|emacs-lisp\\|\n(\\)" + "^```$" + ,#'mm-uu-emacs-sources-extract) + (markdown-diff ;; this should be higher than `git-format-patch' + "^```\\(?:diff\\|patch\\|\ndiff --git \\)" + "^```$" + ,#'mm-uu-diff-extract) (emacs-sources "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--" "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here" @@ -511,7 +519,7 @@ apply the face `mm-uu-extract'." (list (mm-make-handle buf mm-uu-text-plain-type))))) (defun mm-uu-pgp-signed-extract () - (let ((mm-security-handle (list (format "multipart/signed")))) + (let ((mm-security-handle (list (substring "multipart/signed")))) (mm-set-handle-multipart-parameter mm-security-handle 'protocol "application/x-gnus-pgp-signature") (save-restriction @@ -579,7 +587,7 @@ apply the face `mm-uu-extract'." (list (mm-make-handle buf '("application/pgp-encrypted"))))))) (defun mm-uu-pgp-encrypted-extract () - (let ((mm-security-handle (list (format "multipart/encrypted")))) + (let ((mm-security-handle (list (substring "multipart/encrypted")))) (mm-set-handle-multipart-parameter mm-security-handle 'protocol "application/x-gnus-pgp-encrypted") (save-restriction diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 2ec75a0bc59..d2a6d2cf5d3 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -50,9 +50,7 @@ (w3m . mm-inline-text-html-render-with-w3m) (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone) (gnus-w3m . gnus-article-html) - (links mm-inline-render-with-file - mm-links-remove-leading-blank - "links" "-dump" file) + (links . mm-inline-render-with-links) (lynx mm-inline-render-with-stdin nil "lynx" "-dump" "-force_html" "-stdin" "-nolist") (html2text mm-inline-render-with-function html2text)) @@ -264,6 +262,7 @@ This is only used if `mm-inline-large-images' is set to (mm-inline-render-with-stdin handle nil "w3m" "-dump" "-T" "text/html"))) (defun mm-links-remove-leading-blank () + (declare (obsolete nil "28.1")) ;; Delete the annoying three spaces preceding each line of links ;; output. (goto-char (point-min)) @@ -271,15 +270,18 @@ This is only used if `mm-inline-large-images' is set to (delete-region (match-beginning 0) (match-end 0)))) (defun mm-inline-wash-with-file (post-func cmd &rest args) - (let ((file (make-temp-file - (expand-file-name "mm" mm-tmp-directory)))) - (let ((coding-system-for-write 'binary)) - (write-region (point-min) (point-max) file nil 'silent)) - (delete-region (point-min) (point-max)) - (unwind-protect - (apply #'call-process cmd nil t nil (mapcar (lambda (e) (eval e t)) args)) - (delete-file file)) - (and post-func (funcall post-func)))) + (declare (obsolete nil "28.1")) + (with-suppressed-warnings ((lexical file)) + (dlet ((file (make-temp-file + (expand-file-name "mm" mm-tmp-directory)))) + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) file nil 'silent)) + (delete-region (point-min) (point-max)) + (unwind-protect + (apply #'call-process cmd nil t nil + (mapcar (lambda (e) (eval e t)) args)) + (delete-file file)) + (and post-func (funcall post-func))))) (defun mm-inline-wash-with-stdin (post-func cmd &rest args) (let ((coding-system-for-write 'binary)) @@ -288,12 +290,41 @@ This is only used if `mm-inline-large-images' is set to (and post-func (funcall post-func))) (defun mm-inline-render-with-file (handle post-func cmd &rest args) + (declare (obsolete nil "28.1")) (let ((source (mm-get-part handle))) (mm-insert-inline handle (mm-with-unibyte-buffer (insert source) - (apply #'mm-inline-wash-with-file post-func cmd args) + (with-suppressed-warnings ((obsolete mm-inline-wash-with-file)) + (apply #'mm-inline-wash-with-file post-func cmd args)) + (buffer-string))))) + +(defun mm-inline-render-with-links (handle) + (let ((source (mm-get-part handle)) + file charset) + (mm-insert-inline + handle + (with-temp-buffer + (setq charset (mail-content-type-get (mm-handle-type handle) 'charset)) + (insert source) + (unwind-protect + (progn + (setq file (make-temp-file (expand-file-name + "mm" mm-tmp-directory))) + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) file nil 'silent)) + (delete-region (point-min) (point-max)) + (if charset + (with-environment-variables (("LANG" (format "en-US.%s" + charset))) + (call-process "links" nil t nil "-dump" file)) + (call-process "links" nil t nil "-dump" file)) + (goto-char (point-min)) + (while (re-search-forward "^ " nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (when (and file (file-exists-p file)) + (delete-file file))) (buffer-string))))) (defun mm-inline-render-with-stdin (handle post-func cmd &rest args) @@ -420,7 +451,7 @@ This is only used if `mm-inline-large-images' is set to (defvar mm-inline-message-prepare-function nil "Function called by `mm-inline-message' to do client specific setup. -It is called with one parameter -- the charset.") +It is called with two parameters -- the MIME handle and the charset.") (defun mm-inline-message (handle) "Insert HANDLE (a message/rfc822 part) into the current buffer. @@ -440,7 +471,7 @@ after inserting the part." (narrow-to-region b b) (mm-insert-part handle) (when mm-inline-message-prepare-function - (funcall mm-inline-message-prepare-function charset)) + (funcall mm-inline-message-prepare-function handle charset)) (goto-char (point-min)) (unless bolp (insert "\n")) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 15157e6fbc8..f72d76ac02b 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -238,7 +238,7 @@ You can also customize or set `mml-signencrypt-style-alist' instead." (goto-char (match-end 0)) (apply #'mml-insert-tag 'part (cons (if sign 'sign 'encrypt) (cons method tags)))) - (t (error "The message is corrupted. No mail header separator")))))) + (t (error "The message is corrupted. No mail header separator")))))) (defvar mml-secure-method (if (equal mml-default-encrypt-method mml-default-sign-method) @@ -328,7 +328,7 @@ either an error is raised or not." (unless (yes-or-no-p "Message for encryption contains Bcc header.\ This may give away all Bcc'ed identities to all recipients.\ Are you sure that this is safe?\ - (Customize `mml-secure-safe-bcc-list' to avoid this warning.) ") + (Customize `mml-secure-safe-bcc-list' to avoid this warning.)") (error "Aborted")))))))) ;; defuns that add the proper <#secure ...> tag to the top of the message body @@ -352,7 +352,7 @@ either an error is raised or not." (apply #'mml-insert-tag 'secure 'method method 'mode mode tags))) (t (error - "The message is corrupted. No mail header separator")))) + "The message is corrupted. No mail header separator")))) (when (eql insert-loc (point)) (forward-line 1)))) @@ -1022,7 +1022,7 @@ Returns non-nil if the user has chosen to use SENDER." (if (eq 'OpenPGP protocol) (epg-sign-string context (buffer-string) mode) (epg-sign-string context - (replace-regexp-in-string + (string-replace "\n" "\r\n" (buffer-string)) t)) mml-secure-secret-key-id-list nil) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 5c133e680af..b81dd2dae4c 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -314,7 +314,6 @@ Whether the passphrase is cached at all is controlled by (defvar epg-user-id-alist) (defvar epg-digest-algorithm-alist) -(defvar inhibit-redisplay) (defvar password-cache-expiry) (eval-when-compile @@ -369,9 +368,7 @@ Content-Disposition: attachment; filename=smime.p7s (goto-char (point-max))))) (defun mml-smime-epg-encrypt (cont) - (let* ((inhibit-redisplay t) ;FIXME: Why? - ;; (boundary (mml-compute-boundary cont)) - (cipher (mml-secure-epg-encrypt 'CMS cont))) + (let* ((cipher (mml-secure-epg-encrypt 'CMS cont))) (delete-region (point-min) (point-max)) (goto-char (point-min)) (insert "\ @@ -387,8 +384,7 @@ Content-Disposition: attachment; filename=smime.p7m (defun mml-smime-epg-verify (handle ctl) (catch 'error - (let ((inhibit-redisplay t) - context part signature) ;; plain signature-file + (let (context part signature) ;; plain signature-file (when (or (null (setq part (mm-find-raw-part-by-type ctl (or (mm-handle-multipart-ctl-parameter ctl 'protocol) @@ -404,7 +400,7 @@ Content-Disposition: attachment; filename=smime.p7m nil t))))) (mm-sec-error 'gnus-info "Corrupted") (throw 'error handle)) - (setq part (replace-regexp-in-string "\n" "\r\n" part) + (setq part (string-replace "\n" "\r\n" part) context (epg-make-context 'CMS)) (condition-case error ;; (setq plain diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 5f35e73cd7c..079c1b51225 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1409,6 +1409,13 @@ to specify options." :version "22.1" ;; Gnus 5.10.9 :group 'message) +(defcustom mml-attach-file-at-the-end nil + "If non-nil, \\[mml-attach-file] attaches files at the end of the message. +If nil, files are attached at point." + :type 'boolean + :version "29.1" + :group 'message) + ;;;###autoload (defun mml-attach-file (file &optional type description disposition) "Attach a file to the outgoing MIME message. @@ -1423,6 +1430,8 @@ specifies how the attachment is intended to be displayed. It can be either \"inline\" (displayed automatically within the message body) or \"attachment\" (separate from the body). +Also see the `mml-attach-file-at-the-end' variable. + If given a prefix interactively, no prompting will be done for the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults will be computed and used." @@ -1440,8 +1449,11 @@ will be computed and used." (mml-minibuffer-read-disposition type nil file)))) (list file type description disposition))) ;; If in the message header, attach at the end and leave point unchanged. - (let ((head (unless (message-in-body-p) (point)))) - (if head (goto-char (point-max))) + (let ((at-end (and (or (not (message-in-body-p)) + mml-attach-file-at-the-end) + (point)))) + (when at-end + (goto-char (point-max))) (mml-insert-empty-tag 'part 'type type ;; icicles redefines read-file-name and returns a @@ -1451,13 +1463,13 @@ will be computed and used." 'description description) ;; When using Mail mode, make sure it does the mime encoding ;; when you send the message. - (or (eq mail-user-agent 'message-user-agent) - (setq mail-encode-mml t)) - (when head + (unless (eq mail-user-agent 'message-user-agent) + (setq mail-encode-mml t)) + (when at-end (unless (pos-visible-in-window-p) (message "The file \"%s\" has been attached at the end of the message" (file-name-nondirectory file))) - (goto-char head)))) + (goto-char at-end)))) (defun mml-dnd-attach-file (uri _action) "Attach a drag and drop file. diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 05f44a1cbd8..55ef9cf7b37 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -259,8 +259,7 @@ Whether the passphrase is cached at all is controlled by (autoload 'epg-expand-group "epg-config") (defun mml1991-epg-sign (_cont) - (let ((inhibit-redisplay t) - headers cte) + (let (headers cte) ;; Don't sign headers. (goto-char (point-min)) (when (re-search-forward "^$" nil t) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 1af7d10d055..239738114b6 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -700,7 +700,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defvar epg-user-id-alist) (defvar epg-digest-algorithm-alist) (defvar epg-gpg-program) -(defvar inhibit-redisplay) (autoload 'epg-make-context "epg") (autoload 'epg-context-set-armor "epg") @@ -773,8 +772,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defun mml2015-epg-decrypt (handle _ctl) (catch 'error - (let ((inhibit-redisplay t) - context plain child handles) ;; decrypt-status result + (let (context plain child handles) ;; decrypt-status result (unless (setq child (mm-find-part-by-type (cdr handle) "application/octet-stream" nil t)) @@ -818,8 +816,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (list handles))))) (defun mml2015-epg-clear-decrypt () - (let ((inhibit-redisplay t) - (context (epg-make-context)) + (let ((context (epg-make-context)) plain) (if (or mml2015-cache-passphrase mml-secure-cache-passphrase) (epg-context-set-passphrase-callback @@ -851,8 +848,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defun mml2015-epg-verify (handle ctl) (catch 'error - (let ((inhibit-redisplay t) - context part signature) ;; plain signature-file + (let (context part signature) ;; plain signature-file (when (or (null (setq part (mm-find-raw-part-by-type ctl (or (mm-handle-multipart-ctl-parameter ctl 'protocol) @@ -863,7 +859,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." nil t)))) (mm-sec-error 'gnus-info "Corrupted") (throw 'error handle)) - (setq part (replace-regexp-in-string "\n" "\r\n" part) + (setq part (string-replace "\n" "\r\n" part) signature (mm-get-part signature) context (epg-make-context)) (condition-case error @@ -881,8 +877,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." handle))) (defun mml2015-epg-clear-verify () - (let ((inhibit-redisplay t) - (context (epg-make-context)) + (let ((context (epg-make-context)) (signature (encode-coding-string (buffer-string) coding-system-for-write)) plain) @@ -904,8 +899,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (mml2015-extract-cleartext-signature)))) (defun mml2015-epg-sign (cont) - (let ((inhibit-redisplay t) - (boundary (mml-compute-boundary cont))) + (let ((boundary (mml-compute-boundary cont))) ;; Signed data must end with a newline (RFC 3156, 5). (goto-char (point-max)) (unless (bolp) @@ -934,8 +928,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (goto-char (point-max))))) (defun mml2015-epg-encrypt (cont &optional sign) - (let* ((inhibit-redisplay t) - (boundary (mml-compute-boundary cont)) + (let* ((boundary (mml-compute-boundary cont)) (cipher (mml-secure-epg-encrypt 'OpenPGP cont sign))) (delete-region (point-min) (point-max)) (goto-char (point-min)) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index adf4427523f..133e0307a54 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -416,6 +416,11 @@ all. This may very well take some time.") (deffoo nndiary-open-server (server &optional defs) (nnoo-change-server 'nndiary server defs) + (dolist (header nndiary-headers) + (setq header (intern (format "X-Diary-%s" (car header)))) + ;; Required for building NOV databases and some other stuff. + (add-to-list 'gnus-extra-headers header) + (add-to-list 'nnmail-extra-headers header)) (when (not (file-exists-p nndiary-directory)) (ignore-errors (make-directory nndiary-directory t))) (cond @@ -1557,12 +1562,6 @@ all. This may very well take some time.") ;; The end... =============================================================== -(dolist (header nndiary-headers) - (setq header (intern (format "X-Diary-%s" (car header)))) - ;; Required for building NOV databases and some other stuff. - (add-to-list 'gnus-extra-headers header) - (add-to-list 'nnmail-extra-headers header)) - (unless (assoc "nndiary" gnus-valid-select-methods) (gnus-declare-backend "nndiary" 'post-mail 'respool 'address)) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 708887cb9c7..c35e89289a2 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -803,7 +803,7 @@ If FORMAT isn't a format string, it and all ARGS will be inserted without formatting." (with-current-buffer nntp-server-buffer (erase-buffer) - (if (string-match "%" format) + (if (string-search "%" format) (insert (apply #'format format args)) (apply #'insert format args)) t)) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 3e2a202a6cf..b7082696b2c 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -429,8 +429,18 @@ during splitting, which may be slow." now (nnimap-last-command-time nnimap-object)))) (with-local-quit - (ignore-errors ;E.g. "buffer foo has no process". - (nnimap-send-command "NOOP"))))))))) + (ignore-errors ;E.g. "buffer foo has no process". + (nnimap-send-command "NOOP")) + ;; If our connection has died in the meantime, clean it + ;; and its buffer up. + (unless (process-live-p (get-buffer-process buffer)) + (setq nnimap-process-buffers + (delq buffer nnimap-process-buffers)) + (setq nnimap-connection-alist + (seq-filter (lambda (elt) + (null (eq buffer (cdr elt)))) + nnimap-connection-alist)) + (kill-buffer buffer))))))))) (defun nnimap-open-connection (buffer) ;; Be backwards-compatible -- the earlier value of nnimap-stream was @@ -599,6 +609,13 @@ during splitting, which may be slow." (eq nnimap-authenticator 'anonymous) (eq nnimap-authenticator 'login))) (nnimap-command "LOGIN %S %S" user password)) + ((and (nnimap-capability "AUTH=XOAUTH2") + (eq nnimap-authenticator 'xoauth2)) + (nnimap-command "AUTHENTICATE XOAUTH2 %s" + (base64-encode-string + (format "user=%s\001auth=Bearer %s\001\001" + (nnimap-quote-specials user) + (nnimap-quote-specials password))))) ((and (nnimap-capability "AUTH=CRAM-MD5") (or (null nnimap-authenticator) (eq nnimap-authenticator 'cram-md5))) @@ -655,10 +672,17 @@ during splitting, which may be slow." (deffoo nnimap-close-server (&optional server defs) (when (nnoo-change-server 'nnimap server defs) - (ignore-errors - (delete-process (get-buffer-process (nnimap-buffer)))) - (nnoo-close-server 'nnimap server) - t)) + (let ((buf (nnimap-buffer))) + (ignore-errors + (delete-process (get-buffer-process buf))) + (setq nnimap-process-buffers + (delq buf nnimap-process-buffers) + nnimap-connection-alist + (seq-filter (lambda (elt) + (null (eq buf (cdr elt)))) + nnimap-connection-alist)) + (nnoo-close-server 'nnimap server) + t))) (deffoo nnimap-request-close () t) @@ -1292,7 +1316,7 @@ If LIMIT, first try to limit the search to the N last articles." (when (and (nnimap-greeting nnimap-object) (string-match greeting-match (nnimap-greeting nnimap-object)) (eq type 'append) - (string-match "\000" data)) + (string-search "\000" data)) (let ((choice (gnus-multiple-choice "Message contains NUL characters. Delete, continue, abort? " '((?d "Delete NUL characters") @@ -1631,15 +1655,13 @@ If LIMIT, first try to limit the search to the N last articles." (setq start-article 1)) (let* ((unread (gnus-compress-sequence - (seq-difference - (seq-difference + (gnus-set-difference + (gnus-set-difference existing (gnus-sorted-union (cdr (assoc '%Seen flags)) - (cdr (assoc '%Deleted flags))) - #'eq) - (cdr (assoc '%Flagged flags)) - #'eq))) + (cdr (assoc '%Deleted flags)))) + (cdr (assoc '%Flagged flags))))) (read (gnus-range-difference (cons start-article high) unread))) (when (> start-article 1) @@ -1754,7 +1776,7 @@ If LIMIT, first try to limit the search to the N last articles." (let ((result nil)) (dolist (elem (split-string irange ",")) (push - (if (string-match ":" elem) + (if (string-search ":" elem) (let ((numbers (split-string elem ":"))) (cons (string-to-number (car numbers)) (string-to-number (cadr numbers)))) @@ -1932,10 +1954,13 @@ Return the server's response to the SELECT or EXAMINE command." (when entry (if (and (buffer-live-p (cadr entry)) (get-buffer-process (cadr entry)) - (memq (process-status (get-buffer-process (cadr entry))) - '(open run))) + (process-live-p (get-buffer-process (cadr entry)))) (get-buffer-process (cadr entry)) - (setq nnimap-connection-alist (delq entry nnimap-connection-alist)) + (setq nnimap-connection-alist (delq entry nnimap-connection-alist) + nnimap-process-buffers + (delq (cadr entry) nnimap-process-buffers)) + (when (buffer-live-p (cadr entry)) + (kill-buffer (cadr entry))) nil)))) ;; Leave room for `open-network-stream' to issue a couple of IMAP @@ -2282,7 +2307,7 @@ Return the server's response to the SELECT or EXAMINE command." nnimap-incoming-split-list))) (defun nnimap-make-thread-query (header) - (let* ((id (mail-header-id header)) + (let* ((id (substring-no-properties (mail-header-id header))) (refs (split-string (or (mail-header-references header) ""))) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 4867455393a..690761a2d6c 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -87,7 +87,7 @@ See `nnmaildir-flag-mark-mapping'." (defun nnmaildir--ensure-suffix (filename) "Ensure that FILENAME contains the suffix \":2,\"." - (if (string-match-p ":2," filename) + (if (string-search ":2," filename) filename (concat filename ":2,"))) @@ -194,7 +194,15 @@ This variable is set by `nnmaildir-request-article'.") (article-file (concat curdir prefix suffix)) (new-name (concat curdir prefix new-suffix))) (unless (file-exists-p article-file) - (error "Couldn't find article file %s" article-file)) + (let ((possible (file-expand-wildcards (concat curdir prefix "*")))) + (cond ((length= possible 1) + (unless (string-match-p "\\`\\(.+\\):2,.*?\\'" (car possible)) + (error "Couldn't find updated article file %s" article-file)) + (setq article-file (car possible))) + ((length> possible 1) + (error "Couldn't determine exact article file %s" article-file)) + ((null possible) + (error "Couldn't find article file %s" article-file))))) (rename-file article-file new-name 'replace) (setf (nnmaildir--art-suffix article) new-suffix))) @@ -637,13 +645,11 @@ This variable is set by `nnmaildir-request-article'.") (funcall func (cdr entry))))))) (defun nnmaildir--system-name () - (replace-regexp-in-string + (string-replace ":" "\\072" - (replace-regexp-in-string + (string-replace "/" "\\057" - (replace-regexp-in-string "\\\\" "\\134" (system-name) nil 'literal) - nil 'literal) - nil 'literal)) + (string-replace "\\" "\\134" (system-name))))) (defun nnmaildir-request-type (_group &optional _article) 'mail) @@ -937,9 +943,9 @@ This variable is set by `nnmaildir-request-article'.") (setq pgname (nnmaildir--pgname nnmaildir--cur-server gname) ro (nnmaildir--param pgname 'read-only)) - (insert (replace-regexp-in-string + (insert (string-replace " " "\\ " - (nnmaildir--grp-name group) nil t) + (nnmaildir--grp-name group)) " ") (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) nntp-server-buffer) @@ -968,7 +974,7 @@ This variable is set by `nnmaildir-request-article'.") (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) nntp-server-buffer) (insert " " - (replace-regexp-in-string " " "\\ " gname nil t) + (string-replace " " "\\ " gname) "\n"))))) 'group) @@ -1098,7 +1104,7 @@ This variable is set by `nnmaildir-request-article'.") (insert " ") (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) nntp-server-buffer) - (insert " " (replace-regexp-in-string " " "\\ " gname nil t) "\n") + (insert " " (string-replace " " "\\ " gname) "\n") t)))) (defun nnmaildir-request-create-group (gname &optional server _args) @@ -1262,7 +1268,7 @@ This variable is set by `nnmaildir-request-article'.") (insert "\t" (nnmaildir--nov-get-beg nov) "\t" (nnmaildir--art-msgid article) "\t" (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir " - (replace-regexp-in-string " " "\\ " gname nil t) ":") + (string-replace " " "\\ " gname) ":") (princ num nntp-server-buffer) (insert "\t" (nnmaildir--nov-get-end nov) "\n")))) (catch 'return diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index c6aaf460ece..92944887f44 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -1629,7 +1629,7 @@ SERVER." (while (string-match "[<>]" mid) (setq mid (replace-match "" t t mid))) ;; mairix somehow does not like '$' in message-id - (when (string-match "\\$" mid) + (when (string-search "$" mid) (setq mid (concat mid "="))) (while (string-match "\\$" mid) (setq mid (replace-match "=," t t mid))) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index a40fa88631f..0ac57e9e171 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -715,7 +715,7 @@ Read the file and attempt to subscribe to each Feed in the file." (when (and xmlurl (not (string-match "\\`[\t ]*\\'" xmlurl)) (prog1 - (y-or-n-p (format "Subscribe to %s " xmlurl)) + (y-or-n-p (format "Subscribe to %s?" xmlurl)) (message ""))) (condition-case err (progn @@ -785,7 +785,7 @@ It is useful when `(setq nnrss-use-local t)'." (nnrss-node-just-text node) node)) (cleaned-text (if text - (replace-regexp-in-string + (string-replace "\r\n" "\n" (replace-regexp-in-string "^[\000-\037\177]+\\|^ +\\| +$" "" @@ -849,7 +849,7 @@ DATA should be the output of `xml-parse-region'." (defmacro nnrss-match-macro (base-uri item onsite-list offsite-list) `(cond ((or (string-match (concat "^" ,base-uri) ,item) - (not (string-match "://" ,item))) + (not (string-search "://" ,item))) (setq ,onsite-list (append ,onsite-list (list ,item)))) (t (setq ,offsite-list (append ,offsite-list (list ,item)))))) @@ -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/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 1fd2ed06eba..25289655bf2 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -331,9 +331,7 @@ retried once before actually displaying the error report." (when nntp-record-commands (nntp-record-command "*** CALLED nntp-report ***")) - (nnheader-report 'nntp args) - - (apply #'error args))) + (nnheader-report 'nntp args))) (defsubst nntp-copy-to-buffer (buffer start end) "Copy string from unibyte current buffer to multibyte buffer." @@ -1697,7 +1695,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the ;; article comes from that group, I'd say. ((and (setq newsgroups (mail-fetch-field "newsgroups")) - (not (string-match "," newsgroups))) + (not (string-search "," newsgroups))) newsgroups) ;; If there is more than one group in the ;; Newsgroups header, then the Xref header should @@ -1725,7 +1723,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the number (string-to-number (match-string 2 xref)))) ((and (setq newsgroups (mail-fetch-field "newsgroups")) - (not (string-match "," newsgroups))) + (not (string-search "," newsgroups))) (setq group newsgroups)) (group) (t (setq group "")))) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 03a0ff296f2..41a2da958a0 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -382,7 +382,10 @@ It is computed from the marks of individual component groups.") (defun nnvirtual-update-xref-header (group article prefix sysname) - "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines." + "Edit current NOV header to have xref to component group and correct prefix. +This function edits the current NOV header in current buffer so that it +has an xref to the component group, and also ensures any existing xref +lines have the correct component server prefix." ;; Move to beginning of Xref field, creating a slot if needed. (beginning-of-line) (looking-at @@ -569,7 +572,9 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." ;; unique reverse mapping. (defun nnvirtual-map-article (article) - "Return a cons of the component group and article corresponding to the given virtual ARTICLE." + "Return the component group and article corresponding to virtual ARTICLE. +Value is a cons of the component group and article corresponding to the given +virtual ARTICLE." (let ((table nnvirtual-mapping-table) entry group-pos) (while (and table @@ -590,7 +595,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." (defun nnvirtual-reverse-map-article (group article) - "Return the virtual article number corresponding to the given component GROUP and ARTICLE." + "Return virtual article number corresponding to component GROUP and ARTICLE." (when (numberp article) (let ((table nnvirtual-mapping-table) (group-pos 0) diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index a4234f84001..5fa280ea058 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -159,7 +159,7 @@ submitted at once. Internal variable.") rpt-host (concat "/" - (replace-regexp-in-string + (string-replace "/" ":" (replace-regexp-in-string "^.*article.gmane.org/" "" @@ -224,7 +224,7 @@ the function specified by `spam-report-url-ping-function'." (defcustom spam-report-user-mail-address (and (stringp user-mail-address) - (replace-regexp-in-string "@" "<at>" user-mail-address)) + (string-replace "@" "<at>" user-mail-address)) "Mail address of this user used for spam reports to Gmane. This is initialized based on `user-mail-address'." :type '(choice string diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 3f978918b9a..cfef69f1031 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -663,13 +663,13 @@ order for SpamAssassin to recognize the new registered spam." ;;; Key bindings for spam control. -(gnus-define-keys gnus-summary-mode-map - "St" spam-generic-score - "Sx" gnus-summary-mark-as-spam - "Mst" spam-generic-score - "Msx" gnus-summary-mark-as-spam - "\M-d" gnus-summary-mark-as-spam - "$" gnus-summary-mark-as-spam) +(define-keymap :keymap gnus-summary-mode-map + "St" #'spam-generic-score + "Sx" #'gnus-summary-mark-as-spam + "Mst" #'spam-generic-score + "Msx" #'gnus-summary-mark-as-spam + "\M-d" #'gnus-summary-mark-as-spam + "$" #'gnus-summary-mark-as-spam) (defvar spam-cache-lookups t "Whether spam.el will try to cache lookups using `spam-caches'.") @@ -710,8 +710,16 @@ finds ham or spam.") (defun spam-set-difference (list1 list2) "Return a set difference of LIST1 and LIST2. When either list is nil, the other is returned." - (declare (obsolete seq-difference "28.1")) - (seq-difference list1 list2 #'eq)) + (if (and list1 list2) + ;; we have two non-nil lists + (progn + (dolist (item (append list1 list2)) + (when (and (memq item list1) (memq item list2)) + (setq list1 (delq item list1)) + (setq list2 (delq item list2)))) + (append list1 list2)) + ;; if either of the lists was nil, return the other one + (if list1 list1 list2))) (defun spam-group-ham-mark-p (group mark &optional spam) "Checks if MARK is considered a ham mark in GROUP." @@ -1319,7 +1327,7 @@ In the case of mover backends, checks the setting of (new-articles (spam-list-articles gnus-newsgroup-articles classification)) - (changed-articles (seq-difference new-articles old-articles #'eq))) + (changed-articles (spam-set-difference new-articles old-articles))) ;; now that we have the changed articles, we go through the processors (dolist (backend (spam-backend-list)) (let (unregister-list) |