diff options
Diffstat (limited to 'lisp/gnus')
69 files changed, 2038 insertions, 1869 deletions
diff --git a/lisp/gnus/.dir-locals.el b/lisp/gnus/.dir-locals.el deleted file mode 100644 index fb968e13a36..00000000000 --- a/lisp/gnus/.dir-locals.el +++ /dev/null @@ -1,4 +0,0 @@ -((emacs-lisp-mode . ((show-trailing-whitespace . t)))) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index 08beef7db9f..e6c4630a67b 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -310,7 +310,7 @@ You can control what lines will be unwrapped by frobbing `gnus-outlook-deuglify-unwrap-min' and `gnus-outlook-deuglify-unwrap-max', indicating the minimum and maximum length of an unwrapped citation line. If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((case-fold-search nil) (inhibit-read-only t) (cite-marks gnus-outlook-deuglify-cite-marks) @@ -430,7 +430,7 @@ NODISPLAY is non-nil, don't redisplay the article buffer." (defun gnus-article-outlook-repair-attribution (&optional nodisplay) "Repair a broken attribution line. If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((attrib-start (or (gnus-outlook-repair-attribution-other) @@ -442,7 +442,7 @@ If NODISPLAY is non-nil, don't redisplay the article buffer." (defun gnus-article-outlook-rearrange-citation (&optional nodisplay) "Repair broken citations. If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((attrib-start (gnus-article-outlook-repair-attribution 'nodisplay))) ;; rearrange citations if an attribution line has been recognized (if attrib-start @@ -455,7 +455,7 @@ If NODISPLAY is non-nil, don't redisplay the article buffer." Treat \"smartquotes\", unwrap lines, repair attribution and rearrange citation. If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) ;; apply treatment of dumb quotes (gnus-article-treat-smartquotes) ;; repair wrapped cited lines @@ -467,7 +467,7 @@ article buffer." ;;;###autoload (defun gnus-article-outlook-deuglify-article () "Deuglify broken Outlook (Express) articles and redisplay." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-outlook-deuglify-article nil)) (provide 'deuglify) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7ded9e40e99..3c1403e1551 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -170,12 +170,17 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." "All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored." - :type '(choice - (repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) + :type `(choice + (repeat :value-to-internal + ,(lambda (_widget value) + ;; FIXME: Are we sure this can't be used without + ;; loading cus-edit? + (declare-function custom-split-regexp-maybe + "cus-edit" (regexp)) + (custom-split-regexp-maybe value)) + :match ,(lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) regexp) (const :tag "Use gnus-ignored-headers" nil) regexp) @@ -402,14 +407,14 @@ the entire emphasized word. The third is a number that says what regexp grouping should be displayed and highlighted. The fourth is the face used for highlighting." :type - '(repeat + `(repeat (menu-choice :format "%[Customizing Style%]\n%v" :indent 2 (group :tag "Default" :value ("" 0 0 default) :value-create - (lambda (widget) + ,(lambda (widget) (let ((value (widget-get (cadr (widget-get (widget-get widget :parent) :args)) @@ -728,9 +733,6 @@ Each element is a regular expression." :type '(repeat regexp) :group 'gnus-article-various) -(make-obsolete-variable 'gnus-article-hide-pgp-hook nil - "Gnus 5.10 (Emacs 22.1)") - (defface gnus-button '((t (:weight bold))) "Face used for highlighting a button in the article buffer." @@ -974,7 +976,7 @@ see http://www.cs.indiana.edu/picons/ftp/index.html" :version "22.1" :type '(repeat directory) :link '(url-link :tag "download" - "http://www.cs.indiana.edu/picons/ftp/index.html") + "http://www.cs.indiana.edu/picons/ftp/index.html") :link '(custom-manual "(gnus)Picons") :group 'gnus-picon) @@ -1264,9 +1266,6 @@ Any symbol is used to look up a regular expression to match the banner in `gnus-list-identifiers'. A string is used as a regular expression to match the identifier directly.") -(make-obsolete-variable 'gnus-treat-strip-pgp nil - "Gnus 5.10 (Emacs 22.1)") - (defcustom gnus-treat-strip-pem nil "Strip PEM signatures. Valid values are nil, t, `head', `first', `last', an integer or a @@ -1396,9 +1395,6 @@ predicate. See Info node `(gnus)Customizing Articles'." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(make-obsolete-variable 'gnus-treat-display-xface - 'gnus-treat-display-x-face "Emacs 22.1") - (defcustom gnus-treat-display-x-face (and (not noninteractive) (gnus-image-type-available-p 'xbm) @@ -1423,17 +1419,7 @@ See Info node `(gnus)Customizing Articles' and Info node symbol (cond ((or (boundp symbol) (get symbol 'saved-value)) value) - ((boundp 'gnus-treat-display-xface) - (message "\ -** gnus-treat-display-xface is an obsolete variable;\ - use gnus-treat-display-x-face instead") - (default-value 'gnus-treat-display-xface)) - ((get 'gnus-treat-display-xface 'saved-value) - (message "\ -** gnus-treat-display-xface is an obsolete variable;\ - use gnus-treat-display-x-face instead") - (eval (car (get 'gnus-treat-display-xface 'saved-value)) t)) - (t + (t value))))) (put 'gnus-treat-display-x-face 'highlight t) @@ -1823,7 +1809,7 @@ Initialized from `text-mode-syntax-table'.") (defun article-hide-headers (&optional _arg _delete) "Hide unwanted headers and possibly sort them as well." - (interactive) + (interactive nil gnus-article-mode) ;; This function might be inhibited. (unless gnus-inhibit-hiding (let ((inhibit-read-only t) @@ -1891,7 +1877,7 @@ Initialized from `text-mode-syntax-table'.") "Toggle hiding of headers that aren't very interesting. If given a negative prefix, always show; if given a positive prefix, always hide." - (interactive (gnus-article-hidden-arg)) + (interactive (gnus-article-hidden-arg) gnus-article-mode) (when (and (not (gnus-article-check-hidden-text 'boring-headers arg)) (not gnus-show-all-headers)) (save-excursion @@ -2050,7 +2036,7 @@ always hide." (defun article-normalize-headers () "Make all header lines 40 characters long." - (interactive) + (interactive nil gnus-article-mode) (let ((inhibit-read-only t) column) (save-excursion @@ -2086,7 +2072,7 @@ iso-8859-1 character map in an attempt to provide more quoting characters. If you see something like \\222 or \\264 where you're expecting some kind of apostrophe or quotation mark, then try this wash." - (interactive) + (interactive nil gnus-article-mode) (article-translate-strings gnus-article-smartquotes-map)) (define-obsolete-function-alias 'article-treat-dumbquotes #'article-treat-smartquotes "27.1") @@ -2095,7 +2081,7 @@ try this wash." (defun article-treat-non-ascii () "Translate many Unicode characters into their ASCII equivalents." - (interactive) + (interactive nil gnus-article-mode) (require 'org-entities) (let ((table (make-char-table nil))) (dolist (elem org-entities) @@ -2138,7 +2124,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (defun article-treat-overstrike () "Translate overstrikes into bold text." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (when (article-goto-body) (let ((inhibit-read-only t)) @@ -2166,7 +2152,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (defun article-treat-ansi-sequences () "Translate ANSI SGR control sequences into overlays or extents." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (when (article-goto-body) (require 'ansi-color) @@ -2178,7 +2164,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." "Unfold folded message headers. Only the headers that fit into the current window width will be unfolded." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (let (length) (while (not (eobp)) @@ -2204,7 +2190,7 @@ unfolded." (defun gnus-article-treat-fold-headers () "Fold message headers." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (while (not (eobp)) (save-restriction @@ -2214,7 +2200,7 @@ unfolded." (defun gnus-treat-smiley () "Toggle display of textual emoticons (\"smileys\") as small graphical icons." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (if (memq 'smiley gnus-article-wash-types) (gnus-delete-images 'smiley) @@ -2227,7 +2213,7 @@ unfolded." (defun gnus-article-remove-images () "Remove all images from the article buffer." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (save-restriction (widen) @@ -2239,7 +2225,11 @@ unfolded." (defun gnus-article-show-images () "Show any images that are in the HTML-rendered article buffer. This only works if the article in question is HTML." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) + ;; Reselect for image display. + (let ((gnus-blocked-images nil) + (gnus-inhibit-images nil)) + (gnus-summary-select-article)) (gnus-with-article-buffer (save-restriction (widen) @@ -2255,7 +2245,7 @@ This only works if the article in question is HTML." (defun gnus-article-treat-fold-newsgroups () "Fold the Newsgroups and Followup-To message headers." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (while (gnus-article-goto-header "newsgroups\\|followup-to") (save-restriction @@ -2279,7 +2269,7 @@ predicate. See Info node `(gnus)Customizing Articles'." If ARG is non-nil and not a number, toggle `gnus-article-truncate-lines' too. If ARG is a number, truncate long lines if and only if arg is positive." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (cond ((and (numberp arg) (> arg 0)) (setq gnus-article-truncate-lines t)) @@ -2298,7 +2288,7 @@ long lines if and only if arg is positive." (defun gnus-article-treat-body-boundary () "Place a boundary line at the end of the headers." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (when (and gnus-body-boundary-delimiter (> (length gnus-body-boundary-delimiter) 0)) (gnus-with-article-headers @@ -2317,7 +2307,7 @@ long lines if and only if arg is positive." "Fill lines that are wider than the window width or `fill-column'. If WIDTH (interactively, the numeric prefix), use that as the fill width." - (interactive "P") + (interactive "P" gnus-article-mode) (save-excursion (let* ((inhibit-read-only t) (window-width (window-width (get-buffer-window (current-buffer)))) @@ -2341,7 +2331,7 @@ fill width." (defun article-capitalize-sentences () "Capitalize the first word in each sentence." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-read-only t) (paragraph-start "^[\n\^L]")) @@ -2352,7 +2342,7 @@ fill width." (defun article-remove-cr () "Remove trailing CRs and then translate remaining CRs into LFs." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-read-only t)) (goto-char (point-min)) @@ -2364,7 +2354,7 @@ fill width." (defun article-remove-trailing-blank-lines () "Remove all trailing blank lines from the article." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-read-only t)) (goto-char (point-max)) @@ -2383,7 +2373,7 @@ fill width." (defun article-display-face (&optional force) "Display any Face headers in the header." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode gnus-summary-mode) (let ((wash-face-p buffer-read-only)) (gnus-with-article-headers ;; When displaying parts, this function can be called several times on @@ -2431,7 +2421,7 @@ fill width." (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode gnus-summary-mode) (let ((wash-face-p buffer-read-only)) ;; When type `W f' (gnus-with-article-headers ;; Delete the old process, if any. @@ -2493,7 +2483,7 @@ fill width." (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t) (mail-parse-charset gnus-newsgroup-charset) @@ -2505,7 +2495,7 @@ fill width." (defun article-decode-charset (&optional prompt) "Decode charset-encoded text in the article. If PROMPT (the prefix), prompt for a coding system to use." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((inhibit-point-motion-hooks t) (case-fold-search t) (inhibit-read-only t) (mail-parse-charset gnus-newsgroup-charset) @@ -2529,7 +2519,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) @@ -2627,7 +2617,7 @@ Mail-Reply-To: and Mail-Followup-To:." If FORCE, decode the article whether it is marked as quoted-printable or not. If READ-CHARSET, ask for a coding system." - (interactive (list 'force current-prefix-arg)) + (interactive (list 'force current-prefix-arg) gnus-article-mode) (save-excursion (let ((inhibit-read-only t) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) @@ -2655,7 +2645,7 @@ If READ-CHARSET, ask for a coding system." "Translate a base64 article. If FORCE, decode the article whether it is marked as base64 not. If READ-CHARSET, ask for a coding system." - (interactive (list 'force current-prefix-arg)) + (interactive (list 'force current-prefix-arg) gnus-article-mode) (save-excursion (let ((inhibit-read-only t) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) @@ -2687,7 +2677,7 @@ If READ-CHARSET, ask for a coding system." (defun article-decode-HZ () "Translate a HZ-encoded article." - (interactive) + (interactive nil gnus-article-mode) (require 'rfc1843) (save-excursion (let ((inhibit-read-only t)) @@ -2695,7 +2685,7 @@ If READ-CHARSET, ask for a coding system." (defun article-unsplit-urls () "Remove the newlines that some other mailers insert into URLs." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-read-only t)) (goto-char (point-min)) @@ -2707,7 +2697,7 @@ If READ-CHARSET, ask for a coding system." (defun article-wash-html () "Format an HTML article." - (interactive) + (interactive nil gnus-article-mode) (let ((handles nil) (inhibit-read-only t)) (when (gnus-buffer-live-p gnus-original-article-buffer) @@ -3041,7 +3031,7 @@ This command creates temporary files to pass HTML contents including images if any to the browser, and deletes them when exiting the group \(if you want)." ;; Cf. `mm-w3m-safe-url-regexp' - (interactive "P") + (interactive "P" gnus-article-mode) (if arg (gnus-summary-show-article) (let ((gnus-visible-headers @@ -3078,7 +3068,7 @@ images if any to the browser, and deletes them when exiting the group (defun article-hide-list-identifiers () "Remove list identifiers from the Subject header. The `gnus-list-identifiers' variable specifies what to do." - (interactive) + (interactive nil gnus-article-mode) (let ((inhibit-point-motion-hooks t) (regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) (inhibit-read-only t)) @@ -3100,7 +3090,7 @@ The `gnus-list-identifiers' variable specifies what to do." "Toggle hiding of any PEM headers and signatures in the current article. If given a negative prefix, always show; if given a positive prefix, always hide." - (interactive (gnus-article-hidden-arg)) + (interactive (gnus-article-hidden-arg) gnus-article-mode) (unless (gnus-article-check-hidden-text 'pem arg) (save-excursion (let ((inhibit-read-only t) end) @@ -3126,7 +3116,7 @@ always hide." (defun article-strip-banner () "Strip the banners specified by the `banner' group parameter and by `gnus-article-address-banner-alist'." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (save-restriction (let ((inhibit-point-motion-hooks t)) @@ -3175,7 +3165,7 @@ always hide." (defun article-babel () "Translate article using an online translation service." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (require 'babel) (gnus-with-article-buffer (when (article-goto-body) @@ -3192,7 +3182,7 @@ always hide." "Hide the signature in the current article. If given a negative prefix, always show; if given a positive prefix, always hide." - (interactive (gnus-article-hidden-arg)) + (interactive (gnus-article-hidden-arg) gnus-article-mode) (unless (gnus-article-check-hidden-text 'signature arg) (save-excursion (save-restriction @@ -3204,7 +3194,7 @@ always hide." (defun article-strip-headers-in-body () "Strip offensive headers from bodies." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (article-goto-body) (let ((case-fold-search t)) @@ -3213,7 +3203,7 @@ always hide." (defun article-strip-leading-blank-lines () "Remove all blank lines from the beginning of the article." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3255,7 +3245,7 @@ Point is left at the beginning of the narrowed-to region." (defun article-strip-multiple-blank-lines () "Replace consecutive blank lines with one empty line." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3274,7 +3264,7 @@ Point is left at the beginning of the narrowed-to region." (defun article-strip-leading-space () "Remove all white space from the beginning of the lines in the article." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3284,7 +3274,7 @@ Point is left at the beginning of the narrowed-to region." (defun article-strip-trailing-space () "Remove all white space from the end of the lines in the article." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3294,14 +3284,14 @@ Point is left at the beginning of the narrowed-to region." (defun article-strip-blank-lines () "Strip leading, trailing and multiple blank lines." - (interactive) + (interactive nil gnus-article-mode) (article-strip-leading-blank-lines) (article-remove-trailing-blank-lines) (article-strip-multiple-blank-lines)) (defun article-strip-all-blank-lines () "Strip all blank lines." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-read-only t)) @@ -3433,7 +3423,7 @@ lines forward." "Convert DATE date to TYPE in the current article. The default type is `ut'. See `gnus-article-date-headers' for possible values." - (interactive (list 'ut t)) + (interactive (list 'ut t) gnus-article-mode) (let* ((case-fold-search t) (inhibit-read-only t) (inhibit-point-motion-hooks t) @@ -3677,29 +3667,29 @@ possible values." (defun article-date-local (&optional highlight) "Convert the current article date to the local timezone." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'local highlight)) (defun article-date-english (&optional highlight) "Convert the current article date to something that is proper English." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'english highlight)) (defun article-date-original (&optional highlight) "Convert the current article date to what it was originally. This is only useful if you have used some other date conversion function and want to see what the date was before converting." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'original highlight)) (defun article-date-lapsed (&optional highlight) "Convert the current article date to time lapsed since it was sent." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'lapsed highlight)) (defun article-date-combined-lapsed (&optional highlight) "Convert the current article date to time lapsed since it was sent." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'combined-lapsed highlight)) (defun article-update-date-lapsed () @@ -3748,16 +3738,16 @@ function and want to see what the date was before converting." "Start a timer to update the Date headers in the article buffers. The numerical prefix says how frequently (in seconds) the function is to run." - (interactive "p") + (interactive "p" gnus-article-mode) (unless n (setq n 1)) (gnus-stop-date-timer) (setq article-lapsed-timer - (run-at-time 1 n 'article-update-date-lapsed))) + (run-at-time 1 n #'article-update-date-lapsed))) (defun gnus-stop-date-timer () "Stop the Date timer." - (interactive) + (interactive nil gnus-article-mode) (when article-lapsed-timer (cancel-timer article-lapsed-timer) (setq article-lapsed-timer nil))) @@ -3765,12 +3755,12 @@ is to run." (defun article-date-user (&optional highlight) "Convert the current article date to the user-defined format. This format is defined by the `gnus-article-time-format' variable." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'user-defined highlight)) (defun article-date-iso8601 (&optional highlight) "Convert the current article date to ISO8601." - (interactive (list t)) + (interactive (list t) gnus-article-mode) (article-date-ut 'iso8601 highlight)) (defmacro gnus-article-save-original-date (&rest forms) @@ -3803,7 +3793,7 @@ This format is defined by the `gnus-article-time-format' variable." (defun article-remove-leading-whitespace () "Remove excessive whitespace from all headers." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (save-restriction (let ((inhibit-read-only t)) @@ -3814,7 +3804,7 @@ This format is defined by the `gnus-article-time-format' variable." (defun article-emphasize (&optional arg) "Emphasize text according to `gnus-emphasis-alist'." - (interactive (gnus-article-hidden-arg)) + (interactive (gnus-article-hidden-arg) gnus-article-mode) (unless (gnus-article-check-hidden-text 'emphasis arg) (save-excursion (let ((alist (or @@ -4247,7 +4237,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defun article-verify-x-pgp-sig () "Verify X-PGP-Sig." ;; <https://ftp.isc.org/pub/pgpcontrol/FORMAT> - (interactive) + (interactive nil gnus-article-mode) (if (gnus-buffer-live-p gnus-original-article-buffer) (let ((sig (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "X-PGP-Sig"))) @@ -4321,20 +4311,16 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defun article-verify-cancel-lock () "Verify Cancel-Lock header." - (interactive) + (interactive nil gnus-article-mode) (if (gnus-buffer-live-p gnus-original-article-buffer) (canlock-verify gnus-original-article-buffer))) -(defmacro gnus--\,@ (exp) - (declare (debug t)) - `(progn ,@(eval exp t))) - (gnus--\,@ (mapcar (lambda (func) `(defun ,(intern (format "gnus-%s" func)) (&optional interactive &rest args) ,(format "Run `%s' in the article buffer." func) - (interactive (list t)) + (interactive (list t) gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (if interactive (call-interactively #',func) @@ -4424,7 +4410,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is "\M-g" gnus-article-read-summary-keys) (substitute-key-definition - 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) + #'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) @@ -4502,12 +4488,12 @@ commands: (make-local-variable 'gnus-article-image-alist) (make-local-variable 'gnus-article-charset) (make-local-variable 'gnus-article-ignored-charsets) - (setq-local bookmark-make-record-function 'gnus-summary-bookmark-make-record) + (setq-local bookmark-make-record-function #'gnus-summary-bookmark-make-record) ;; Prevent Emacs from displaying non-break space with ;; `nobreak-space' face. (setq-local nobreak-char-display nil) ;; Enable `gnus-article-remove-images' to delete images shr.el renders. - (setq-local shr-put-image-function 'gnus-shr-put-image) + (setq-local shr-put-image-function #'gnus-shr-put-image) (unless gnus-article-show-cursor (setq cursor-in-non-selected-windows nil)) (gnus-set-default-directory) @@ -4742,21 +4728,22 @@ If ALL-HEADERS is non-nil, no headers are hidden." (define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle" "Mode for sticky articles." ;; Release bindings that won't work. - (substitute-key-definition 'gnus-article-read-summary-keys 'undefined + (substitute-key-definition #'gnus-article-read-summary-keys #'undefined gnus-sticky-article-mode-map) - (substitute-key-definition 'gnus-article-refer-article 'undefined + (substitute-key-definition #'gnus-article-refer-article #'undefined gnus-sticky-article-mode-map) (dolist (k '("e" "h" "s" "F" "R")) (define-key gnus-sticky-article-mode-map k nil)) - (define-key gnus-sticky-article-mode-map "k" 'gnus-kill-sticky-article-buffer) - (define-key gnus-sticky-article-mode-map "q" 'bury-buffer) - (define-key gnus-sticky-article-mode-map "\C-hc" 'describe-key-briefly) - (define-key gnus-sticky-article-mode-map "\C-hk" 'describe-key)) + (define-key gnus-sticky-article-mode-map "k" + #'gnus-kill-sticky-article-buffer) + (define-key gnus-sticky-article-mode-map "q" #'bury-buffer) + (define-key gnus-sticky-article-mode-map "\C-hc" #'describe-key-briefly) + (define-key gnus-sticky-article-mode-map "\C-hk" #'describe-key)) (defun gnus-sticky-article (arg) "Make the current article sticky. If a prefix ARG is given, ask for a name for this sticky article buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-summary-show-thread) (gnus-summary-select-article nil nil 'pseudo) (let (new-art-buf-name) @@ -4800,7 +4787,7 @@ If a prefix ARG is given, ask for a name for this sticky article buffer." "Kill the given sticky article BUFFER. If none is given, assume the current buffer and kill it if it has `gnus-sticky-article-mode'." - (interactive) + (interactive nil gnus-article-mode) (unless buffer (setq buffer (current-buffer))) (with-current-buffer buffer @@ -4810,7 +4797,7 @@ If none is given, assume the current buffer and kill it if it has (defun gnus-kill-sticky-article-buffers (arg) "Kill all sticky article buffers. If a prefix ARG is given, ask for confirmation." - (interactive "P") + (interactive "P" gnus-article-mode) (dolist (buf (gnus-buffers)) (with-current-buffer buf (and (derived-mode-p 'gnus-sticky-article-mode) @@ -4882,9 +4869,9 @@ General format specifiers can also be used. See Info node (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) - (define-key map "\r" 'gnus-article-push-button) - (define-key map [mouse-2] 'gnus-article-push-button) - (define-key map [down-mouse-3] 'gnus-mime-button-menu) + (define-key map "\r" #'gnus-article-push-button) + (define-key map [mouse-2] #'gnus-article-push-button) + (define-key map [down-mouse-3] #'gnus-mime-button-menu) (dolist (c gnus-mime-button-commands) (define-key map (cadr c) (car c))) map)) @@ -4952,7 +4939,7 @@ General format specifiers can also be used. See Info node (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." - (interactive) + (interactive nil gnus-article-mode) (with-current-buffer gnus-article-buffer (let ((handles (or handles gnus-article-mime-handles)) (mail-parse-charset gnus-newsgroup-charset) @@ -4969,7 +4956,7 @@ General format specifiers can also be used. See Info node (defun gnus-article-jump-to-part (n) "Jump to MIME part N." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((parts (with-current-buffer gnus-article-buffer (length gnus-article-mime-handle-alist)))) (when (zerop parts) @@ -5065,11 +5052,11 @@ and `gnus-mime-delete-part', and not provided at run-time normally." (defun gnus-mime-replace-part (file) "Replace MIME part under point with an external body." ;; Useful if file has already been saved to disk - (interactive - (list - (read-file-name "Replace MIME part with file: " - (or mm-default-directory default-directory) - nil t))) + (interactive (list + (read-file-name "Replace MIME part with file: " + (or mm-default-directory default-directory) + nil t)) + gnus-article-mode) (unless (file-regular-p (file-truename file)) (error "Can't replace part with %s, which isn't a regular file" file)) @@ -5078,7 +5065,7 @@ and `gnus-mime-delete-part', and not provided at run-time normally." (defun gnus-mime-save-part-and-strip (&optional file event) "Save the MIME part under point then replace it with an external body. If FILE is given, use it for the external part." - (interactive (list nil last-nonmenu-event)) + (interactive (list nil last-nonmenu-event) gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5120,7 +5107,7 @@ The current article has a complicated MIME structure, giving up...")) (defun gnus-mime-delete-part (&optional event) "Delete the MIME part under point. Replace it with some information about the removed part." - (interactive (list last-nonmenu-event)) + (interactive (list last-nonmenu-event) gnus-article-mode) (mouse-set-point event) (gnus-article-check-buffer) (when (gnus-group-read-only-p) @@ -5169,7 +5156,7 @@ Deleting parts may malfunction or destroy the article; continue? ")) (defun gnus-mime-save-part (&optional event) "Save the MIME part under point." - (interactive (list last-nonmenu-event)) + (interactive (list last-nonmenu-event) gnus-article-mode) (mouse-set-point event) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) @@ -5179,7 +5166,7 @@ Deleting parts may malfunction or destroy the article; continue? ")) (defun gnus-mime-pipe-part (&optional cmd event) "Pipe the MIME part under point to a process. Use CMD as the process." - (interactive (list nil last-nonmenu-event)) + (interactive (list nil last-nonmenu-event) gnus-article-mode) (mouse-set-point event) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) @@ -5188,7 +5175,7 @@ Use CMD as the process." (defun gnus-mime-view-part (&optional event) "Interactively choose a viewing method for the MIME part under point." - (interactive (list last-nonmenu-event)) + (interactive (list last-nonmenu-event) gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5218,7 +5205,7 @@ Use CMD as the process." "Choose a MIME media type, and view the part as such. If non-nil, PRED is a predicate to use during completion to limit the available media-types." - (interactive (list nil nil last-nonmenu-event)) + (interactive (list nil nil last-nonmenu-event) gnus-article-mode) (save-excursion (if event (mouse-set-point event)) (unless mime-type @@ -5257,7 +5244,8 @@ available media-types." "Put the MIME part under point into a new buffer. If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 are decompressed." - (interactive (list nil current-prefix-arg last-nonmenu-event)) + (interactive (list nil current-prefix-arg last-nonmenu-event) + gnus-article-mode) (mouse-set-point event) (gnus-article-check-buffer) (unless handle @@ -5313,7 +5301,8 @@ are decompressed." (defun gnus-mime-print-part (&optional handle filename event) "Print the MIME part under point." (interactive - (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event)) + (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event) + gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5341,7 +5330,8 @@ are decompressed." (defun gnus-mime-inline-part (&optional handle arg event) "Insert the MIME part under point into the current buffer. Compressed files like .gz and .bz2 are decompressed." - (interactive (list nil current-prefix-arg last-nonmenu-event)) + (interactive (list nil current-prefix-arg last-nonmenu-event) + gnus-article-mode) (if event (mouse-set-point event)) (gnus-article-check-buffer) (let* ((inhibit-read-only t) @@ -5439,7 +5429,8 @@ CHARSET may either be a string or a symbol." (defun gnus-mime-view-part-as-charset (&optional handle arg event) "Insert the MIME part under point into the current buffer using the specified charset." - (interactive (list nil current-prefix-arg last-nonmenu-event)) + (interactive (list nil current-prefix-arg last-nonmenu-event) + gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5479,7 +5470,7 @@ specified charset." (defun gnus-mime-view-part-externally (&optional handle event) "View the MIME part under point with an external viewer." - (interactive (list nil last-nonmenu-event)) + (interactive (list nil last-nonmenu-event) gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5501,7 +5492,7 @@ specified charset." (defun gnus-mime-view-part-internally (&optional handle event) "View the MIME part under point with an internal viewer. If no internal viewer is available, use an external viewer." - (interactive (list nil last-nonmenu-event)) + (interactive (list nil last-nonmenu-event) gnus-article-mode) (save-excursion (mouse-set-point event) (gnus-article-check-buffer) @@ -5522,7 +5513,9 @@ If no internal viewer is available, use an external viewer." (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at (point)." (interactive - (list (gnus-completing-read "Action" (mapcar #'car gnus-mime-action-alist) t))) + (list (gnus-completing-read + "Action" (mapcar #'car gnus-mime-action-alist) t)) + gnus-article-mode) (gnus-article-check-buffer) (let ((action-pair (assoc action gnus-mime-action-alist))) (if action-pair @@ -5615,62 +5608,62 @@ If INTERACTIVE, call FUNCTION interactively." (defun gnus-article-pipe-part (n) "Pipe MIME part N, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'mm-pipe-part)) (defun gnus-article-save-part (n) "Save MIME part N, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'mm-save-part)) (defun gnus-article-interactively-view-part (n) "View MIME part N interactively, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'mm-interactively-view-part)) (defun gnus-article-copy-part (n) "Copy MIME part N, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-copy-part)) (defun gnus-article-view-part-as-charset (n) "View MIME part N using a specified charset. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) (defun gnus-article-view-part-externally (n) "View MIME part N externally, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-view-part-externally)) (defun gnus-article-inline-part (n) "Inline MIME part N, which is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-inline-part)) (defun gnus-article-save-part-and-strip (n) "Save MIME part N and replace it with an external body. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t)) (defun gnus-article-replace-part (n) "Replace MIME part N with an external body. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-replace-part t t)) (defun gnus-article-delete-part (n) "Delete MIME part N and add some information about the removed part. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-delete-part t)) (defun gnus-article-view-part-as-type (n) "Choose a MIME media type, and view part N as such. N is the numerical prefix." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t)) (defun gnus-article-mime-match-handle-first (condition) @@ -5697,7 +5690,7 @@ N is the numerical prefix." "View MIME part N, which is the numerical prefix. If the part is already shown, hide the part. If N is nil, view all parts." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (or (numberp n) (setq n (gnus-article-mime-match-handle-first gnus-article-mime-match-handle-function))) @@ -6046,7 +6039,28 @@ If nil, don't show those extra buttons." (ignored gnus-ignored-mime-types) (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight)) (not-attachment t) - display text) + ;; 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 (progn (while ignored @@ -6151,7 +6165,7 @@ If nil, don't show those extra buttons." (let* ((preferred (or preferred (mm-preferred-alternative handles))) (ihandles handles) (point (point)) - handle (inhibit-read-only t) begend not-pref) ;; from + (inhibit-read-only t) begend not-pref) ;; from (save-window-excursion (save-restriction (when ibegend @@ -6165,8 +6179,8 @@ If nil, don't show those extra buttons." (mm-remove-parts handles)) (setq begend (list (point-marker))) ;; Do the toggle. - (unless (setq not-pref (cadr (member preferred ihandles))) - (setq not-pref (car ihandles))) + (setq not-pref (or (cadr (member preferred ihandles)) + (car ihandles))) (when (or ibegend (not preferred) (not (gnus-unbuttonized-mime-type-p @@ -6177,22 +6191,22 @@ If nil, don't show those extra buttons." (progn (insert (format "%d. " id)) (point)) - `(gnus-callback - (lambda (handles) - (unless ,(not ibegend) - (setq gnus-article-mime-handle-alist - ',gnus-article-mime-handle-alist)) - (gnus-mime-display-alternative - ',ihandles ',not-pref ',begend ,id)) - keymap ,gnus-mime-button-map - mouse-face ,gnus-article-mouse-face - face ,gnus-article-button-face - follow-link t - gnus-part ,id - article-type multipart - rear-nonsticky t)) + (let ((gamha gnus-article-mime-handle-alist)) + `(gnus-callback + ,(lambda (_handles) + (unless (not ibegend) + (setq gnus-article-mime-handle-alist gamha)) + (gnus-mime-display-alternative + ihandles not-pref begend id)) + keymap ,gnus-mime-button-map + mouse-face ,gnus-article-mouse-face + face ,gnus-article-button-face + follow-link t + gnus-part ,id + article-type multipart + rear-nonsticky t))) ;; Do the handles - (while (setq handle (pop handles)) + (dolist (handle handles) (add-text-properties ;; (setq from (point) ;; ) @@ -6201,22 +6215,22 @@ If nil, don't show those extra buttons." (if (equal handle preferred) ?* ? ) (mm-handle-media-type handle))) (point)) - `(gnus-callback - (lambda (handles) - (unless ,(not ibegend) - (setq gnus-article-mime-handle-alist - ',gnus-article-mime-handle-alist)) - (gnus-mime-display-alternative - ',ihandles ',handle ',begend ,id)) - keymap ,gnus-mime-button-map - mouse-face ,gnus-article-mouse-face - face ,gnus-article-button-face - follow-link t - gnus-part ,id - button t - category t - gnus-data ,handle - rear-nonsticky t)) + (let ((gamha gnus-article-mime-handle-alist)) + `(gnus-callback + ,(lambda (_handles) + (unless (not ibegend) + (setq gnus-article-mime-handle-alist gamha)) + (gnus-mime-display-alternative + ihandles handle begend id)) + keymap ,gnus-mime-button-map + mouse-face ,gnus-article-mouse-face + face ,gnus-article-button-face + follow-link t + gnus-part ,id + button t + category t + gnus-data ,handle + rear-nonsticky t))) (insert " ")) (insert "\n\n")) (when preferred @@ -6224,8 +6238,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 @@ -6321,7 +6336,8 @@ is the string to use when it is inactive.") (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) (gnus-delete-wash-type category))) -(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) +(defalias 'gnus-article-hide-headers-if-wanted + #'gnus-article-maybe-hide-headers) (defun gnus-article-maybe-hide-headers () "Hide unwanted headers if `gnus-have-all-headers' is nil. @@ -6387,7 +6403,7 @@ Provided for backwards compatibility." This function toggles the display when called interactively. Note that buttons to be added to the header are only the ones that aren't inlined in the body. Use `gnus-header-face-alist' to highlight buttons." - (interactive (list t)) + (interactive (list t) gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (let ((case-fold-search t) buttons st) (save-excursion @@ -6492,7 +6508,7 @@ the coding cookie." (defun gnus-narrow-to-page (&optional arg) "Narrow the article buffer to a page. If given a numerical ARG, move forward ARG pages." - (interactive "P") + (interactive "P" gnus-article-mode) (setq arg (if arg (prefix-numeric-value arg) 0)) (with-current-buffer gnus-article-buffer (widen) @@ -6545,7 +6561,7 @@ If given a numerical ARG, move forward ARG pages." (defun gnus-article-goto-next-page () "Show the next page of the article." - (interactive) + (interactive nil gnus-article-mode) (when (gnus-article-next-page) (goto-char (point-min)) (gnus-article-read-summary-keys nil ?n))) @@ -6553,7 +6569,7 @@ If given a numerical ARG, move forward ARG pages." (defun gnus-article-goto-prev-page () "Show the previous page of the article." - (interactive) + (interactive nil gnus-article-mode) (if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer? (gnus-article-read-summary-keys nil ?p) (gnus-article-prev-page nil))) @@ -6576,7 +6592,7 @@ If given a numerical ARG, move forward ARG pages." "Show the next page of the current article. If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." - (interactive "p") + (interactive "p" gnus-article-mode) (move-to-window-line (- -1 scroll-margin)) (if (and (not (and gnus-article-over-scroll (> (count-lines (window-start) (point-max)) @@ -6632,7 +6648,7 @@ specifies." (defun gnus-article-prev-page (&optional lines) "Show previous page of current article. Argument LINES specifies lines to be scrolled down." - (interactive "p") + (interactive "p" gnus-article-mode) (move-to-window-line 0) (if (and gnus-page-broken (bobp) @@ -6665,15 +6681,16 @@ not have a face in `gnus-article-boring-faces'." (catch 'only-boring (while (re-search-forward "\\b\\w\\w" nil t) (forward-char -1) - (when (not (gnus-intersection + (when (not (seq-intersection (gnus-faces-at (point)) - (symbol-value 'gnus-article-boring-faces))) + (symbol-value 'gnus-article-boring-faces) + #'eq)) (throw 'only-boring nil))) (throw 'only-boring t)))))) (defun gnus-article-refer-article () "Read article specified by message-id around point." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (re-search-backward "[ \t]\\|^" (point-at-bol) t) (re-search-forward "<?news:<?\\|<" (point-at-eol) t) @@ -6685,7 +6702,7 @@ not have a face in `gnus-article-boring-faces'." (defun gnus-article-show-summary () "Reconfigure windows to show summary buffer." - (interactive) + (interactive nil gnus-article-mode) (if (not (gnus-buffer-live-p gnus-summary-buffer)) (error "There is no summary buffer for this article buffer") (gnus-article-set-globals) @@ -6695,7 +6712,7 @@ not have a face in `gnus-article-boring-faces'." (defun gnus-article-describe-briefly () "Describe article mode commands briefly." - (interactive) + (interactive nil gnus-article-mode) (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) (defun gnus-article-check-buffer () @@ -6707,7 +6724,7 @@ not have a face in `gnus-article-boring-faces'." (defun gnus-article-read-summary-keys (&optional _arg key not-restore-window) "Read a summary buffer key sequence and execute it from the article buffer." - (interactive "P") + (interactive "P" gnus-article-mode) (gnus-article-check-buffer) (let ((nosaves '("q" "Q" "r" "m" "a" "f" "WDD" "WDW" @@ -6818,7 +6835,7 @@ not have a face in `gnus-article-boring-faces'." (ding)))))))) (defun gnus-article-read-summary-send-keys () - (interactive) + (interactive nil gnus-article-mode) (let ((unread-command-events (list ?S))) (gnus-article-read-summary-keys))) @@ -6826,7 +6843,8 @@ not have a face in `gnus-article-boring-faces'." "Display documentation of the function invoked by KEY. KEY is a string or a vector." (interactive (list (let ((cursor-in-echo-area t)) - (read-key-sequence "Describe key: ")))) + (read-key-sequence "Describe key: "))) + gnus-article-mode) (gnus-article-check-buffer) (if (memq (key-binding key t) '(gnus-article-read-summary-keys gnus-article-read-summary-send-keys)) @@ -6848,7 +6866,8 @@ KEY is a string or a vector." KEY is a string or a vector." (interactive (list (let ((cursor-in-echo-area t)) (read-key-sequence "Describe key: ")) - current-prefix-arg)) + current-prefix-arg) + gnus-article-mode) (gnus-article-check-buffer) (if (memq (key-binding key t) '(gnus-article-read-summary-keys gnus-article-read-summary-send-keys)) @@ -6875,7 +6894,7 @@ KEY is a string or a vector." "Show a list of all defined keys, and their definitions. The optional argument PREFIX, if non-nil, should be a key sequence; then we display only bindings that start with that prefix." - (interactive) + (interactive nil gnus-article-mode) (gnus-article-check-buffer) (let ((keymap (copy-keymap gnus-article-mode-map)) (map (copy-keymap gnus-article-send-map)) @@ -6884,7 +6903,7 @@ then we display only bindings that start with that prefix." parent agent draft) (define-key keymap "S" map) (define-key map [t] nil) - (define-key summap [t] 'undefined) + (define-key summap [t] #'undefined) (with-current-buffer gnus-article-current-summary (dolist (key sumkeys) (define-key summap key (key-binding key (current-local-map)))) @@ -6920,10 +6939,11 @@ then we display only bindings that start with that prefix." (setq-local gnus-agent-summary-mode agent) (setq-local gnus-draft-mode draft) (describe-bindings prefix)) - (let ((item `((lambda (prefix) - (with-current-buffer ,(current-buffer) - (gnus-article-describe-bindings prefix))) - ,prefix))) + (let* ((cb (current-buffer)) + (item `(,(lambda (prefix) + (with-current-buffer cb + (gnus-article-describe-bindings prefix))) + ,prefix))) ;; Loading `help-mode' here is necessary if `describe-bindings' ;; is replaced with something, e.g. `helm-descbinds'. (require 'help-mode) @@ -6934,7 +6954,7 @@ then we display only bindings that start with that prefix." "Start composing a reply mail to the current message. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." - (interactive) + (interactive nil gnus-article-mode) (let ((article (cdr gnus-article-current)) contents) (if (not (and transient-mark-mode mark-active)) @@ -6952,14 +6972,14 @@ the entire article will be yanked." "Start composing a wide reply mail to the current message. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." - (interactive) + (interactive nil gnus-article-mode) (gnus-article-reply-with-original t)) (defun gnus-article-followup-with-original () "Compose a followup to the current article. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." - (interactive) + (interactive nil gnus-article-mode) (let ((article (cdr gnus-article-current)) contents) (if (not (and transient-mark-mode mark-active)) @@ -6978,7 +6998,8 @@ the entire article will be yanked." This means that signatures, cited text and (some) headers will be hidden. If given a prefix, show the hidden text instead." - (interactive (append (gnus-article-hidden-arg) (list 'force))) + (interactive (append (gnus-article-hidden-arg) (list 'force)) + gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (article-hide-headers arg) (article-hide-list-identifiers) @@ -7273,7 +7294,7 @@ This is an extended text-mode. This will have permanent effect only in mail groups. If FORCE is non-nil, allow editing of articles even in read-only groups." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (when (and (not force) (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing")) @@ -7306,7 +7327,7 @@ groups." (defun gnus-article-edit-done (&optional arg) "Update the article edits and exit." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((func gnus-article-edit-done-function) (buf (current-buffer)) (start (window-start)) @@ -7340,7 +7361,7 @@ groups." (defun gnus-article-edit-exit () "Exit the article editing without updating." - (interactive) + (interactive nil gnus-article-mode) (when (or (not (buffer-modified-p)) (yes-or-no-p "Article modified; kill anyway? ")) (let ((curbuf (current-buffer)) @@ -7361,7 +7382,7 @@ groups." (defun gnus-article-edit-full-stops () "Interactively repair spacing at end of sentences." - (interactive) + (interactive nil gnus-article-mode) (save-excursion (goto-char (point-min)) (search-forward-regexp "^$" nil t) @@ -7879,7 +7900,7 @@ HEADER is a regexp to match a header. For a fuller explanation, see "Check text under the mouse pointer for a callback function. If the text under the mouse pointer has a `gnus-callback' property, call it with the value of the `gnus-data' text property." - (interactive "e") + (interactive "e" gnus-article-mode) (set-buffer (window-buffer (posn-window (event-start event)))) (let* ((pos (posn-point (event-start event))) (data (get-text-property pos 'gnus-data)) @@ -7892,7 +7913,7 @@ call it with the value of the `gnus-data' text property." "Check text at point for a callback function. If the text at point has a `gnus-callback' property, call it with the value of the `gnus-data' text property." - (interactive (list last-nonmenu-event)) + (interactive (list last-nonmenu-event) gnus-article-mode) (save-excursion (when event (mouse-set-point event)) @@ -7906,7 +7927,7 @@ This function calls `gnus-article-highlight-headers', `gnus-article-highlight-citation', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode) (gnus-article-highlight-headers) (gnus-article-highlight-citation force) (gnus-article-highlight-signature) @@ -7918,14 +7939,14 @@ do the highlighting. See the documentation for those functions." This function calls `gnus-article-highlight-headers', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode) (gnus-article-highlight-headers) (gnus-article-highlight-signature) (gnus-article-add-buttons)) (defun gnus-article-highlight-headers () "Highlight article headers as specified by `gnus-header-face-alist'." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (let (regexp header-face field-face from hpoints fpoints) (dolist (entry gnus-header-face-alist) @@ -7959,7 +7980,7 @@ do the highlighting. See the documentation for those functions." "Highlight the signature in an article. It does this by highlighting everything after `gnus-signature-separator' using the face `gnus-signature'." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t)) (save-restriction @@ -7982,7 +8003,7 @@ It does this by highlighting everything after "Find external references in the article and make buttons of them. \"External references\" are things like Message-IDs and URLs, as specified by `gnus-button-alist'." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t) (case-fold-search t) @@ -8076,7 +8097,7 @@ url is put as the `gnus-button-url' overlay property on the button." ;; Add buttons to the head of an article. (defun gnus-article-add-buttons-to-head () "Add buttons to the head of the article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (let (beg end) (dolist (entry gnus-header-button-alist) @@ -8124,7 +8145,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-article-copy-string () "Copy the string in the button to the kill ring." - (interactive) + (interactive nil gnus-article-mode) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-string))) (when data @@ -8240,7 +8261,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-button-patch (library line) "Visit an Emacs Lisp library LIBRARY on line LINE." - (interactive) + (interactive nil gnus-article-mode) (let ((file (locate-library (file-name-nondirectory library)))) (unless file (error "Couldn't find library %s" library)) @@ -8267,7 +8288,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)))) @@ -8403,14 +8424,14 @@ url is put as the `gnus-button-url' overlay property on the button." (defvar gnus-prev-page-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'gnus-button-prev-page) - (define-key map "\r" 'gnus-button-prev-page) + (define-key map [mouse-2] #'gnus-button-prev-page) + (define-key map "\r" #'gnus-button-prev-page) map)) (defvar gnus-next-page-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'gnus-button-next-page) - (define-key map "\r" 'gnus-button-next-page) + (define-key map [mouse-2] #'gnus-button-next-page) + (define-key map "\r" #'gnus-button-next-page) map)) (defun gnus-insert-prev-page-button () @@ -8432,7 +8453,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-button-next-page (&optional _args _more-args) "Go to the next page." - (interactive) + (interactive nil gnus-article-mode) (let ((win (selected-window))) (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-next-page) @@ -8440,7 +8461,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-button-prev-page (&optional _args _more-args) "Go to the prev page." - (interactive) + (interactive nil gnus-article-mode) (let ((win (selected-window))) (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) @@ -8464,7 +8485,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-article-button-next-page (_arg) "Go to the next page." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((win (selected-window))) (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-next-page) @@ -8472,7 +8493,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-article-button-prev-page (_arg) "Go to the prev page." - (interactive "P") + (interactive "P" gnus-article-mode) (let ((win (selected-window))) (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) @@ -8606,9 +8627,10 @@ For example: (list (or gnus-article-encrypt-protocol (gnus-completing-read "Encrypt protocol" - (mapcar #'car gnus-article-encrypt-protocol-alist) - t)) - current-prefix-arg)) + (mapcar #'car gnus-article-encrypt-protocol-alist) + t)) + current-prefix-arg) + gnus-article-mode) ;; User might hit `K E' instead of `K e', so prompt once. (when (and gnus-article-encrypt-protocol gnus-novice-user) @@ -8713,9 +8735,9 @@ For example: (defvar gnus-mime-security-button-map (let ((map (make-sparse-keymap))) - (define-key map "\r" 'gnus-article-push-button) - (define-key map [mouse-2] 'gnus-article-push-button) - (define-key map [down-mouse-3] 'gnus-mime-security-button-menu) + (define-key map "\r" #'gnus-article-push-button) + (define-key map [mouse-2] #'gnus-article-push-button) + (define-key map [down-mouse-3] #'gnus-mime-security-button-menu) (dolist (c gnus-mime-security-button-commands) (define-key map (cadr c) (car c))) map)) @@ -8732,7 +8754,7 @@ For example: (defun gnus-mime-security-button-menu (event prefix) "Construct a context-sensitive menu of security commands." - (interactive "e\nP") + (interactive "e\nP" gnus-article-mode) (save-window-excursion (let ((pos (event-start event))) (select-window (posn-window pos)) @@ -8889,12 +8911,12 @@ For example: (defun gnus-mime-security-save-part () "Save the security part under point." - (interactive) + (interactive nil gnus-article-mode) (gnus-mime-security-run-function 'mm-save-part)) (defun gnus-mime-security-pipe-part () "Pipe the security part under point to a process." - (interactive) + (interactive nil gnus-article-mode) (gnus-mime-security-run-function 'mm-pipe-part)) (provide 'gnus-art) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index bc41d5b149d..8c2a928ab98 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -168,7 +168,7 @@ So the cdr of each bookmark is an alist too.") ;;;###autoload (defun gnus-bookmark-set () "Set a bookmark for this article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-bookmark-maybe-load-default-file) (if (or (not (derived-mode-p 'gnus-summary-mode)) (not gnus-article-current)) @@ -483,7 +483,7 @@ Gnus bookmarks names preceded by a \"*\" have annotations. (defun gnus-bookmark-bmenu-toggle-infos (&optional show) "Toggle whether details are shown in the Gnus bookmark list. Optional argument SHOW means show them unconditionally." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (cond (show (setq gnus-bookmark-bmenu-toggle-infos nil) @@ -649,14 +649,14 @@ reposition and try again, else return nil." (defun gnus-bookmark-bmenu-show-details () "Show the annotation for the current bookmark in another window." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (let ((bookmark (gnus-bookmark-bmenu-bookmark))) (if (gnus-bookmark-bmenu-check-position) (gnus-bookmark-show-details bookmark)))) (defun gnus-bookmark-bmenu-mark () "Mark bookmark on this line to be displayed by \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-select]." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (beginning-of-line) (if (gnus-bookmark-bmenu-check-position) (let ((inhibit-read-only t)) @@ -668,7 +668,7 @@ reposition and try again, else return nil." (defun gnus-bookmark-bmenu-unmark (&optional backup) "Cancel all requested operations on bookmark on this line and move down. Optional BACKUP means move up." - (interactive "P") + (interactive "P" gnus-bookmark-bmenu-mode) (beginning-of-line) (if (gnus-bookmark-bmenu-check-position) (progn @@ -683,7 +683,7 @@ Optional BACKUP means move up." (defun gnus-bookmark-bmenu-backup-unmark () "Move up and cancel all requested operations on bookmark on line above." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (forward-line -1) (if (gnus-bookmark-bmenu-check-position) (progn @@ -695,7 +695,7 @@ Optional BACKUP means move up." "Mark Gnus bookmark on this line to be deleted. To carry out the deletions that you've marked, use \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (beginning-of-line) (if (gnus-bookmark-bmenu-check-position) (let ((inhibit-read-only t)) @@ -708,7 +708,7 @@ To carry out the deletions that you've marked, use "Mark bookmark on this line to be deleted, then move up one line. To carry out the deletions that you've marked, use \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (gnus-bookmark-bmenu-delete) (forward-line -2) (if (gnus-bookmark-bmenu-check-position) @@ -720,7 +720,7 @@ To carry out the deletions that you've marked, use You can mark bookmarks with the \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-mark] command." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (if (gnus-bookmark-bmenu-check-position) (let ((bmrk (gnus-bookmark-bmenu-bookmark)) (menu (current-buffer))) @@ -730,13 +730,13 @@ command." (bury-buffer menu)))) (defun gnus-bookmark-bmenu-select-by-mouse (event) - (interactive "e") + (interactive "e" gnus-bookmark-bmenu-mode) (mouse-set-point event) (gnus-bookmark-bmenu-select)) (defun gnus-bookmark-bmenu-load () "Load the Gnus bookmark file and rebuild the bookmark menu-buffer." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (if (gnus-bookmark-bmenu-check-position) (save-excursion (save-window-excursion @@ -745,7 +745,7 @@ command." (defun gnus-bookmark-bmenu-execute-deletions () "Delete Gnus bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands." - (interactive) + (interactive nil gnus-bookmark-bmenu-mode) (message "Deleting Gnus bookmarks...") (let ((hide-em gnus-bookmark-bmenu-toggle-infos) (o-point (point)) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 5ed731947bc..34dba54c11d 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -342,7 +342,7 @@ it's not cached." "Enter the next N articles into the cache. If not given a prefix, use the process marked articles instead. Returns the list of articles entered." - (interactive "P") + (interactive "P" gnus-summary-mode) (let (out) (dolist (article (gnus-summary-work-articles n)) (gnus-summary-remove-process-mark article) @@ -363,7 +363,7 @@ Returns the list of articles entered." "Remove the next N articles from the cache. If not given a prefix, use the process marked articles instead. Returns the list of articles removed." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-cache-change-buffer gnus-newsgroup-name) (let (out) (dolist (article (gnus-summary-work-articles n)) @@ -388,7 +388,7 @@ Returns the list of articles removed." (defun gnus-summary-insert-cached-articles () "Insert all the articles cached for this group into the current buffer." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-verbose (max 6 gnus-verbose))) (cond ((not gnus-newsgroup-cached) @@ -401,7 +401,7 @@ Returns the list of articles removed." (defun gnus-summary-limit-include-cached () "Limit the summary buffer to articles that are cached." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-verbose (max 6 gnus-verbose))) (if gnus-newsgroup-cached (progn diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 96f1a7de5ec..34947cece89 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -335,7 +335,7 @@ lines matches `message-cite-prefix-regexp' with the same prefix. Lines matching `gnus-cite-attribution-suffix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." - (interactive (list 'force)) + (interactive (list 'force) gnus-article-mode gnus-summary-mode) (with-current-buffer (if same-buffer (current-buffer) gnus-article-buffer) (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) @@ -459,7 +459,7 @@ frame width. Sections that are heuristically interpreted as not being text (i.e., computer code and the like) will not be folded." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) @@ -529,7 +529,8 @@ text (i.e., computer code and the like) will not be folded." See the documentation for `gnus-article-highlight-citation'. If given a negative prefix, always show; if given a positive prefix, always hide." - (interactive (append (gnus-article-hidden-arg) (list 'force))) + (interactive (append (gnus-article-hidden-arg) (list 'force)) + gnus-article-mode gnus-summary-mode) (gnus-set-format 'cited-opened-text-button t) (gnus-set-format 'cited-closed-text-button t) (with-current-buffer gnus-article-buffer @@ -661,7 +662,8 @@ percent and at least `gnus-cite-hide-absolute' lines of the body is cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." - (interactive (append (gnus-article-hidden-arg) '(force))) + (interactive (append (gnus-article-hidden-arg) '(force)) + gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-delete-wash-type 'cite) (unless (gnus-article-check-hidden-text 'cite arg) @@ -689,7 +691,7 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (let ((article (cdr gnus-article-current))) (unless (with-current-buffer gnus-summary-buffer @@ -837,7 +839,7 @@ See also the documentation for `gnus-article-highlight-citation'." (setq current (car loop) loop (cdr loop)) (setcdr current - (gnus-set-difference (cdr current) numbers))))))))) + (seq-difference (cdr current) numbers #'eq))))))))) (defun gnus-cite-parse-attributions () (let (al-alist) @@ -997,7 +999,7 @@ See also the documentation for `gnus-article-highlight-citation'." loop (cdr loop)) (if (eq current best) () - (setcdr current (gnus-set-difference (cdr current) numbers)) + (setcdr current (seq-difference (cdr current) numbers #'eq)) (when (null (cdr current)) (setq gnus-cite-loose-prefix-alist (delq current gnus-cite-loose-prefix-alist) @@ -1132,9 +1134,7 @@ Returns nil if there is no such line before LIMIT, t otherwise." (define-minor-mode gnus-message-citation-mode "Minor mode providing more font-lock support for nested citations. When enabled, it automatically turns on `font-lock-mode'." - nil ;; init-value - "" ;; lighter - nil ;; keymap + :lighter "" (when (derived-mode-p 'message-mode) ;; FIXME: Use font-lock-add-keywords! (let ((defaults (car font-lock-defaults)) diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index d8f48b19f87..e7af94ff509 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -337,7 +337,8 @@ category.")) (defun gnus-group-customize (group &optional topic) "Edit the group or topic on the current line." - (interactive (list (gnus-group-group-name) (gnus-group-topic-name))) + (interactive (list (gnus-group-group-name) (gnus-group-topic-name)) + gnus-group-mode) (let (info (types (mapcar (lambda (entry) `(cons :format "%v%h\n" @@ -485,7 +486,7 @@ form, but who cares?" (defun gnus-group-customize-done (&rest _ignore) "Apply changes and bury the buffer." - (interactive) + (interactive nil gnus-custom-mode) (let ((params (widget-value gnus-custom-params))) (if gnus-custom-topic (gnus-topic-set-parameters gnus-custom-topic params) @@ -829,7 +830,7 @@ eh?"))) "Customize score file FILE. When called interactively, FILE defaults to the current score file. This can be changed using the `\\[gnus-score-change-score-file]' command." - (interactive (list gnus-current-score-file)) + (interactive (list gnus-current-score-file) gnus-summary-mode) (unless file (error "No score file for %s" gnus-newsgroup-name)) (let ((scores (gnus-score-load file)) @@ -1000,7 +1001,7 @@ articles in the thread. (defun gnus-agent-customize-category (category) "Edit the CATEGORY." - (interactive (list (gnus-category-name))) + (interactive (list (gnus-category-name)) gnus-custom-mode) (let ((info (assq category gnus-category-alist)) (defaults (list nil '(agent-predicate . false) (cons 'agent-enable-expiration @@ -1101,8 +1102,6 @@ articles in the thread. (widget-setup) (buffer-enable-undo)))) -;;; The End: - (provide 'gnus-cus) ;;; gnus-cus.el ends here diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index 0cee01b9428..944fd9795a2 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -76,10 +76,10 @@ DELAY is a string, giving the length of the time. Possible values are: The value of `message-draft-headers' determines which headers are generated when the article is delayed. Remaining headers are generated when the article is sent." - (interactive - (list (read-string - "Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): " - gnus-delay-default-delay))) + (interactive (list (read-string + "Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): " + gnus-delay-default-delay)) + message-mode) ;; Allow spell checking etc. (run-hooks 'message-send-hook) (let (num unit year month day hour minute deadline) ;; days diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 52705640bf0..e2cbca9007d 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -32,11 +32,6 @@ ;; gnus-diary is a utility toolkit used on top of the nndiary back end. It is ;; now fully documented in the Gnus manual. - -;; Bugs / Todo: -;; =========== - - ;;; Code: (require 'nndiary) @@ -214,7 +209,7 @@ There are currently two built-in format functions: (defun gnus-summary-sort-by-schedule (&optional reverse) "Sort nndiary summary buffers by schedule of appointments. Optional prefix (or REVERSE argument) means sort in reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'schedule reverse)) (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. @@ -322,7 +317,7 @@ This function checks that all NNDiary required headers are present and valid, and prompts for values / correction otherwise. If ARG (or prefix) is non-nil, force prompting for all fields." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (mapcar (lambda (head) diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index ca2d57de7dc..af0b782202a 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -124,7 +124,8 @@ filenames." (mapcar ;; don't attach directories (lambda (f) (if (file-directory-p f) nil f)) - (nreverse (dired-map-over-marks (dired-get-filename) nil)))))) + (nreverse (dired-map-over-marks (dired-get-filename) nil))))) + dired-mode) (let ((destination nil) (files-str nil) (bufs nil)) @@ -178,7 +179,8 @@ filenames." If ARG is non-nil, open it in a new buffer." (interactive (list (file-name-sans-versions (dired-get-filename) t) - current-prefix-arg)) + current-prefix-arg) + dired-mode) (mailcap-parse-mailcaps) (if (file-exists-p file-name) (let (mime-type method) @@ -216,7 +218,8 @@ that name. If PRINT-TO is a number, prompt the user for the name of the file to save in." (interactive (list (file-name-sans-versions (dired-get-filename) t) - (ps-print-preprint current-prefix-arg))) + (ps-print-preprint current-prefix-arg)) + dired-mode) (mailcap-parse-mailcaps) (cond ((file-directory-p file-name) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index f68e9d6b749..9a0f21359f8 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -71,7 +71,7 @@ (defun gnus-draft-toggle-sending (article) "Toggle whether to send an article or not." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) gnus-summary-mode) (if (gnus-draft-article-sendable-p article) (progn (push article gnus-newsgroup-unsendable) @@ -83,7 +83,7 @@ (defun gnus-draft-edit-message () "Enter a mail/post buffer to edit and send the draft." - (interactive) + (interactive nil gnus-summary-mode) (let ((article (gnus-summary-article-number)) (group gnus-newsgroup-name)) (gnus-draft-check-draft-articles (list article)) @@ -109,7 +109,7 @@ (defun gnus-draft-send-message (&optional n) "Send the current draft(s). Obeys the standard process/prefix convention." - (interactive "P") + (interactive "P" gnus-summary-mode) (let* ((articles (gnus-summary-work-articles n)) (total (length articles)) article) diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index 265edf4d612..3fd8bf51de4 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -104,7 +104,7 @@ The optional LAYOUT overrides the `edit-form' window layout." (defun gnus-edit-form-done () "Update changes and kill the current buffer." - (interactive) + (interactive nil gnus-edit-form-mode) (goto-char (point-min)) (let ((form (condition-case nil (read (current-buffer)) @@ -115,7 +115,7 @@ The optional LAYOUT overrides the `edit-form' window layout." (defun gnus-edit-form-exit () "Kill the current buffer." - (interactive) + (interactive nil gnus-edit-form-mode) (let ((winconf gnus-prev-winconf)) (kill-buffer (current-buffer)) (set-window-configuration winconf))) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index f69c2ed12c2..8bca4ffe38f 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -132,11 +132,12 @@ For instance, to insert an X-Face use `gnus-random-x-face' as FUN Files matching `gnus-x-face-omit-files' are not considered." (interactive) - (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files - (lambda (file) - (gnus-shell-command-to-string - (format gnus-convert-pbm-to-x-face-command - (shell-quote-argument file)))))) + (gnus--random-face-with-type + gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files + (lambda (file) + (gnus-shell-command-to-string + (format gnus-convert-pbm-to-x-face-command + (shell-quote-argument file)))))) ;;;###autoload (defun gnus-insert-random-x-face-header () @@ -205,12 +206,11 @@ different input formats." (defun gnus-convert-face-to-png (face) "Convert FACE (which is base64-encoded) to a PNG. The PNG is returned as a string." - (let ((face (gnus-base64-repad face nil nil t))) - (mm-with-unibyte-buffer - (insert face) - (ignore-errors - (base64-decode-region (point-min) (point-max))) - (buffer-string)))) + (mm-with-unibyte-buffer + (insert face) + (ignore-errors + (base64-decode-region (point-min) (point-max))) + (buffer-string))) ;;;###autoload (defun gnus-convert-png-to-face (file) @@ -231,8 +231,8 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to Files matching `gnus-face-omit-files' are not considered." (interactive) (gnus--random-face-with-type gnus-face-directory "\\.png$" - gnus-face-omit-files - 'gnus-convert-png-to-face)) + gnus-face-omit-files + 'gnus-convert-png-to-face)) ;;;###autoload (defun gnus-insert-random-face-header () @@ -277,7 +277,6 @@ colors of the displayed X-Faces." (defun gnus-grab-cam-x-face () "Grab a picture off the camera and make it into an X-Face." - (interactive) (shell-command "xawtv-remote snap ppm") (let ((file nil)) (while (null (setq file (directory-files "/tftpboot/sparky/tmp" @@ -289,13 +288,11 @@ colors of the displayed X-Faces." (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>%s | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface" file null-device) (current-buffer)) - ;;(sleep-for 3) (delete-file file) (buffer-string)))) (defun gnus-grab-cam-face () "Grab a picture off the camera and make it into an X-Face." - (interactive) (shell-command "xawtv-remote snap ppm") (let ((file nil) (tempfile (make-temp-file "gnus-face-" nil ".ppm")) @@ -312,7 +309,6 @@ colors of the displayed X-Faces." (gnus-fun-ppm-change-string)))) (setq result (gnus-face-from-file tempfile))) (delete-file file) - ;;(delete-file tempfile) ; FIXME why are we not deleting it?! result)) (defun gnus-fun-ppm-change-string () diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index 9ea9e100316..be57774fe96 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -125,7 +125,7 @@ callback for `gravatar-retrieve'." (defun gnus-treat-from-gravatar (&optional force) "Display gravatar in the From header. If gravatar is already displayed, remove it." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (if (memq 'from-gravatar gnus-article-wash-types) (gnus-delete-images 'from-gravatar) @@ -135,7 +135,7 @@ If gravatar is already displayed, remove it." (defun gnus-treat-mail-gravatar (&optional force) "Display gravatars in the Cc and To headers. If gravatars are already displayed, remove them." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (if (memq 'mail-gravatar gnus-article-wash-types) (gnus-delete-images 'mail-gravatar) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index e8b62a4133e..b1134397e55 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -589,8 +589,8 @@ simple manner." "\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 + "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 @@ -767,8 +767,8 @@ simple manner." (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 + "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 @@ -814,7 +814,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"] @@ -894,20 +894,20 @@ simple manner." ["Sort by real name" gnus-group-sort-selected-groups-by-real-name (not (gnus-topic-mode-p))]) ("Mark" - ["Mark group" gnus-group-mark-group + ["Toggle/Set mark" gnus-group-mark-group (and (gnus-group-group-name) (not (memq (gnus-group-group-name) gnus-group-marked)))] - ["Unmark group" gnus-group-unmark-group + ["Remove mark" gnus-group-unmark-group (and (gnus-group-group-name) (memq (gnus-group-group-name) gnus-group-marked))] - ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] - ["Mark regexp..." gnus-group-mark-regexp t] + ["Remove all marks" gnus-group-unmark-all-groups gnus-group-marked] + ["Mark by regexp..." gnus-group-mark-regexp t] ["Mark region" gnus-group-mark-region :active mark-active] ["Mark buffer" gnus-group-mark-buffer t] ["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 +1042,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 +1119,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]'). @@ -1160,7 +1160,7 @@ The following commands are available: (defun gnus-mouse-pick-group (e) "Enter the group under the mouse pointer." - (interactive "e") + (interactive "e" gnus-group-mode) (mouse-set-point e) (gnus-group-read-group nil)) @@ -1241,7 +1241,8 @@ Also see the `gnus-group-use-permanent-levels' variable." (or (gnus-group-default-level nil t) (gnus-group-default-list-level) - gnus-level-subscribed)))) + gnus-level-subscribed))) + gnus-group-mode) (unless level (setq level (car gnus-group-list-mode) unread (cdr gnus-group-list-mode))) @@ -1292,7 +1293,7 @@ Also see the `gnus-group-use-permanent-levels' variable." (defun gnus-group-list-level (level &optional all) "List groups on LEVEL. If ALL (the prefix), also list groups that have no unread articles." - (interactive "nList groups on level: \nP") + (interactive "nList groups on level: \nP" gnus-group-mode) (gnus-group-list-groups level all level)) (defun gnus-group-prepare-logic (group test) @@ -1864,9 +1865,9 @@ If FIRST-TOO, the current line is also eligible as a target." (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (eq (char-after) gnus-process-mark))) -(defun gnus-group-mark-group (n &optional unmark no-advance) +(defun gnus-group-mark-group (n &optional unmark no-advance no-toggle) "Mark the current group." - (interactive "p") + (interactive "p" gnus-group-mode) (let ((buffer-read-only nil) group) (while (and (> n 0) @@ -1876,28 +1877,38 @@ If FIRST-TOO, the current line is also eligible as a target." (beginning-of-line) (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (delete-char 1) - (if unmark - (progn - (setq gnus-group-marked (delete group gnus-group-marked)) - (insert-char ?\s 1 t)) - (setq gnus-group-marked - (cons group (delete group gnus-group-marked))) - (insert-char gnus-process-mark 1 t))) + (if (and gnus-process-mark-toggle (not no-toggle)) + (if (memq group gnus-group-marked) + (gnus-group-mark-update group t) + (gnus-group-mark-update group)) + (gnus-group-mark-update group unmark))) (unless no-advance (gnus-group-next-group 1)) (cl-decf n)) (gnus-group-position-point) n)) +(defun gnus-group-mark-update (n &optional unmark) + "Set the process mark on current group and update the group line." + (if unmark + (progn + (setq gnus-group-marked + (delete n gnus-group-marked)) + (insert-char ?\s 1 t)) + (progn + (setq gnus-group-marked + (cons n (delete n gnus-group-marked))) + (insert-char gnus-process-mark 1 t)))) + (defun gnus-group-unmark-group (n) "Remove the mark from the current group." - (interactive "p") - (gnus-group-mark-group n 'unmark) + (interactive "p" gnus-group-mode) + (gnus-group-mark-group n 'unmark nil t) (gnus-group-position-point)) (defun gnus-group-unmark-all-groups () "Unmark all groups." - (interactive) + (interactive nil gnus-group-mode) (save-excursion (mapc #'gnus-group-remove-mark gnus-group-marked)) (gnus-group-position-point)) @@ -1905,21 +1916,21 @@ If FIRST-TOO, the current line is also eligible as a target." (defun gnus-group-mark-region (unmark beg end) "Mark all groups between point and mark. If UNMARK, remove the mark instead." - (interactive "P\nr") + (interactive "P\nr" gnus-group-mode) (let ((num (count-lines beg end))) (save-excursion (goto-char beg) - (- num (gnus-group-mark-group num unmark))))) + (- num (gnus-group-mark-group num unmark nil t))))) (defun gnus-group-mark-buffer (&optional unmark) "Mark all groups in the buffer. If UNMARK, remove the mark instead." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-mark-region unmark (point-min) (point-max))) (defun gnus-group-mark-regexp (regexp) "Mark all groups that match some regexp." - (interactive "sMark (regexp): ") + (interactive "sMark (regexp): " gnus-group-mode) (let ((alist (cdr gnus-newsrc-alist)) group) (save-excursion @@ -1934,7 +1945,7 @@ If UNMARK, remove the mark instead." Return nil if the group isn't displayed." (if (gnus-group-goto-group group nil test-marked) (save-excursion - (gnus-group-mark-group 1 'unmark t) + (gnus-group-mark-group 1 'unmark t t) t) (setq gnus-group-marked (delete group gnus-group-marked)) @@ -1944,7 +1955,7 @@ Return nil if the group isn't displayed." "Set the process mark on GROUP." (if (gnus-group-goto-group group) (save-excursion - (gnus-group-mark-group 1 nil t)) + (gnus-group-mark-group 1 nil t t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) (defun gnus-group-universal-argument (arg &optional _groups func) @@ -2028,7 +2039,7 @@ number of the earliest articles in the group. If the optional argument NO-ARTICLE is non-nil, no article will be auto-selected upon group entry. If GROUP is non-nil, fetch that group." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((no-display (eq all 0)) (group (or group (gnus-group-group-name))) number active marked entry) @@ -2062,7 +2073,7 @@ If ALL is a positive number, fetch this number of the latest articles in the group. If ALL is a negative number, fetch this number of the earliest articles in the group." - (interactive "P") + (interactive "P" gnus-group-mode) (when (and (eobp) (not (gnus-group-group-name))) (forward-line -1)) (gnus-group-read-group all t)) @@ -2081,7 +2092,7 @@ buffer. If GROUP is nil, use current group. This might be useful if you want to toggle threading before entering the group." - (interactive "P") + (interactive "P" gnus-group-mode) (require 'gnus-score) (let (gnus-visual gnus-score-find-score-files-function @@ -2092,7 +2103,7 @@ before entering the group." (defun gnus-group-visible-select-group (&optional all) "Select the current group without hiding any articles." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((gnus-inhibit-limiting t)) (gnus-group-read-group all t))) @@ -2101,7 +2112,7 @@ before entering the group." You will actually be entered into a group that's a copy of the current group; no changes you make while in this group will be permanent." - (interactive) + (interactive nil gnus-group-mode) (require 'gnus-score) (let* (gnus-visual gnus-score-find-score-files-function gnus-apply-kill-hook @@ -2175,7 +2186,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) @@ -2333,7 +2344,8 @@ specified by `gnus-gmane-group-download-format'." (list (gnus-group-completing-read "Gmane group") (read-number "Start article number: ") - (read-number "How many articles: "))) + (read-number "How many articles: ")) + gnus-group-mode) (unless range (setq range 500)) (when (< range 1) (error "Invalid range: %s" range)) @@ -2367,8 +2379,7 @@ Valid input formats include: ;; - The URLs should be added to `gnus-button-alist'. Probably we should ;; prompt the user to decide: "View via `browse-url' or in Gnus? " ;; (`gnus-read-ephemeral-gmane-group-url') - (interactive - (list (gnus-group-completing-read "Gmane URL"))) + (interactive (list (gnus-group-completing-read "Gmane URL")) gnus-group-mode) (let (group start range) (cond ;; URLs providing `group', `start' and `range': @@ -2461,7 +2472,8 @@ the ephemeral group." (with-temp-file tmpfile (mm-disable-multibyte) (dolist (id ids) - (let ((file (concat "~/.emacs.d/debbugs-cache/" id))) + (let ((file (expand-file-name id (locate-user-emacs-file + "debbugs-cache")))) (if (and (not gnus-plugged) (file-exists-p file)) (insert-file-contents file) @@ -2543,7 +2555,8 @@ If PROMPT (the prefix) is a number, use the prompt specified in (or (and (stringp gnus-group-jump-to-group-prompt) gnus-group-jump-to-group-prompt) (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) - (and (stringp p) p))))))) + (and (stringp p) p)))))) + gnus-group-mode) (when (equal group "") (error "Empty group name")) @@ -2612,7 +2625,7 @@ Return nil if GROUP is not found." If N is negative, search backward instead. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group n t nil silent)) (defun gnus-group-next-unread-group (n &optional all level silent) @@ -2624,7 +2637,7 @@ such group can be found, the next group with a level higher than LEVEL. Returns the difference between N and the number of skips actually made." - (interactive "p") + (interactive "p" gnus-group-mode) (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) @@ -2641,14 +2654,14 @@ made." "Go to previous N'th newsgroup. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group (- n) t)) (defun gnus-group-prev-unread-group (n) "Go to previous N'th unread newsgroup. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group (- n))) (defun gnus-group-next-unread-group-same-level (n) @@ -2656,7 +2669,7 @@ done." If N is negative, search backward instead. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group n t (gnus-group-group-level)) (gnus-group-position-point)) @@ -2664,14 +2677,14 @@ done." "Go to next N'th unread newsgroup on the same level. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-group-mode) (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) (gnus-group-position-point)) (defun gnus-group-best-unread-group (&optional exclude-group) "Go to the group with the highest level. If EXCLUDE-GROUP, do not go to that group." - (interactive) + (interactive nil gnus-group-mode) (goto-char (point-min)) (let ((best 100000) unread best-point) @@ -2711,7 +2724,7 @@ If EXCLUDE-GROUP, do not go to that group." (defun gnus-group-first-unread-group () "Go to the first group with unread articles." - (interactive) + (interactive nil gnus-group-mode) (prog1 (let ((opoint (point)) unread) @@ -2727,13 +2740,13 @@ If EXCLUDE-GROUP, do not go to that group." (defun gnus-group-enter-server-mode () "Jump to the server buffer." - (interactive) + (interactive nil gnus-group-mode) (gnus-enter-server-buffer)) (defun gnus-group-make-group-simple (&optional group) "Add a new newsgroup. The user will be prompted for GROUP." - (interactive (list (gnus-group-completing-read))) + (interactive (list (gnus-group-completing-read)) gnus-group-mode) (gnus-group-make-group (gnus-group-real-name group) (gnus-group-server group) nil nil)) @@ -2749,7 +2762,8 @@ server." (interactive (list (gnus-read-group "Group name: ") - (gnus-read-method "Select method for new group (use tab for completion)"))) + (gnus-read-method "Select method for new group (use tab for completion)")) + gnus-group-mode) (when (stringp method) (setq method (or (gnus-server-to-method method) method))) @@ -2794,7 +2808,7 @@ server." (defun gnus-group-delete-groups (&optional arg) "Delete the current group. Only meaningful with editable groups." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((n (length (gnus-group-process-prefix arg)))) (when (gnus-yes-or-no-p (if (= n 1) @@ -2809,8 +2823,8 @@ server." If OLDP (the prefix), only delete articles that are \"old\", according to the expiry settings. Note that this will delete old not-expirable articles, too." - (interactive (list (gnus-group-group-name) - current-prefix-arg)) + (interactive (list (gnus-group-group-name) current-prefix-arg) + gnus-group-mode) (let ((articles (gnus-uncompress-range (gnus-active group)))) (when (gnus-yes-or-no-p (format "Do you really want to delete these %d articles forever? " @@ -2829,9 +2843,8 @@ doing the deletion. Note that you also have to specify FORCE if you want the group to be removed from the server, even when it's empty." - (interactive - (list (gnus-group-group-name) - current-prefix-arg)) + (interactive (list (gnus-group-group-name) current-prefix-arg) + gnus-group-mode) (unless group (error "No group to delete")) (unless (gnus-check-backend-function 'request-delete-group group) @@ -2865,7 +2878,8 @@ and NEW-NAME will be prompted for." "Rename group to: " (gnus-group-real-name group)) method (gnus-info-method (gnus-get-info group))) - (list group (gnus-group-prefixed-name new-name method)))) + (list group (gnus-group-prefixed-name new-name method))) + gnus-group-mode) (unless (gnus-check-backend-function 'request-rename-group group) (error "This back end does not support renaming groups")) @@ -2911,7 +2925,7 @@ and NEW-NAME will be prompted for." (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (let ((part (or part 'info)) info) (unless group @@ -2950,12 +2964,12 @@ and NEW-NAME will be prompted for." (defun gnus-group-edit-group-method (group) "Edit the select method of GROUP." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (gnus-group-edit-group group 'method)) (defun gnus-group-edit-group-parameters (group) "Edit the group parameters of GROUP." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (gnus-group-edit-group group 'params)) (defun gnus-group-edit-group-done (part group form) @@ -2993,14 +3007,16 @@ and NEW-NAME will be prompted for." (defun gnus-group-make-useful-group (group method) "Create one of the groups described in `gnus-useful-groups'." (interactive - (let ((entry (assoc (gnus-completing-read "Create group" - (mapcar #'car gnus-useful-groups) - t) + (let ((entry (assoc (gnus-completing-read + "Create group" + (mapcar #'car gnus-useful-groups) + t) gnus-useful-groups))) (list (cadr entry) - ;; Don't use `caddr' here since macros within the `interactive' - ;; form won't be expanded. - (car (cddr entry))))) + ;; Don't use `caddr' here since macros within the + ;; `interactive' form won't be expanded. + (car (cddr entry)))) + gnus-group-mode) (setq method (copy-tree method)) (let (entry) (while (setq entry (memq (assq 'eval method) method)) @@ -3014,7 +3030,7 @@ group already exists: - if not given, and error is signaled, - if t, stay silent, - if anything else, just print a message." - (interactive) + (interactive nil gnus-group-mode) (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) (file (nnheader-find-etc-directory "gnus-tut.txt" t))) (if (gnus-group-entry name) @@ -3040,9 +3056,9 @@ group already exists: "Create a group that uses a single file as the source. If called with a prefix argument, ask for the file type." - (interactive - (list (read-file-name "File name: ") - (and current-prefix-arg 'ask))) + (interactive (list (read-file-name "File name: ") + (and current-prefix-arg 'ask)) + gnus-group-mode) (when (eq type 'ask) (let ((err "") char found) @@ -3077,7 +3093,7 @@ If called with a prefix argument, ask for the file type." (defun gnus-group-make-web-group (&optional solid) "Create an ephemeral nnweb group. If SOLID (the prefix), create a solid group." - (interactive "P") + (interactive "P" gnus-group-mode) (require 'nnweb) (let* ((group (if solid (gnus-read-group "Group name: ") @@ -3117,7 +3133,7 @@ If SOLID (the prefix), create a solid group." (defun gnus-group-make-rss-group (&optional url) "Given a URL, discover if there is an RSS feed. If there is, use Gnus to create an nnrss group" - (interactive) + (interactive nil gnus-group-mode) (require 'nnrss) (if (not url) (setq url (read-from-minibuffer "URL to Search for RSS: "))) @@ -3158,8 +3174,8 @@ If there is, use Gnus to create an nnrss group" The user will be prompted for a directory. The contents of this directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." - (interactive - (list (read-directory-name "Create group from directory: "))) + (interactive (list (read-directory-name "Create group from directory: ")) + gnus-group-mode) (unless (file-exists-p dir) (error "No such directory")) (unless (file-directory-p dir) @@ -3192,7 +3208,7 @@ prefix arg NO-PARSE means that Gnus should not parse the search query before passing it to the underlying search engine. A non-nil SPECS arg must be an alist with `search-query-spec' and `search-group-spec' keys, and skips all prompting." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((name (gnus-read-group "Group name: "))) (with-current-buffer gnus-group-buffer (let* ((group-spec @@ -3246,7 +3262,7 @@ prefix arg NO-PARSE means that Gnus should not parse the search query before passing it to the underlying search engine. A non-nil SPECS arg must be an alist with `search-query-spec' and `search-group-spec' keys, and skips all prompting." - (interactive "P") + (interactive "P" gnus-group-mode) (let* ((group-spec (or (cdr (assq 'search-group-spec specs)) (cdr (assq 'nnir-group-spec specs)) @@ -3286,10 +3302,10 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." - (interactive - (list current-prefix-arg - (gnus-group-completing-read "Add to virtual group" - nil t "nnvirtual:"))) + (interactive (list current-prefix-arg + (gnus-group-completing-read "Add to virtual group" + nil t "nnvirtual:")) + gnus-group-mode) (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) (error "%s is not an nnvirtual group" vgroup)) (gnus-close-group vgroup) @@ -3307,7 +3323,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-make-empty-virtual (group) "Create a new, fresh, empty virtual group." - (interactive "sCreate new, empty virtual group: ") + (interactive "sCreate new, empty virtual group: " gnus-group-mode) (let* ((method (list 'nnvirtual "^$")) (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. @@ -3321,7 +3337,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-enter-directory (dir) "Enter an ephemeral nneething group." - (interactive "DDirectory to read: ") + (interactive "DDirectory to read: " gnus-group-mode) (let* ((method (list 'nneething dir '(nneething-read-only t))) (leaf (gnus-group-prefixed-name (file-name-nondirectory (directory-file-name dir)) @@ -3336,7 +3352,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-expunge-group (group) "Expunge deleted articles in current nnimap GROUP." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (let ((method (gnus-find-method-for-group group))) (if (not (gnus-check-backend-function 'request-expunge-group (car method))) @@ -3348,7 +3364,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (defun gnus-group-nnimap-edit-acl (group) "Edit the Access Control List of current nnimap GROUP." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (let ((mailbox (gnus-group-real-name group)) method acl) (unless group (error "No group on current line")) @@ -3395,7 +3411,8 @@ Editing the access control list for `%s'. When used interactively, the sorting function used will be determined by the `gnus-group-sort-function' variable. If REVERSE (the prefix), reverse the sorting order." - (interactive (list gnus-group-sort-function current-prefix-arg)) + (interactive (list gnus-group-sort-function current-prefix-arg) + gnus-group-mode) (funcall gnus-group-sort-alist-function (gnus-make-sort-function func) reverse) (gnus-group-unmark-all-groups) @@ -3428,56 +3445,57 @@ value is disregarded." (defun gnus-group-sort-groups-by-alphabet (&optional reverse) "Sort the group buffer alphabetically by group name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) (defun gnus-group-sort-groups-by-real-name (&optional reverse) "Sort the group buffer alphabetically by real (unprefixed) group name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse)) (defun gnus-group-sort-groups-by-unread (&optional reverse) "Sort the group buffer by number of unread articles. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) (defun gnus-group-sort-groups-by-level (&optional reverse) "Sort the group buffer by group level. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) (defun gnus-group-sort-groups-by-score (&optional reverse) "Sort the group buffer by group score. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) (defun gnus-group-sort-groups-by-rank (&optional reverse) "Sort the group buffer by group rank. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) (defun gnus-group-sort-groups-by-method (&optional reverse) "Sort the group buffer alphabetically by back end name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) (defun gnus-group-sort-groups-by-server (&optional reverse) "Sort the group buffer alphabetically by server name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-sort-groups 'gnus-group-sort-by-server reverse)) ;;; Selected group sorting. (defun gnus-group-sort-selected-groups (n func &optional reverse) "Sort the process/prefixed groups." - (interactive (list current-prefix-arg gnus-group-sort-function)) + (interactive (list current-prefix-arg gnus-group-sort-function) + gnus-group-mode) (let ((groups (gnus-group-process-prefix n))) (funcall gnus-group-sort-selected-function groups (gnus-make-sort-function func) reverse) @@ -3509,49 +3527,49 @@ If REVERSE is non-nil, reverse the sorting." "Sort the group buffer alphabetically by group name. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse)) (defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse) "Sort the group buffer alphabetically by real group name. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse)) (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse) "Sort the group buffer by number of unread articles. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse)) (defun gnus-group-sort-selected-groups-by-level (&optional n reverse) "Sort the group buffer by group level. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse)) (defun gnus-group-sort-selected-groups-by-score (&optional n reverse) "Sort the group buffer by group score. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse)) (defun gnus-group-sort-selected-groups-by-rank (&optional n reverse) "Sort the group buffer by group rank. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse)) (defun gnus-group-sort-selected-groups-by-method (&optional n reverse) "Sort the group buffer alphabetically by back end name. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-group-mode) (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse)) ;;; Sorting predicates. @@ -3609,7 +3627,7 @@ sort in reverse order." (defun gnus-group-clear-data (&optional arg) "Clear all marks and read ranges from the current group. Obeys the process/prefix convention." - (interactive "P") + (interactive "P" gnus-group-mode) (when (gnus-y-or-n-p "Really clear data? ") (gnus-group-iterate arg (lambda (group) @@ -3621,7 +3639,7 @@ Obeys the process/prefix convention." (defun gnus-group-clear-data-on-native-groups () "Clear all marks and read ranges from all native groups." - (interactive) + (interactive nil gnus-group-mode) (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ") (let ((alist (cdr gnus-newsrc-alist)) info) @@ -3665,7 +3683,7 @@ caught up. If ALL is non-nil, marked articles will also be marked as read. Cross references (Xref: header) of articles are ignored. The number of newsgroups that this function was unable to catch up is returned." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((groups (gnus-group-process-prefix n)) (ret 0) group) @@ -3704,7 +3722,7 @@ up is returned." (defun gnus-group-catchup-current-all (&optional n) "Mark all articles in current newsgroup as read. Cross references (Xref: header) of articles are ignored." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-catchup-current n 'all)) (declare-function gnus-sequence-of-unread-articles "gnus-sum" (group)) @@ -3751,7 +3769,7 @@ or nil if no action could be taken." (defun gnus-group-expire-articles (&optional n) "Expire all expirable articles in the current newsgroup. Uses the process/prefix convention." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((groups (gnus-group-process-prefix n)) group) (unless groups @@ -3797,7 +3815,7 @@ Uses the process/prefix convention." (defun gnus-group-expire-all-groups () "Expire all expirable articles in all newsgroups." - (interactive) + (interactive nil gnus-group-mode) (save-excursion (gnus-message 5 "Expiring...") (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) @@ -3821,7 +3839,8 @@ Uses the process/prefix convention." (if (string-match "^\\s-*$" s) (int-to-string (or (gnus-group-group-level) gnus-level-default-subscribed)) - s)))))) + s))))) + gnus-group-mode) (unless (and (>= level 1) (<= level gnus-level-killed)) (error "Invalid level: %d" level)) (dolist (group (gnus-group-process-prefix n)) @@ -3837,61 +3856,91 @@ Uses the process/prefix convention." (defun gnus-group-unsubscribe (&optional n) "Unsubscribe the current group." - (interactive "P") - (gnus-group-unsubscribe-current-group n 'unsubscribe)) + (interactive "P" gnus-group-mode) + (gnus-group-set-subscription-at-point n 'unsubscribe)) (defun gnus-group-subscribe (&optional n) "Subscribe the current group." - (interactive "P") - (gnus-group-unsubscribe-current-group n 'subscribe)) + (interactive "P" gnus-group-mode) + (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") -(defun gnus-group-unsubscribe-current-group (&optional n do-sub) +(make-obsolete 'gnus-group-unsubscribe-group + 'gnus-group-toggle-subscription "28.1") + +(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") + (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. +(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." - (interactive (list (gnus-group-completing-read - nil nil (gnus-read-active-file-p)))) (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) @@ -3905,7 +3954,7 @@ group line." "Move the current newsgroup up N places. If given a negative prefix, move down instead. The difference between N and the number of steps taken is returned." - (interactive "p") + (interactive "p" gnus-group-mode) (unless (gnus-group-group-name) (error "No group on current line")) (gnus-group-kill-group 1) @@ -3917,7 +3966,8 @@ N and the number of steps taken is returned." (defun gnus-group-kill-all-zombies (&optional dummy) "Kill all zombie newsgroups. The optional DUMMY should always be nil." - (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? ")))) + (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? "))) + gnus-group-mode) (unless dummy (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) (setq gnus-zombie-list nil) @@ -3927,7 +3977,7 @@ The optional DUMMY should always be nil." (defun gnus-group-kill-region (begin end) "Kill newsgroups in current region (excluding current point). The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." - (interactive "r") + (interactive "r" gnus-group-mode) (let ((lines ;; Count lines. (save-excursion @@ -3949,7 +3999,7 @@ However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. The return value is the name of the group that was killed, or a list of groups killed." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((buffer-read-only nil) (groups (gnus-group-process-prefix n)) group entry level out) @@ -4009,7 +4059,7 @@ of groups killed." 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." - (interactive "p") + (interactive "p" gnus-group-mode) (setq arg (or arg 1)) (let (info group prev out) (while (>= (cl-decf arg) 0) @@ -4034,7 +4084,7 @@ yanked) a list of yanked groups is returned." (defun gnus-group-kill-level (level) "Kill all groups that is on a certain LEVEL." - (interactive "nKill all groups on level: ") + (interactive "nKill all groups on level: " gnus-group-mode) (cond ((= level gnus-level-zombie) (setq gnus-killed-list @@ -4065,7 +4115,7 @@ yanked) a list of yanked groups is returned." "List all newsgroups with level ARG or lower. Default is `gnus-level-unsubscribed', which lists all subscribed and most unsubscribed groups." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) ;; Redefine this to list ALL killed groups if prefix arg used. @@ -4074,7 +4124,7 @@ unsubscribed groups." "List all killed newsgroups in the group buffer. If ARG is non-nil, list ALL killed groups known to Gnus. This may entail asking the server for the groups." - (interactive "P") + (interactive "P" gnus-group-mode) ;; Find all possible killed newsgroups if arg. (when arg (gnus-get-killed-groups)) @@ -4088,7 +4138,7 @@ entail asking the server for the groups." (defun gnus-group-list-zombies () "List all zombie newsgroups in the group buffer." - (interactive) + (interactive nil gnus-group-mode) (if (not gnus-zombie-list) (gnus-message 6 "No zombie groups") (let (gnus-group-list-mode) @@ -4099,7 +4149,7 @@ entail asking the server for the groups." (defun gnus-group-list-active () "List all groups that are available from the server(s)." - (interactive) + (interactive nil gnus-group-mode) ;; First we make sure that we have really read the active file. (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t) @@ -4121,7 +4171,7 @@ entail asking the server for the groups." (defun gnus-activate-all-groups (level) "Activate absolutely all groups." - (interactive (list gnus-level-unsubscribed)) + (interactive (list gnus-level-unsubscribed) gnus-group-mode) (let ((gnus-activate-level level) (gnus-activate-foreign-newsgroups level)) (gnus-group-get-new-news))) @@ -4133,7 +4183,7 @@ re-scanning. If ARG is non-nil and not a number, this will force \"hard\" re-reading of the active files from all servers. If ONE-LEVEL is not nil, then re-scan only the specified level, otherwise all levels below ARG will be scanned too." - (interactive "P") + (interactive "P" gnus-group-mode) (require 'nnmail) (let ((gnus-inhibit-demon t) ;; Binding this variable will inhibit multiple fetchings @@ -4163,7 +4213,7 @@ otherwise all levels below ARG will be scanned too." The difference between N and the number of newsgroup checked is returned. If N is negative, this group and the N-1 previous groups will be checked. If DONT-SCAN is non-nil, scan non-activated groups as well." - (interactive "P") + (interactive "P" gnus-group-mode) (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) (beg (unless n @@ -4208,7 +4258,8 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." - (interactive (list current-prefix-arg (gnus-group-group-name))) + (interactive (list current-prefix-arg (gnus-group-group-name)) + gnus-group-mode) (let* ((method (gnus-find-method-for-group group)) (mname (gnus-group-prefixed-name "" method)) desc) @@ -4230,7 +4281,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. (defun gnus-group-describe-all-groups (&optional force) "Pop up a buffer with descriptions of all newsgroups." - (interactive "P") + (interactive "P" gnus-group-mode) (when force (setq gnus-description-hashtb nil)) (when (not (or gnus-description-hashtb @@ -4255,7 +4306,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." ;; Suggested by Daniel Quinlan <quinlan@best.com>. (defun gnus-group-apropos (regexp &optional search-description) "List all newsgroups that have names that match a regexp." - (interactive "sGnus apropos (regexp): ") + (interactive "sGnus apropos (regexp): " gnus-group-mode) (let ((prev "") (obuf (current-buffer)) groups des) @@ -4294,7 +4345,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (defun gnus-group-description-apropos (regexp) "List all newsgroups that have names or descriptions that match REGEXP." - (interactive "sGnus description apropos (regexp): ") + (interactive "sGnus description apropos (regexp): " gnus-group-mode) (when (not (or gnus-description-hashtb (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) @@ -4309,7 +4360,7 @@ If ALL, also list groups with no unread articles. If LOWEST, don't list groups with level lower than LOWEST. This command may read the active file." - (interactive "P\nsList newsgroups matching: ") + (interactive "P\nsList newsgroups matching: " gnus-group-mode) ;; First make sure active file has been read. (when (and level (> (prefix-numeric-value level) gnus-level-killed)) @@ -4324,7 +4375,7 @@ This command may read the active file." If the prefix LEVEL is non-nil, it should be a number that says which level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST." - (interactive "P\nsList newsgroups matching: ") + (interactive "P\nsList newsgroups matching: " gnus-group-mode) (when level (setq level (prefix-numeric-value level))) (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) @@ -4333,12 +4384,12 @@ If LOWEST, don't list groups with level lower than LOWEST." (defun gnus-group-save-newsrc (&optional force) "Save the Gnus startup files. If FORCE, force saving whether it is necessary or not." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-save-newsrc-file force)) (defun gnus-group-restart (&optional _arg) "Force Gnus to read the .newsrc file." - (interactive) + (interactive nil gnus-group-mode) (when (gnus-yes-or-no-p (format "Are you sure you want to restart Gnus? ")) (gnus-save-newsrc-file) @@ -4347,7 +4398,7 @@ If FORCE, force saving whether it is necessary or not." (defun gnus-group-read-init-file () "Read the Gnus elisp init file." - (interactive) + (interactive nil gnus-group-mode) (gnus-read-init-file) (gnus-message 5 "Read %s" gnus-init-file)) @@ -4355,7 +4406,7 @@ If FORCE, force saving whether it is necessary or not." "Check bogus newsgroups. If given a prefix, don't ask for confirmation before removing a bogus group." - (interactive "P") + (interactive "P" gnus-group-mode) (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) (gnus-group-list-groups)) @@ -4366,7 +4417,7 @@ With 1 C-u, 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 for new groups, and subscribe the new groups as zombies." - (interactive "p") + (interactive "p" gnus-group-mode) (let ((new-groups (gnus-find-new-newsgroups (or arg 1))) current-group) (gnus-group-list-groups) @@ -4379,7 +4430,7 @@ for new groups, and subscribe the new groups as zombies." (defun gnus-group-edit-global-kill (&optional article group) "Edit the global kill file. If GROUP, edit that local kill file instead." - (interactive "P") + (interactive "P" gnus-group-mode) (setq gnus-current-kill-article article) (gnus-kill-file-edit-file group) (gnus-message 6 "Editing a %s kill file (Type %s to exit)" @@ -4388,12 +4439,12 @@ If GROUP, edit that local kill file instead." (defun gnus-group-edit-local-kill (article group) "Edit a local kill file." - (interactive (list nil (gnus-group-group-name))) + (interactive (list nil (gnus-group-group-name)) gnus-group-mode) (gnus-group-edit-global-kill article group)) (defun gnus-group-force-update () "Update `.newsrc' file." - (interactive) + (interactive nil gnus-group-mode) (gnus-save-newsrc-file)) (defvar gnus-backlog-articles) @@ -4402,7 +4453,7 @@ If GROUP, edit that local kill file instead." "Suspend the current Gnus session. In fact, cleanup buffers except for group mode buffer. The hook `gnus-suspend-gnus-hook' is called before actually suspending." - (interactive) + (interactive nil gnus-group-mode) (gnus-run-hooks 'gnus-suspend-gnus-hook) (gnus-offer-save-summaries) ;; Kill Gnus buffers except for group mode buffer. @@ -4425,14 +4476,14 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending." (defun gnus-group-clear-dribble () "Clear all information from the dribble buffer." - (interactive) + (interactive nil gnus-group-mode) (gnus-dribble-clear) (gnus-message 7 "Cleared dribble buffer")) (defun gnus-group-exit () "Quit reading news after updating .newsrc.eld and .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) + (interactive nil gnus-group-mode) (when (or noninteractive ;For gnus-batch-kill (not gnus-interactive-exit) ;Without confirmation @@ -4466,7 +4517,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (defun gnus-group-quit () "Quit reading news without updating .newsrc.eld or .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) + (interactive nil gnus-group-mode) (when (or noninteractive ;For gnus-batch-kill (zerop (buffer-size)) (not (gnus-server-opened gnus-select-method)) @@ -4491,7 +4542,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (defun gnus-group-describe-briefly () "Give a one line description of the group mode commands." - (interactive) + (interactive nil gnus-group-mode) (gnus-message 7 "%s" (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) (defun gnus-group-browse-foreign-server (method) @@ -4504,7 +4555,7 @@ and the second element is the address." (list (let ((how (gnus-completing-read "Which back end" (mapcar #'car (append gnus-valid-select-methods - gnus-server-alist)) + gnus-server-alist)) t (cons "nntp" 0) 'gnus-method-history))) ;; We either got a back end name or a virtual server name. ;; If the first, we also need an address. @@ -4520,7 +4571,8 @@ and the second element is the address." gnus-secondary-servers (cdr gnus-select-method)))) ;; We got a server name. - how)))) + how))) + gnus-group-mode) (gnus-browse-foreign-server method)) (defun gnus-group-set-info (info &optional method-only-group part) @@ -4678,27 +4730,27 @@ level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST. This command may read the active file." - (interactive "P") + (interactive "P" gnus-group-mode) (when level (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) (gnus-cache-open)) (funcall gnus-group-prepare-function (or level gnus-level-subscribed) - #'(lambda (info) - (let ((marks (gnus-info-marks info))) - (assq 'cache marks))) + (lambda (info) + (let ((marks (gnus-info-marks info))) + (assq 'cache marks))) lowest - #'(lambda (group) - (or (gethash group - gnus-cache-active-hashtb) - ;; Cache active file might use "." - ;; instead of ":". - (gethash - (mapconcat #'identity - (split-string group ":") - ".") - gnus-cache-active-hashtb)))) + (lambda (group) + (or (gethash group + gnus-cache-active-hashtb) + ;; Cache active file might use "." + ;; instead of ":". + (gethash + (mapconcat #'identity + (split-string group ":") + ".") + gnus-cache-active-hashtb)))) (goto-char (point-min)) (gnus-group-position-point)) @@ -4709,16 +4761,16 @@ level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST. This command may read the active file." - (interactive "P") + (interactive "P" gnus-group-mode) (when level (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) (gnus-cache-open)) (funcall gnus-group-prepare-function (or level gnus-level-subscribed) - #'(lambda (info) - (let ((marks (gnus-info-marks info))) - (assq 'dormant marks))) + (lambda (info) + (let ((marks (gnus-info-marks info))) + (assq 'dormant marks))) lowest 'ignore) (goto-char (point-min)) @@ -4731,16 +4783,16 @@ level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST. This command may read the active file." - (interactive "P") + (interactive "P" gnus-group-mode) (when level (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) (gnus-cache-open)) (funcall gnus-group-prepare-function (or level gnus-level-subscribed) - #'(lambda (info) - (let ((marks (gnus-info-marks info))) - (assq 'tick marks))) + (lambda (info) + (let ((marks (gnus-info-marks info))) + (assq 'tick marks))) lowest 'ignore) (goto-char (point-min)) @@ -4759,7 +4811,7 @@ This command may read the active file." (defun gnus-group-list-plus (&optional _args) "List groups plus the current selection." - (interactive) + (interactive nil gnus-group-mode) (let ((gnus-group-listed-groups (gnus-group-listed-groups)) (gnus-group-list-mode gnus-group-list-mode) ;; Save it. func) @@ -4775,7 +4827,7 @@ This command may read the active file." (defun gnus-group-list-flush (&optional args) "Flush groups from the current selection." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((gnus-group-list-option 'flush)) (gnus-group-list-plus args))) @@ -4786,7 +4838,7 @@ with this command. If you've first limited to groups with dormant articles with `A ?', you can then further limit with `A / c', which will then limit to groups with cached articles, giving you the groups that have both dormant articles and cached articles." - (interactive "P") + (interactive "P" gnus-group-mode) (let ((gnus-group-list-option 'limit)) (gnus-group-list-plus args))) @@ -4839,7 +4891,7 @@ operation is only meaningful for back ends using one file per article \(e.g. nnml). Note: currently only implemented in nnml." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-group-mode) (unless group (error "No group to compact")) (unless (gnus-check-backend-function 'request-compact-group group) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 9811e8b440f..5294b83d9e9 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -222,28 +222,32 @@ (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)) (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 +256,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 +275,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. @@ -970,7 +978,7 @@ These will be used to retrieve the RSVP information from ical events." (defun gnus-icalendar-save-event () "Save the Calendar event in the text/calendar part under point." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (when data @@ -978,28 +986,28 @@ These will be used to retrieve the RSVP information from ical events." (defun gnus-icalendar-reply-accept () "Accept invitation in the current article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event)) (setq-local gnus-icalendar-reply-status 'accepted))) (defun gnus-icalendar-reply-tentative () "Send tentative response to invitation in the current article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event)) (setq-local gnus-icalendar-reply-status 'tentative))) (defun gnus-icalendar-reply-decline () "Decline invitation in the current article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event)) (setq-local gnus-icalendar-reply-status 'declined))) (defun gnus-icalendar-event-export () "Export calendar event to `org-mode', or update existing agenda entry." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (gnus-icalendar-sync-event-to-org gnus-icalendar-event)) ;; refresh article buffer in case the reply had been sent before initial org @@ -1009,14 +1017,14 @@ These will be used to retrieve the RSVP information from ical events." (defun gnus-icalendar-event-show () "Display `org-mode' agenda entry related to the calendar event." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-icalendar--show-org-event (with-current-buffer gnus-article-buffer gnus-icalendar-event))) (defun gnus-icalendar-event-check-agenda () "Display `org-mode' agenda for days between event start and end dates." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-icalendar-show-org-agenda (with-current-buffer gnus-article-buffer gnus-icalendar-event))) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 64928623e6a..01053797b3a 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -662,7 +662,7 @@ This is the string that Gnus uses to identify the group." "Look up the current article in the group where it originated. This command only makes sense for groups shows articles gathered from other groups -- for instance, search results and the like." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) (or diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index b0e6cb59d52..525823e72ce 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -337,7 +337,7 @@ Returns the number of articles marked as read." (gnus-newsgroup-kill-file gnus-newsgroup-name))) (unreads (length gnus-newsgroup-unreads)) (gnus-summary-inhibit-highlight t) - beg) + ) ;; beg (setq gnus-newsgroup-kill-headers nil) ;; If there are any previously scored articles, we remove these ;; from the `gnus-newsgroup-headers' list that the score functions @@ -381,7 +381,7 @@ Returns the number of articles marked as read." (gnus-set-mode-line 'summary) - (if beg + (if nil ;; beg (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) (or (eq nunreads 0) (gnus-message 6 "Marked %d articles as read" nunreads)) @@ -435,7 +435,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-mh.el b/lisp/gnus/gnus-mh.el index fc8d9be8d6d..df076c11759 100644 --- a/lisp/gnus/gnus-mh.el +++ b/lisp/gnus/gnus-mh.el @@ -53,7 +53,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-folder)) (gnus-summary-save-article arg))) diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index d42f0971259..6adda2ed147 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -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 45e665be8c3..ef89e6e9fcb 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -143,9 +143,6 @@ See Info node `(gnus)Posting Styles'." :group 'gnus-message :type 'boolean) -(make-obsolete-variable 'gnus-inews-mark-gcc-as-read - 'gnus-gcc-mark-as-read "Emacs 22.1") - (defcustom gnus-gcc-externalize-attachments nil "Should local-file attachments be included as external parts in Gcc copies? If it is `all', attach files as external parts; @@ -418,11 +415,12 @@ only affect the Gcc copy, but not the original message." gnus-article-reply))) (,oarticle gnus-article-reply) (,yanked gnus-article-yanked-articles) - (,group (when gnus-article-reply - (or (nnselect-article-group - (or (car-safe gnus-article-reply) - gnus-article-reply)) - gnus-newsgroup-name))) + (,group (if gnus-article-reply + (or (nnselect-article-group + (or (car-safe gnus-article-reply) + gnus-article-reply)) + gnus-newsgroup-name) + gnus-newsgroup-name)) (message-header-setup-hook (copy-sequence message-header-setup-hook)) (mbl mml-buffer-list) @@ -609,8 +607,6 @@ instead." If ARG, use the group under the point to find a posting style. If ARG is 1, prompt for a group name to find the posting style." (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) @@ -634,8 +630,6 @@ This function prepares a news even when using mail groups. This is useful for posting messages to mail groups without actually sending them over the network. The corresponding back end must have a `request-post' method." (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) @@ -657,7 +651,7 @@ network. The corresponding back end must have a `request-post' method." If ARG, post to group under point. If ARG is 1, prompt for group name. Depending on the selected group, the message might be either a mail or a news." - (interactive "P") + (interactive "P" gnus-group-mode) ;; Bind this variable here to make message mode hooks work ok. (let ((gnus-newsgroup-name (if arg @@ -676,9 +670,7 @@ a news." Use the posting of the current group by default. If ARG, don't do that. If ARG is 1, prompt for group name to find the posting style." - (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. + (interactive "P" gnus-summary-mode) (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) @@ -701,9 +693,7 @@ If ARG, don't do that. If ARG is 1, prompt for group name to post to. This function prepares a news even when using mail groups. This is useful for posting messages to mail groups without actually sending them over the network. The corresponding back end must have a `request-post' method." - (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. + (interactive "P" gnus-summary-mode) (let* (;;(group gnus-newsgroup-name) ;; make sure last viewed article doesn't affect posting styles: (gnus-article-copy) @@ -730,7 +720,7 @@ network. The corresponding back end must have a `request-post' method." If ARG, don't do that. If ARG is 1, prompt for a group name to post to. Depending on the selected group, the message might be either a mail or a news." - (interactive "P") + (interactive "P" gnus-summary-mode) ;; Bind this variable here to make message mode hooks work ok. (let ((gnus-newsgroup-name (if arg @@ -750,9 +740,9 @@ If prefix argument YANK is non-nil, the original article is yanked automatically. YANK is a list of elements, where the car of each element is the article number, and the cdr is the string to be yanked." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (when yank (gnus-summary-goto-subject (if (listp (car yank)) @@ -772,19 +762,19 @@ article number, and the cdr is the string to be yanked." "Compose a followup to an article and include the original article. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-followup (gnus-summary-work-articles n) force-news)) (defun gnus-summary-followup-to-mail (&optional arg) "Followup to the current mail message via news." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (gnus-summary-followup arg t)) (defun gnus-summary-followup-to-mail-with-original (&optional arg) "Followup to the current mail message via news." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-followup (gnus-summary-work-articles arg) t)) (defun gnus-inews-yank-articles (articles) @@ -819,7 +809,7 @@ active, the entire article will be yanked." Uses the process-prefix convention. If given the symbolic prefix `a', cancel using the standard posting method; if not post using the current select method." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-summary-mode) (let ((message-post-method (let ((gn gnus-newsgroup-name)) (lambda (_arg) (gnus-post-method (eq symp 'a) gn)))) @@ -849,7 +839,7 @@ post using the current select method." "Compose an article that will supersede a previous article. This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." - (interactive) + (interactive nil gnus-summary-mode) (let ((article (gnus-summary-article-number)) (mail-parse-charset gnus-newsgroup-charset)) (gnus-setup-message 'reply-yank @@ -1088,7 +1078,6 @@ If SILENT, don't prompt the user." (defun gnus-extended-version () "Stringified Gnus version and Emacs version. See the variable `gnus-user-agent'." - (interactive) (if (stringp gnus-user-agent) gnus-user-agent ;; `gnus-user-agent' is a list: @@ -1117,9 +1106,9 @@ If prefix argument YANK is non-nil, the original article is yanked automatically. If WIDE, make a wide reply. If VERY-WIDE, make a very wide reply." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) ;; Allow user to require confirmation before replying by mail to the ;; author of a news article (or mail message). (when (or (not (or (gnus-news-group-p gnus-newsgroup-name) @@ -1187,14 +1176,14 @@ If VERY-WIDE, make a very wide reply." (defun gnus-summary-reply-with-original (n &optional wide) "Start composing a reply mail to the current message. The original article will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-reply (gnus-summary-work-articles n) wide)) (defun gnus-summary-reply-to-list-with-original (n &optional wide) "Start composing a reply mail to the current message. The reply goes only to the mailing list. The original article will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((message-reply-to-function (lambda nil `((To . ,(gnus-mailing-list-followup-to)))))) @@ -1206,32 +1195,32 @@ If prefix argument YANK is non-nil, the original article is yanked automatically. If WIDE, make a wide reply. If VERY-WIDE, make a very wide reply." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (let ((gnus-msg-force-broken-reply-to t)) (gnus-summary-reply yank wide very-wide))) (defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide) "Like `gnus-summary-reply-with-original' except removing reply-to field. The original article will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide)) (defun gnus-summary-wide-reply (&optional yank) "Start composing a wide reply mail to the current message. If prefix argument YANK is non-nil, the original article is yanked automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (gnus-summary-reply yank t)) (defun gnus-summary-wide-reply-with-original (n) "Start composing a wide reply mail to the current message. The original article(s) will be yanked. Uses the process/prefix convention." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-reply-with-original n t)) (defun gnus-summary-very-wide-reply (&optional yank) @@ -1244,9 +1233,9 @@ messages as the To/Cc headers. If prefix argument YANK is non-nil, the original article(s) will be yanked automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) + (interactive (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) (gnus-summary-reply yank t (gnus-summary-work-articles yank))) (defun gnus-summary-very-wide-reply-with-original (n) @@ -1258,7 +1247,7 @@ The reply will include all From/Cc headers from the original messages as the To/Cc headers. The original article(s) will be yanked." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-reply (gnus-summary-work-articles n) t (gnus-summary-work-articles n))) @@ -1274,7 +1263,7 @@ otherwise, use flipped `message-forward-as-mime'. If POST, post instead of mail. For the \"inline\" alternatives, also see the variable `message-forward-ignored-headers'." - (interactive "P") + (interactive "P" gnus-summary-mode) (if (cdr (gnus-summary-work-articles nil)) ;; Process marks are given. (gnus-uu-digest-mail-forward nil post) @@ -1334,7 +1323,7 @@ For the \"inline\" alternatives, also see the variable ((stringp self) (insert "Gcc: " (encode-coding-string - (if (string-match " " self) + (if (string-search " " self) (concat "\"" self "\"") self) (gnus-group-name-charset (gnus-inews-group-method self) @@ -1363,7 +1352,8 @@ the message before resending." ;; initial-contents. (with-current-buffer gnus-original-article-buffer (nnmail-fetch-field "to")))) - current-prefix-arg)) + current-prefix-arg) + gnus-summary-mode) (let ((message-header-setup-hook (copy-sequence message-header-setup-hook)) (message-sent-hook (copy-sequence message-sent-hook)) ;; Honor posting-style for `name' and `address' in Resent-From header. @@ -1416,7 +1406,7 @@ the message before resending." A new buffer will be created to allow the user to modify body and contents of the message, and then, everything will happen as when composing a new message." - (interactive) + (interactive nil gnus-summary-mode) (let ((mail-parse-charset gnus-newsgroup-charset)) (gnus-setup-message 'reply-yank (gnus-summary-select-article t) @@ -1444,12 +1434,12 @@ composing a new message." (defun gnus-summary-post-forward (&optional arg) "Forward the current article to a newsgroup. See `gnus-summary-mail-forward' for ARG." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mail-forward arg t)) (defun gnus-summary-mail-crosspost-complaint (n) "Send a complaint about crossposting to the current article(s)." - (interactive "P") + (interactive "P" gnus-summary-mode) (dolist (article (gnus-summary-work-articles n)) (set-buffer gnus-summary-buffer) (gnus-summary-goto-subject article) @@ -1517,9 +1507,9 @@ Already submitted bugs can be found in the Emacs bug tracker: (defun gnus-summary-yank-message (buffer n) "Yank the current article into a composed message." - (interactive - (list (gnus-completing-read "Buffer" (message-buffers) t) - current-prefix-arg)) + (interactive (list (gnus-completing-read "Buffer" (message-buffers) t) + current-prefix-arg) + gnus-summary-mode) (gnus-summary-iterate n (let ((gnus-inhibit-treatment t)) (gnus-summary-select-article)) @@ -1536,7 +1526,7 @@ contains some mail you have written which has been bounced back to you. If FETCH, try to fetch the article that this is a reply to, if indeed this is a reply." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-select-article t) (let (summary-buffer parent) (if fetch @@ -1579,7 +1569,6 @@ this is a reply." ;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) - (interactive) (save-excursion (save-restriction (message-narrow-to-headers) @@ -1608,6 +1597,10 @@ this is a reply." (if (stringp gnus-gcc-externalize-attachments) (string-match gnus-gcc-externalize-attachments group) gnus-gcc-externalize-attachments)) + ;; If we want to externalize stuff when GCC-ing, then we + ;; can't use the cache, because that has all the contents. + (when mml-externalize-attachments + (setq encoded-cache nil)) (save-excursion (nnheader-set-temp-buffer " *acc*") (setq message-options (with-current-buffer cur message-options)) @@ -1668,9 +1661,7 @@ this is a reply." ;; FIXME: Should gcc-mark-as-read work when ;; Gnus is not running? (gnus-alive-p)) - (if (or gnus-gcc-mark-as-read - (and (boundp 'gnus-inews-mark-gcc-as-read) - (symbol-value 'gnus-inews-mark-gcc-as-read))) + (if gnus-gcc-mark-as-read (gnus-group-mark-article-read group (cdr group-art)) (with-current-buffer gnus-group-buffer (let ((gnus-group-marked (list group)) @@ -1690,7 +1681,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 @@ -1698,7 +1689,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 @@ -1761,11 +1752,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 @@ -1972,7 +1963,7 @@ created. This command uses the process/prefix convention, so if you process-mark several articles, they will all be attached." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((buffers (message-buffers)) destination) ;; Set up the destination mail composition buffer. diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index a4d198b46e4..8646904637c 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -1,4 +1,4 @@ -;; gnus-notifications.el -- Send notification on new message in Gnus -*- lexical-binding: t; -*- +;;; gnus-notifications.el --- Send notification on new message in Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 7927b88c3de..fd4d3b8a762 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -244,7 +244,7 @@ replacement is added." (gnus-picon-insert-glyph (pop spec) category)))))))))) (defun gnus-picon-transform-newsgroups (header) - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-headers (gnus-article-goto-header header) (mail-header-narrow-to-field) @@ -283,7 +283,7 @@ replacement is added." (defun gnus-treat-from-picon () "Display picons in the From header. If picons are already displayed, remove them." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types)) @@ -294,7 +294,7 @@ If picons are already displayed, remove them." (defun gnus-treat-mail-picon () "Display picons in the Cc and To headers. If picons are already displayed, remove them." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types)) @@ -306,7 +306,7 @@ If picons are already displayed, remove them." (defun gnus-treat-newsgroups-picon () "Display picons in the Newsgroups and Followup-To headers. If picons are already displayed, remove them." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types)) diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index 6cc60cb49b3..7d12ae9fdcc 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -42,13 +42,8 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE." (defun gnus-set-difference (list1 list2) "Return a list of elements of LIST1 that do not appear in LIST2." - (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))) + (declare (obsolete seq-difference "28.1")) + (seq-difference list1 list2 #'eq)) (defun gnus-range-nconcat (&rest ranges) "Return a range comprising all the RANGES, which are pre-sorted. @@ -179,12 +174,8 @@ Both lists have to be sorted over <." ;;;###autoload (defun gnus-intersection (list1 list2) - (let ((result nil)) - (while list2 - (when (memq (car list2) list1) - (setq result (cons (car list2) result))) - (setq list2 (cdr list2))) - result)) + (declare (obsolete seq-intersection "28.1")) + (nreverse (seq-intersection list1 list2 #'eq))) ;;;###autoload (defun gnus-sorted-intersection (list1 list2) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 147550d8cf3..0468d72edd0 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -88,7 +88,6 @@ (require 'gnus-art) (require 'gnus-util) (require 'nnmail) -(require 'easymenu) (require 'registry) (defvar gnus-adaptive-word-syntax-table) @@ -320,9 +319,12 @@ Encode names if ENCODE is non-nil, otherwise decode." (setf (oref db tracked) (append gnus-registry-track-extra '(mark group keyword))) - (when (not (equal old (oref db tracked))) + (when (not (seq-set-equal-p old (oref db tracked))) (gnus-message 9 "Reindexing the Gnus registry (tracked change)") - (registry-reindex db)) + (let ((message-log-max (if (< gnus-verbose 9) + nil + message-log-max))) + (registry-reindex db))) (gnus-registry--munge-group-names db))) db) @@ -813,7 +815,7 @@ Consults `gnus-registry-ignored-groups' and (defun gnus-registry-wash-for-keywords (&optional force) "Get the keywords of the current article. Overrides existing keywords with FORCE set non-nil." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((id (gnus-registry-fetch-message-id-fast gnus-current-article)) word words) (if (or (not (gnus-registry-get-id-key id 'keyword)) @@ -1039,13 +1041,15 @@ Uses `gnus-registry-marks' to find what shortcuts to install." (defun gnus-registry-set-article-mark (&rest articles) "Apply a mark to process-marked ARTICLES." - (interactive (gnus-summary-work-articles current-prefix-arg)) + (interactive (gnus-summary-work-articles current-prefix-arg) + gnus-article-mode gnus-summary-mode) (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles nil t)) (defun gnus-registry-remove-article-mark (&rest articles) "Remove a mark from process-marked ARTICLES." - (interactive (gnus-summary-work-articles current-prefix-arg)) + (interactive (gnus-summary-work-articles current-prefix-arg) + gnus-article-mode gnus-summary-mode) (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles t t)) @@ -1069,7 +1073,8 @@ Uses `gnus-registry-marks' to find what shortcuts to install." "Get the Gnus registry marks for ARTICLES and show them if interactive. Uses process/prefix conventions. For multiple articles, only the last one's marks are returned." - (interactive (gnus-summary-work-articles 1)) + (interactive (gnus-summary-work-articles 1) + gnus-article-mode gnus-summary-mode) (let* ((article (last articles)) (id (gnus-registry-fetch-message-id-fast article)) (marks (when id (gnus-registry-get-id-key id 'mark)))) @@ -1288,16 +1293,14 @@ from your existing entries." (registry-reindex db) (cl-loop for k being the hash-keys of (oref db data) using (hash-value v) - do (let ((newv (delq nil (mapcar #'(lambda (entry) - (unless (member (car entry) extra) - entry)) + do (let ((newv (delq nil (mapcar (lambda (entry) + (unless (member (car entry) extra) + entry)) v)))) (registry-delete db (list k) nil) (gnus-registry-insert db k newv))) (registry-reindex db)))) -;; TODO: a few things - (provide 'gnus-registry) ;;; gnus-registry.el ends here 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 e222d24b694..5b746a8efa9 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -137,6 +137,8 @@ It accepts the same format specs that `gnus-summary-line-format' does." "Start reading the picked articles. If given a prefix, mark all unpicked articles as read." (interactive "P") + (declare (completion (lambda (s b) + (completion-minor-mode-active-p s b 'gnus-pick-mode)))) (if gnus-newsgroup-processable (progn (gnus-summary-limit-to-articles nil) @@ -462,7 +464,7 @@ Two predefined functions are available: (defun gnus-tree-read-summary-keys (&optional arg) "Read a summary buffer key sequence and execute it." - (interactive "P") + (interactive "P" gnus-tree-mode) (unless gnus-tree-inhibit (let ((buf (current-buffer)) (gnus-tree-inhibit t) @@ -477,7 +479,7 @@ Two predefined functions are available: (defun gnus-tree-show-summary () "Reconfigure windows to show summary buffer." - (interactive) + (interactive nil gnus-tree-mode) (if (not (gnus-buffer-live-p gnus-summary-buffer)) (error "There is no summary buffer for this tree buffer") (gnus-configure-windows 'article) @@ -485,7 +487,7 @@ Two predefined functions are available: (defun gnus-tree-select-article (article) "Select the article under point, if any." - (interactive (list (gnus-tree-article-number))) + (interactive (list (gnus-tree-article-number)) gnus-tree-mode) (let ((buf (current-buffer))) (when article (with-current-buffer gnus-summary-buffer @@ -494,7 +496,7 @@ Two predefined functions are available: (defun gnus-tree-pick-article (e) "Select the article under the mouse pointer." - (interactive "e") + (interactive "e" gnus-tree-mode) (mouse-set-point e) (gnus-tree-select-article (gnus-tree-article-number))) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index ade0897a16a..f40da9e9c4c 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -528,7 +528,8 @@ permanence, and the string to be used. The numerical prefix will be used as SCORE. A symbolic prefix of `a' (the SYMP parameter) says to use the `all.SCORE' file for the command instead of the current score file." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") + gnus-article-mode gnus-summary-mode) (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp)) (defun gnus-score-kill-help-buffer () @@ -544,7 +545,8 @@ permanence, and the string to be used. The numerical prefix will be used as SCORE. A symbolic prefix of `a' (the SYMP parameter) says to use the `all.SCORE' file for the command instead of the current score file." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") + gnus-article-mode gnus-summary-mode) (let* ((nscore (gnus-score-delta-default score)) (prefix (if (< nscore 0) ?L ?I)) (increase (> nscore 0)) @@ -931,15 +933,16 @@ TYPE is the score type. SCORE is the score to add. EXTRA is the possible non-standard header." (interactive (list (gnus-completing-read "Header" - (mapcar + (mapcar #'car (seq-filter (lambda (x) (fboundp (nth 2 x))) gnus-header-index)) - t) + t) (read-string "Match: ") (if (y-or-n-p "Use regexp match? ") 'r 's) - (string-to-number (read-string "Score: ")))) + (string-to-number (read-string "Score: "))) + gnus-article-mode gnus-summary-mode) (save-excursion (unless (and (stringp match) (> (length match) 0)) (error "No match")) @@ -974,7 +977,8 @@ EXTRA is the possible non-standard header." "Automatically mark articles with score below SCORE as read." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-number (read-string "Mark below: "))))) + (string-to-number (read-string "Mark below: ")))) + gnus-article-mode gnus-summary-mode) (setq score (or score gnus-summary-default-score 0)) (gnus-score-set 'mark (list score)) (gnus-score-set 'touched '(t)) @@ -1008,14 +1012,15 @@ EXTRA is the possible non-standard header." "Automatically expunge articles with score below SCORE." (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-number (read-string "Set expunge below: "))))) + (string-to-number (read-string "Set expunge below: ")))) + gnus-article-mode gnus-summary-mode) (setq score (or score gnus-summary-default-score 0)) (gnus-score-set 'expunge (list score)) (gnus-score-set 'touched '(t))) (defun gnus-score-followup-article (&optional score) "Add SCORE to all followups to the article in the current buffer." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (setq score (gnus-score-delta-default score)) (when (gnus-buffer-live-p gnus-summary-buffer) (save-excursion @@ -1030,7 +1035,7 @@ EXTRA is the possible non-standard header." (defun gnus-score-followup-thread (&optional score) "Add SCORE to all later articles in the thread the current buffer is part of." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (setq score (gnus-score-delta-default score)) (when (gnus-buffer-live-p gnus-summary-buffer) (save-excursion @@ -1064,13 +1069,13 @@ EXTRA is the possible non-standard header." (defun gnus-summary-raise-score (n) "Raise the score of the current article by N." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-summary-set-score (+ (gnus-summary-article-score) (or n gnus-score-interactive-default-score )))) (defun gnus-summary-set-score (n) "Set the score of the current article to N." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (save-excursion (gnus-summary-show-thread) (let ((buffer-read-only nil)) @@ -1089,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." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (message "%s" (if arg (gnus-thread-total-score (gnus-id-to-thread @@ -1099,14 +1104,16 @@ EXTRA is the possible non-standard header." (defun gnus-score-change-score-file (file) "Change current score alist." (interactive - (list (read-file-name "Change to score file: " gnus-kill-files-directory))) + (list (read-file-name "Change to score file: " gnus-kill-files-directory)) + gnus-article-mode gnus-summary-mode) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) (defvar gnus-score-edit-exit-function) (defun gnus-score-edit-current-scores (file) "Edit the current score alist." - (interactive (list gnus-current-score-file)) + (interactive (list gnus-current-score-file) + gnus-article-mode gnus-summary-mode) (if (not gnus-current-score-file) (error "No current score file") (let ((winconf (current-window-configuration))) @@ -1175,8 +1182,8 @@ If FORMAT, also format the current score file." (when (consp rule) ;; the rule exists (setq rule (if (symbolp (car rule)) (format "(%S)" (car rule)) - (mapconcat #'(lambda (obj) - (regexp-quote (format "%S" obj))) + (mapconcat (lambda (obj) + (regexp-quote (format "%S" obj))) rule sep))) (goto-char (point-min)) @@ -2496,7 +2503,7 @@ score in `gnus-newsgroup-scored' by SCORE." (defun gnus-score-find-trace () "Find all score rules that applies to the current article." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((old-scored gnus-newsgroup-scored)) (let ((gnus-newsgroup-headers (list (gnus-summary-article-header))) @@ -2611,7 +2618,7 @@ the score file and its full name, including the directory.") (defun gnus-summary-rescore () "Redo the entire scoring process in the current summary." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-score-save) (setq gnus-score-cache nil) (setq gnus-newsgroup-scored nil) @@ -2642,7 +2649,7 @@ the score file and its full name, including the directory.") (defun gnus-summary-raise-same-subject-and-select (score) "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (let ((subject (gnus-summary-article-subject))) (gnus-summary-raise-score score) (while (gnus-summary-find-subject subject) @@ -2651,7 +2658,7 @@ the score file and its full name, including the directory.") (defun gnus-summary-raise-same-subject (score) "Raise articles which has the same subject with SCORE." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (let ((subject (gnus-summary-article-subject))) (gnus-summary-raise-score score) (while (gnus-summary-find-subject subject) @@ -2664,7 +2671,7 @@ the score file and its full name, including the directory.") (defun gnus-summary-raise-thread (&optional score) "Raise the score of the articles in the current thread with SCORE." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (setq score (gnus-score-delta-default score)) (let (e) (save-excursion @@ -2683,17 +2690,17 @@ the score file and its full name, including the directory.") (defun gnus-summary-lower-same-subject-and-select (score) "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-summary-raise-same-subject-and-select (- score))) (defun gnus-summary-lower-same-subject (score) "Raise articles which has the same subject with SCORE." - (interactive "p") + (interactive "p" gnus-article-mode gnus-summary-mode) (gnus-summary-raise-same-subject (- score))) (defun gnus-summary-lower-thread (&optional score) "Lower score of articles in the current thread with SCORE." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-summary-raise-thread (- (gnus-score-delta-default score)))) ;;; Finding score files. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 21602f825c1..2a8069d400c 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -4,18 +4,20 @@ ;; Author: Eric Abrahamsen <eric@ericabrahamsen.net> -;; This program is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -363,7 +365,7 @@ This variable can also be set per-server." "A list of strings representing expandable search keys. \"Expandable\" simply means the key can be abbreviated while typing in search queries, ie \"subject\" could be entered as -\"subj\" or even \"su\", though \"s\" is ambigous between +\"subj\" or even \"su\", though \"s\" is ambiguous between \"subject\" and \"since\". Ambiguous abbreviations will raise an error." @@ -400,7 +402,7 @@ The search \"language\" is essentially a series of key:value 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 implictly ANDed; the \"or\" keyword can be used to +are implicitly ANDed; the \"or\" keyword can be used to 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 @@ -446,10 +448,10 @@ auto-completion of contact names and addresses for keys like Date values (any key in `gnus-search-date-keys') can be provided in any format that `parse-time-string' can parse (note that this can produce weird results). Dates with missing bits will be -interpreted as the most recent occurance thereof (ie \"march 03\" -is the most recent March 3rd). Lastly, relative specifications -such as 1d (one day ago) are understood. This also accepts w, m, -and y. m is assumed to be 30 days. +interpreted as the most recent occurrence thereof (i.e. \"march +03\" is the most recent March 3rd). Lastly, relative +specifications such as 1d (one day ago) are understood. This +also accepts w, m, and y. m is assumed to be 30 days. This function will accept pretty much anything as input. Its only job is to parse the query into a sexp, and pass that on -- @@ -547,7 +549,7 @@ structure. In the simplest case, they are simply consed together. String KEY is converted to a symbol." - (let (return) + (let () ;; return (cond ((member key gnus-search-date-keys) (when (string= "after" key) @@ -557,7 +559,7 @@ KEY is converted to a symbol." (setq value (gnus-search-query-parse-mark value))) ((string= "message-id" key) (setq key "id"))) - (or return + (or nil ;; return (cons (intern key) value)))) (defun gnus-search-query-parse-date (value &optional rel-date) @@ -570,7 +572,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))) @@ -627,25 +629,30 @@ gnus-*-mark marks, and return an appropriate string." mark)) (defun gnus-search-query-expand-key (key) - (cond ((test-completion key gnus-search-expandable-keys) - ;; We're done! - key) - ;; There is more than one possible completion. - ((consp (cdr (completion-all-completions - key gnus-search-expandable-keys #'stringp 0))) - (signal 'gnus-search-parse-error - (list (format "Ambiguous keyword: %s" key)))) - ;; Return KEY, either completed or untouched. - ((car-safe (completion-try-completion - key gnus-search-expandable-keys - #'stringp 0))))) + "Attempt to expand KEY to a full keyword. +Use `gnus-search-expandable-keys' as a completion table; return +KEY directly if it can't be completed. Raise an error if KEY is +ambiguous, meaning that it is a prefix of multiple known +keywords. This means that it's not possible to enter a custom +keyword that happens to be a prefix of a known keyword." + (let ((comp (try-completion key gnus-search-expandable-keys))) + (if (or (eql comp 't) ; Already a key. + (null comp)) ; An unknown key. + key + (if (null (member comp gnus-search-expandable-keys)) + ;; KEY is a prefix of multiple known keywords, and could not + ;; be completed to something unique. + (signal 'gnus-search-parse-error + (list (format "Ambiguous keyword: %s" key))) + ;; We completed to a unique known key. + comp)))) (defun gnus-search-query-return-string (&optional delimited trim) "Return a string from the current buffer. If DELIMITED is non-nil, assume the next character is a delimiter character, and return everything between point and the next -occurance of the delimiter, including the delimiters themselves. -If TRIM is non-nil, do not return the delimiters. Otherwise, +occurrence of the delimiter, including the delimiters themselves. +If TRIM is non-nil, do not return the delimiters. Otherwise, return one word." ;; This function cannot handle nested delimiters, as it's not a ;; proper parser. Ie, you cannot parse "to:bob or (from:bob or @@ -787,7 +794,7 @@ the files in ARTLIST by that search key.") (raw-queries-p :initform (symbol-value 'gnus-search-imap-raw-queries-p))) :documentation - "The base IMAP search engine, using an IMAP server's search capabilites. + "The base IMAP search engine, using an IMAP server's search capabilities. This backend may be subclassed to handle particular IMAP servers' quirks.") @@ -973,7 +980,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. @@ -1080,7 +1087,7 @@ Responsible for handling and, or, and parenthetical expressions.") (cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap) (query string)) "Create the IMAP search command for QUERY. -Currenly takes into account support for the LITERAL+ capability. +Currently takes into account support for the LITERAL+ capability. Other capabilities could be tested here." (with-slots (literal-plus) engine (when literal-plus @@ -1276,24 +1283,30 @@ elements are present." str))) (defun gnus-search-imap-handle-flag (flag) - "Make sure string FLAG is something IMAP will recognize." - ;; What else? What about the KEYWORD search key? + "Adjust string FLAG to help IMAP recognize it. +If it's one of the RFC3501 flags, make sure it's upcased. +Otherwise, if FLAG starts with a \"$\", treat as a KEYWORD +search. Otherwise, drop the flag." (setq flag (pcase flag ("flag" "flagged") ("read" "seen") ("replied" "answered") (_ flag))) - (if (member flag '("seen" "answered" "deleted" "draft" "flagged")) - (upcase flag) - "")) + (cond + ((member flag '("seen" "answered" "deleted" "draft" "flagged" "recent")) + (upcase flag)) + ((string-prefix-p "$" flag) + (format "KEYWORD %s" flag)) + ;; TODO: Provide a user option to treat *all* marks as a KEYWORDs? + (t ""))) ;;; Methods for the indexed search engines. ;; First, some common methods. -(cl-defgeneric gnus-search-indexed-parse-output (engine server &optional groups) - "Parse the results of ENGINE's query against SERVER in GROUPS. +(cl-defgeneric gnus-search-indexed-parse-output (engine server query &optional groups) + "Parse the results of ENGINE's QUERY against SERVER in GROUPS. Locally-indexed search engines return results as a list of filenames, sometimes with additional information. Returns a list of viable results, in the form of a list of [group article score] @@ -1343,63 +1356,61 @@ Returns a list of [group article score] vectors." (cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed) server query &optional groups) - (let ((prefix (slot-value engine 'remove-prefix)) - (group-regexp (when groups - (mapconcat - (lambda (x) - (replace-regexp-in-string - ;; Accept any of [.\/] as path separators. - "[.\\/]" "[.\\\\/]" - (gnus-group-real-name x))) - groups "\\|"))) - artlist vectors article group) + (let ((prefix (or (slot-value engine 'remove-prefix) + "")) + (groups (mapcar #'gnus-group-short-name groups)) + artlist article group) (goto-char (point-min)) - (while (not (eobp)) + ;; Prep prefix, we want to at least be removing the root + ;; filesystem separator. + (when (stringp prefix) + (setq prefix (file-name-as-directory + (expand-file-name prefix "/")))) + (while (not (or (eobp) + (looking-at-p + "\\(?:[[:space:]\n]+\\)?Process .+ finished"))) (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine))) - (when (and (file-readable-p f-name) - (null (file-directory-p f-name)) - (or (null groups) - (and (gnus-search-single-p query) - (alist-get 'thread query)) - (string-match-p group-regexp f-name))) - (push (list f-name score) artlist)))) + (when (and f-name + (file-readable-p f-name) + (null (file-directory-p f-name))) + (setq group + (replace-regexp-in-string + "[/\\]" "." + (replace-regexp-in-string + "/?\\(cur\\|new\\|tmp\\)?/\\'" "" + (replace-regexp-in-string + "\\`\\." "" + (string-remove-prefix + prefix (file-name-directory f-name)) + nil t) + nil t) + nil t)) + (setq article (file-name-nondirectory f-name) + article + ;; TODO: Provide a cleaner way of producing final + ;; article numbers for the various backends. + (if (string-match-p "\\`[[:digit:]]+\\'" article) + (string-to-number article) + (nnmaildir-base-name-to-article-number + (substring article 0 (string-search ":" article)) + group (string-remove-prefix "nnmaildir:" server)))) + (when (and (numberp article) + (or (null groups) + (member group groups))) + (push (list f-name article group score) + artlist))))) ;; Are we running an additional grep query? (when-let ((grep-reg (alist-get 'grep query))) (setq artlist (gnus-search-grep-search engine artlist grep-reg))) - ;; Prep prefix. - (when (and prefix (null (string-empty-p prefix))) - (setq prefix (file-name-as-directory (expand-file-name prefix)))) - ;; Turn (file-name score) into [group article score]. - (pcase-dolist (`(,f-name ,score) artlist) - (setq article (file-name-nondirectory f-name) - group (file-name-directory f-name)) - ;; Remove prefix. - (when prefix - (setq group (string-remove-prefix prefix group))) - ;; Break the directory name down until it's something that - ;; (probably) can be used as a group name. - (setq group - (replace-regexp-in-string - "[/\\]" "." - (replace-regexp-in-string - "/?\\(cur\\|new\\|tmp\\)?/\\'" "" - (replace-regexp-in-string - "^[./\\]" "" - group nil t) - nil t) - nil t)) - - (push (vector (gnus-group-full-name group server) - (if (string-match-p "\\`[[:digit:]]+\\'" article) - (string-to-number article) - (nnmaildir-base-name-to-article-number - (substring article 0 (string-match ":" article)) - group (string-remove-prefix "nnmaildir:" server))) - (if (numberp score) - score - (string-to-number score))) - vectors)) - vectors)) + ;; Munge into the list of vectors expected by nnselect. + (mapcar (pcase-lambda (`(,_ ,article ,group ,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)) "Base implementation treats the whole line as a filename, and @@ -1658,7 +1669,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) ":-" @@ -1668,8 +1679,8 @@ and \"-\" before marks." (cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix) (expr (head or))) "Handle Mairix \"or\" statement. -Mairix only accepts \"or\" expressions on homogenous keys. We -cast \"or\" expressions on heterogenous keys as \"and\", which +Mairix only accepts \"or\" expressions on homogeneous keys. We +cast \"or\" expressions on heterogeneous keys as \"and\", which isn't quite right, but it's the best we can do. For date keys, only keep one of the terms." (let ((term1 (caadr expr)) @@ -1852,9 +1863,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 @@ -2125,7 +2136,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 5dcd079fb48..eeedf7ff35c 100644 --- a/lisp/gnus/gnus-sieve.el +++ b/lisp/gnus/gnus-sieve.el @@ -113,7 +113,7 @@ Return nil if no rule could be guessed." ;;;###autoload (defun gnus-sieve-article-add-rule () - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-summary-select-article nil 'force) (with-current-buffer gnus-original-article-buffer (let ((rule (gnus-sieve-guess-rule-for-article)) 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 a305e343f69..1c75abb6f4b 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -409,7 +409,7 @@ The following commands are available: (defun gnus-server-kill-server (server) "Kill the server on the current line." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (unless (gnus-server-goto-server server) (if server (error "No such server: %s" server) (error "No server on the current line"))) @@ -438,7 +438,7 @@ The following commands are available: (defun gnus-server-yank-server () "Yank the previously killed server." - (interactive) + (interactive nil gnus-server-mode) (unless gnus-server-killed-servers (error "No killed servers to be yanked")) (let ((alist gnus-server-alist) @@ -460,14 +460,14 @@ The following commands are available: (defun gnus-server-exit () "Return to the group buffer." - (interactive) + (interactive nil gnus-server-mode) (gnus-run-hooks 'gnus-server-exit-hook) (gnus-kill-buffer (current-buffer)) (gnus-configure-windows 'group t)) (defun gnus-server-list-servers () "List all available servers." - (interactive) + (interactive nil gnus-server-mode) (let ((cur (gnus-server-server-name))) (gnus-server-prepare) (if cur (gnus-server-goto-server cur) @@ -489,7 +489,7 @@ The following commands are available: (defun gnus-server-open-server (server) "Force an open of SERVER." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (unless method (error "No such server: %s" server)) @@ -501,13 +501,13 @@ The following commands are available: (defun gnus-server-open-all-servers () "Open all servers." - (interactive) + (interactive nil gnus-server-mode) (dolist (server gnus-inserted-opened-servers) (gnus-server-open-server (car server)))) (defun gnus-server-close-server (server) "Close SERVER." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (unless method (error "No such server: %s" server)) @@ -519,7 +519,7 @@ The following commands are available: (defun gnus-server-offline-server (server) "Set SERVER to offline." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (unless method (error "No such server: %s" server)) @@ -531,7 +531,7 @@ The following commands are available: (defun gnus-server-close-all-servers () "Close all servers." - (interactive) + (interactive nil gnus-server-mode) (dolist (server gnus-inserted-opened-servers) (gnus-server-close-server (car server))) (dolist (server gnus-server-alist) @@ -539,7 +539,7 @@ The following commands are available: (defun gnus-server-deny-server (server) "Make sure SERVER will never be attempted opened." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (unless method (error "No such server: %s" server)) @@ -550,7 +550,7 @@ The following commands are available: (defun gnus-server-remove-denials () "Make all denied servers into closed servers." - (interactive) + (interactive nil gnus-server-mode) (dolist (server gnus-opened-servers) (when (eq (nth 1 server) 'denied) (setcar (nthcdr 1 server) 'closed))) @@ -558,11 +558,11 @@ The following commands are available: (defun gnus-server-copy-server (from to) "Copy a server definition to a new name." - (interactive - (list - (or (gnus-server-server-name) - (error "No server on the current line")) - (read-string "Copy to: "))) + (interactive (list + (or (gnus-server-server-name) + (error "No server on the current line")) + (read-string "Copy to: ")) + gnus-server-mode) (unless from (error "No server on current line")) (unless (and to (not (string= to ""))) @@ -583,7 +583,8 @@ The following commands are available: (list (intern (gnus-completing-read "Server method" (mapcar #'car gnus-valid-select-methods) t)) - (read-string "Server name: "))) + (read-string "Server name: ")) + gnus-server-mode) (when (assq where gnus-server-alist) (error "Server with that name already defined")) (push (list where how where) gnus-server-killed-servers) @@ -593,7 +594,8 @@ The following commands are available: "Jump to a server line." (interactive (list (gnus-completing-read "Goto server" - (mapcar #'car gnus-server-alist) t))) + (mapcar #'car gnus-server-alist) t)) + gnus-server-mode) (let ((to (text-property-any (point-min) (point-max) 'gnus-server (intern server)))) (when to @@ -602,7 +604,7 @@ The following commands are available: (defun gnus-server-edit-server (server) "Edit the server on the current line." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (unless server (error "No server on current line")) (unless (assoc server gnus-server-alist) @@ -620,7 +622,7 @@ The following commands are available: (defun gnus-server-show-server (server) "Show the definition of the server on the current line." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (unless server (error "No server on current line")) (let ((info (gnus-server-to-method server))) @@ -632,7 +634,7 @@ The following commands are available: (defun gnus-server-scan-server (server) "Request a scan from the current server." - (interactive (list (gnus-server-server-name))) + (interactive (list (gnus-server-server-name)) gnus-server-mode) (let ((method (gnus-server-to-method server))) (if (not (gnus-get-function method 'request-scan)) (error "Server %s can't scan" (car method)) @@ -714,7 +716,7 @@ claim them." "\M-n" gnus-browse-next-group "\M-p" gnus-browse-prev-group "\r" gnus-browse-select-group - "u" gnus-browse-unsubscribe-current-group + "u" gnus-browse-toggle-subscription-at-point "l" gnus-browse-exit "L" gnus-browse-exit "q" gnus-browse-exit @@ -733,7 +735,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] @@ -879,9 +881,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. @@ -897,7 +899,7 @@ buffer. (defun gnus-browse-read-group (&optional no-article number) "Enter the group at the current line. If NUMBER, fetch this number of articles." - (interactive "P") + (interactive "P" gnus-browse-mode) (let* ((full-name (gnus-browse-group-name)) (group (if (gnus-native-method-p (gnus-find-method-for-group full-name)) @@ -916,33 +918,38 @@ If NUMBER, fetch this number of articles." (defun gnus-browse-select-group (&optional number) "Select the current group. If NUMBER, fetch this number of articles." - (interactive "P") + (interactive "P" gnus-browse-mode) (gnus-browse-read-group 'no number)) (defun gnus-browse-next-group (n) "Go to the next group." - (interactive "p") + (interactive "p" gnus-browse-mode) (prog1 (forward-line n) (gnus-group-position-point))) (defun gnus-browse-prev-group (n) "Go to the next group." - (interactive "p") + (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." - (interactive "p") + (interactive "p" gnus-browse-mode) (when (eobp) (error "No group at current line")) (let ((ward (if (< arg 0) -1 1)) (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) @@ -961,7 +968,7 @@ how new groups will be entered into the group buffer." (defun gnus-browse-describe-group (group) "Describe the current group." - (interactive (list (gnus-browse-group-name))) + (interactive (list (gnus-browse-group-name)) gnus-browse-mode) (gnus-group-describe-group nil group)) (defun gnus-browse-delete-group (group force) @@ -970,11 +977,11 @@ If FORCE (the prefix) is non-nil, all the articles in the group will be deleted. This is \"deleted\" as in \"removed forever from the face of the Earth\". There is no undo. The user will be prompted before doing the deletion." - (interactive (list (gnus-browse-group-name) - current-prefix-arg)) + (interactive (list (gnus-browse-group-name) current-prefix-arg) + 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) @@ -1020,7 +1027,7 @@ doing the deletion." (defun gnus-browse-exit () "Quit browsing and return to the group buffer." - (interactive) + (interactive nil gnus-browse-mode) (when (derived-mode-p 'gnus-browse-mode) (gnus-kill-buffer (current-buffer))) ;; Insert the newly subscribed groups in the group buffer. @@ -1032,7 +1039,7 @@ doing the deletion." (defun gnus-browse-describe-briefly () "Give a one line description of the group mode commands." - (interactive) + (interactive nil gnus-browse-mode) (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) @@ -1089,7 +1096,7 @@ Requesting compaction of %s... (this may take a long time)" (defun gnus-server-toggle-cloud-server () "Toggle whether the server under point is replicated in the Emacs Cloud." - (interactive) + (interactive nil gnus-server-mode) (let ((server (gnus-server-server-name))) (unless server (error "No server on the current line")) @@ -1110,7 +1117,7 @@ Requesting compaction of %s... (this may take a long time)" (defun gnus-server-set-cloud-method-server () "Set the server under point to host the Emacs Cloud." - (interactive) + (interactive nil gnus-server-mode) (let ((server (gnus-server-server-name))) (unless server (error "No server on the current line")) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 1554635a3f2..02bbe19e7fe 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -663,7 +663,6 @@ the first newsgroup." (defvar mail-sources) (defvar nnmail-scan-directory-mail-source-once) (defvar nnmail-split-history) -(defvar nnmail-spool-file) (defun gnus-close-all-servers () "Close all servers." @@ -855,7 +854,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))))) @@ -1070,7 +1069,7 @@ With 1 C-u, 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 for new groups, and subscribe the new groups as zombies." - (interactive "p") + (interactive "p" gnus-group-mode) (let* ((gnus-subscribe-newsgroup-method gnus-subscribe-newsgroup-method) (check (cond @@ -1173,7 +1172,7 @@ for new groups, and subscribe the new groups as zombies." gnus-check-new-newsgroups) gnus-secondary-select-methods)))) (groups 0) - group new-newsgroups got-new method hashtb + new-newsgroups got-new method hashtb ;; group gnus-override-subscribe-method) (unless gnus-killed-hashtb (gnus-make-hashtable-from-killed)) @@ -1204,14 +1203,14 @@ for new groups, and subscribe the new groups as zombies." (cond ((eq do-sub 'subscribe) (cl-incf groups) - (puthash g-name group gnus-killed-hashtb) + (puthash g-name nil gnus-killed-hashtb) ;; group (gnus-call-subscribe-functions gnus-subscribe-options-newsgroup-method g-name)) ((eq do-sub 'ignore) nil) (t (cl-incf groups) - (puthash g-name group gnus-killed-hashtb) + (puthash g-name nil gnus-killed-hashtb) ;; group (if gnus-subscribe-hierarchical-interactive (push g-name new-newsgroups) (gnus-call-subscribe-functions @@ -1405,7 +1404,7 @@ newsgroup." (defun gnus-check-duplicate-killed-groups () "Remove duplicates from the list of killed groups." - (interactive) + (interactive nil gnus-group-mode) (let ((killed gnus-killed-list)) (while killed (gnus-message 9 "%d" (length killed)) @@ -2379,6 +2378,11 @@ If FORCE is non-nil, the .newsrc file is read." (unless (gnus-yes-or-no-p (concat errmsg "; continue? ")) (error "%s" errmsg))))))))) +;; IIUC these 3 vars were used in older .newsrc files. +(defvar gnus-killed-assoc) +(defvar gnus-marked-assoc) +(defvar gnus-newsrc-assoc) + (defun gnus-read-newsrc-el-file (file) (let ((ding-file (concat file "d"))) (when (file-exists-p ding-file) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 456e7b0f8c4..856e95c0ba0 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -73,18 +73,10 @@ (eval-when-compile (require 'subr-x)) -(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) +(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil + '(gnus-summary-mode)) (autoload 'gnus-cache-write-active "gnus-cache") -(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) -(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) (autoload 'gnus-pick-line-number "gnus-salt" nil t) -(autoload 'mm-uu-dissect "mm-uu") -(autoload 'gnus-article-outlook-deuglify-article "deuglify" - "Deuglify broken Outlook (Express) articles and redisplay." - t) -(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t) -(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t) -(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t) (autoload 'nnselect-article-rsv "nnselect" nil nil) (autoload 'nnselect-article-group "nnselect" nil nil) (autoload 'gnus-nnselect-group-p "nnselect" nil nil) @@ -887,8 +879,9 @@ this reverses the sort order. Ready-made functions include `gnus-article-sort-by-number', `gnus-article-sort-by-author', `gnus-article-sort-by-subject', -`gnus-article-sort-by-date', `gnus-article-sort-by-random' -and `gnus-article-sort-by-score'. +`gnus-article-sort-by-date', `gnus-article-sort-by-score', +`gnus-article-sort-by-rsv', `gnus-article-sort-by-newsgroups', +and `gnus-article-sort-by-random'. When threading is turned on, the variable `gnus-thread-sort-functions' controls how articles are sorted." @@ -900,6 +893,7 @@ controls how articles are sorted." (function-item gnus-article-sort-by-date) (function-item gnus-article-sort-by-score) (function-item gnus-article-sort-by-rsv) + (function-item gnus-article-sort-by-newsgroups) (function-item gnus-article-sort-by-random) (function :tag "other")) (boolean :tag "Reverse order")))) @@ -924,8 +918,8 @@ Ready-made functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient' `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', `gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number', -`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random', -and `gnus-thread-sort-by-total-score' (see +`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-newsgroups', +`gnus-thread-sort-by-random', and `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). When threading is turned off, the variable @@ -946,6 +940,7 @@ subthreads, customize `gnus-subthread-sort-functions'." (function-item gnus-thread-sort-by-rsv) (function-item gnus-thread-sort-by-most-recent-number) (function-item gnus-thread-sort-by-most-recent-date) + (function-item gnus-thread-sort-by-newsgroups) (function-item gnus-thread-sort-by-random) (function-item gnus-thread-sort-by-total-score) (function :tag "other")) @@ -969,6 +964,7 @@ according to the value of `gnus-thread-sort-functions'." (function-item gnus-thread-sort-by-score) (function-item gnus-thread-sort-by-most-recent-number) (function-item gnus-thread-sort-by-most-recent-date) + (function-item gnus-thread-sort-by-newsgroups) (function-item gnus-thread-sort-by-random) (function-item gnus-thread-sort-by-total-score) (function :tag "other")) @@ -1984,6 +1980,8 @@ increase the score of each group you read." "\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 @@ -2525,6 +2523,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (let ((gnus-summary-show-article-charset-alist `((1 . ,cs)))) (gnus-summary-show-article 1)))) + (function-put command 'completion-predicate #'ignore) `[,(symbol-name cs) ,command t])) (sort (coding-system-list) #'string<))))) ("Washing" @@ -2781,7 +2780,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Hide marked" gnus-summary-limit-exclude-marks t] ["Show expunged" gnus-summary-limit-include-expunged t]) ("Process Mark" - ["Set mark" gnus-summary-mark-as-processable t] + ["Toggle/Set mark" gnus-summary-mark-as-processable t] ["Remove mark" gnus-summary-unmark-as-processable t] ["Remove all marks" gnus-summary-unmark-all-processable t] ["Invert marks" gnus-uu-invert-processable t] @@ -2838,6 +2837,8 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Sort by lines" gnus-summary-sort-by-lines t] ["Sort by characters" gnus-summary-sort-by-chars t] ["Sort by marks" gnus-summary-sort-by-marks t] + ["Sort by newsgroup" gnus-summary-sort-by-newsgroups t] + ["Sort by extra" gnus-summary-sort-by-extra t] ["Randomize" gnus-summary-sort-by-random t] ["Original sort" gnus-summary-sort-by-original t]) ("Help" @@ -3149,6 +3150,7 @@ buffer; read the Info manual for more information (`\\[gnus-info-find-node]'). The following commands are available: \\{gnus-summary-mode-map}" + :interactive nil (let ((gnus-summary-local-variables gnus-newsgroup-variables)) (gnus-summary-make-local-variables)) (gnus-summary-make-local-variables) @@ -3479,7 +3481,7 @@ marks of articles." ;; Various summary mode internalish functions. (defun gnus-mouse-pick-article (e) - (interactive "e") + (interactive "e" gnus-summary-mode) (mouse-set-point e) (gnus-summary-next-page nil t)) @@ -4219,7 +4221,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (defun gnus-summary-prepare () "Generate the summary buffer." - (interactive) + (interactive nil gnus-summary-mode) (let ((inhibit-read-only t)) (erase-buffer) (setq gnus-newsgroup-data nil @@ -4268,7 +4270,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (defun gnus-summary-simplify-subject-query () "Query where the respool algorithm would put this article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (message "%s" (gnus-general-simplify-subject (gnus-summary-article-subject)))) @@ -5081,17 +5083,17 @@ using some other form will lead to serious barfage." (gnus-article-sort-by-author (gnus-thread-header h1) (gnus-thread-header h2))) +(defsubst gnus-article-sort-extract-extra (name header) + (let ((extract + (funcall gnus-extract-address-components + (or (cdr (assq name (mail-header-extra header))) + "")))) + (or (car extract) (cadr extract)))) + (defsubst gnus-article-sort-by-recipient (h1 h2) "Sort articles by recipient." - (gnus-string< - (let ((extract (funcall - gnus-extract-address-components - (or (cdr (assq 'To (mail-header-extra h1))) "")))) - (or (car extract) (cadr extract))) - (let ((extract (funcall - gnus-extract-address-components - (or (cdr (assq 'To (mail-header-extra h2))) "")))) - (or (car extract) (cadr extract))))) + (let ((ex (lambda (h) (gnus-article-sort-extract-extra 'To h)))) + (gnus-string< (funcall ex h1) (funcall ex h2)))) (defun gnus-thread-sort-by-recipient (h1 h2) "Sort threads by root recipient." @@ -5186,6 +5188,16 @@ Unscored articles will be counted as having a score of zero." "Sort threads such that the thread with the most recently dated article comes first." (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2))) +(defsubst gnus-article-sort-by-newsgroups (h1 h2) + "Sort articles by newsgroups." + (let ((ex (lambda (h) (gnus-article-sort-extract-extra 'Newsgroups h)))) + (gnus-string< (funcall ex h1) (funcall ex h2)))) + +(defun gnus-thread-sort-by-newsgroups (h1 h2) + "Sort threads by root newsgroups." + (gnus-article-sort-by-newsgroups + (gnus-thread-header h1) (gnus-thread-header h2))) + ; Since this is called not only to sort the top-level threads, but ; also in recursive sorts to order the articles within a thread, each ; article will be processed many times. Thus it speeds things up @@ -5682,9 +5694,9 @@ or a straight list of headers." (or dependencies (with-current-buffer gnus-summary-buffer gnus-newsgroup-dependencies)))) - (delq nil (mapcar #'(lambda (header) - (gnus-dependencies-add-header - header dependencies force-new)) + (delq nil (mapcar (lambda (header) + (gnus-dependencies-add-header + header dependencies force-new)) gnus-headers-retrieved-by))))) (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name))) @@ -5983,14 +5995,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (input (read-string (if only-read-p - (format - "How many articles from %s (available %d, default %d): " - (gnus-group-real-name gnus-newsgroup-name) - number default) - (format - "How many articles from %s (%d default): " - (gnus-group-real-name gnus-newsgroup-name) - default)) + (format-prompt + "How many articles from %s (available %d)" + default + (gnus-group-real-name gnus-newsgroup-name) + number) + (format-prompt + "How many articles from %s" + default + (gnus-group-real-name gnus-newsgroup-name))) nil nil (number-to-string default)))) @@ -6360,9 +6373,9 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; First peel off all invalid article numbers. (when active (let ((ids articles) - id first) + id) ;; first (while (setq id (pop ids)) - (when (and first (> id (cdr active))) + (when nil ;; (and first (> id (cdr active))) ;; We'll end up in this situation in one particular ;; obscure situation. If you re-scan a group and get ;; a new article that is cross-posted to a different @@ -6671,19 +6684,19 @@ executed with point over the summary line of the articles." (defun gnus-summary-save-process-mark () "Push the current set of process marked articles on the stack." - (interactive) + (interactive nil gnus-summary-mode) (push (copy-sequence gnus-newsgroup-processable) gnus-newsgroup-process-stack)) (defun gnus-summary-kill-process-mark () "Push the current set of process marked articles on the stack and unmark." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-save-process-mark) (gnus-summary-unmark-all-processable)) (defun gnus-summary-yank-process-mark () "Pop the last process mark state off the stack and restore it." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-newsgroup-process-stack (error "Empty mark stack")) (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack))) @@ -6818,7 +6831,7 @@ articles with that subject. If BACKWARD, search backward instead." (defun gnus-recenter (&optional n) "Center point in window and redisplay frame. Also do horizontal recentering." - (interactive "P") + (interactive "P" gnus-summary-mode) (when (and gnus-auto-center-summary (not (eq gnus-auto-center-summary 'vertical))) (gnus-horizontal-recenter)) @@ -6852,7 +6865,7 @@ If `gnus-auto-center-summary' is nil, or the article buffer isn't displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. - (interactive) + (interactive nil gnus-summary-mode) ;; The user has to want it. (when gnus-auto-center-summary (let* ((top (cond ((< (window-height) 4) 0) @@ -7029,7 +7042,7 @@ displayed, no centering will be performed." "Reconfigure windows to show the article buffer. If `gnus-widen-article-window' is set, show only the article buffer." - (interactive) + (interactive nil gnus-summary-mode) (if (not (gnus-buffer-live-p gnus-article-buffer)) (error "There is no article buffer for this summary buffer") (or (get-buffer-window gnus-article-buffer) @@ -7052,7 +7065,7 @@ buffer." (defun gnus-summary-universal-argument (arg) "Perform any operation on all articles that are process/prefixed." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((articles (gnus-summary-work-articles arg)) func article) (if (eq @@ -7073,7 +7086,7 @@ buffer." (gnus-summary-position-point)) (define-obsolete-function-alias - 'gnus-summary-toggle-truncation #'toggle-truncate-lines "26.1") + 'gnus-summary-toggle-truncation #'toggle-truncate-lines "26.1") (defun gnus-summary-find-for-reselect () "Return the number of an article to stay on across a reselect. @@ -7095,7 +7108,7 @@ insertion from another group. If there's no such then return a dummy 0." (defun gnus-summary-reselect-current-group (&optional all rescan) "Exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (when (gnus-ephemeral-group-p gnus-newsgroup-name) (error "Ephemeral groups can't be reselected")) (let ((current-subject (gnus-summary-find-for-reselect)) @@ -7113,7 +7126,7 @@ The prefix argument ALL means to select all articles." (defun gnus-summary-rescan-group (&optional all) "Exit the newsgroup, ask for new articles, and select the newsgroup." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((config gnus-current-window-configuration)) (gnus-summary-reselect-current-group all t) (gnus-configure-windows config) @@ -7168,7 +7181,7 @@ The prefix argument ALL means to select all articles." (defun gnus-summary-make-group-from-search () "Make a persistent group from the current ephemeral search group." - (interactive) + (interactive nil gnus-summary-mode) (if (not (gnus-nnselect-group-p gnus-newsgroup-name)) (gnus-message 3 "%s is not a search group" gnus-newsgroup-name) (let ((name (gnus-read-group "Group name: "))) @@ -7185,7 +7198,7 @@ The prefix argument ALL means to select all articles." "Save the current number of read/marked articles in the dribble buffer. The dribble buffer will then be saved. If FORCE (the prefix), also save the .newsrc file(s)." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-update-info t) (if force (gnus-save-newsrc-file) @@ -7197,7 +7210,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (defun gnus-summary-exit (&optional temporary leave-hidden) "Exit reading current newsgroup, and then return to group selection mode. `gnus-exit-group-hook' is called with no arguments if that value is non-nil." - (interactive) + (interactive nil gnus-summary-mode) (gnus-set-global-variables) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer @@ -7303,7 +7316,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) (defun gnus-summary-exit-no-update (&optional no-questions) "Quit reading current newsgroup without updating read article info." - (interactive) + (interactive nil gnus-summary-mode) (let* ((group gnus-newsgroup-name) (gnus-group-is-exiting-p t) (gnus-group-is-exiting-without-update-p t) @@ -7457,7 +7470,7 @@ The state which existed when entering the ephemeral is reset." (defun gnus-summary-wake-up-the-dead (&rest _) "Wake up the dead summary buffer." - (interactive) + (interactive nil gnus-summary-mode) (gnus-dead-summary-mode -1) (let ((name (buffer-name))) (when (string-match "Dead " name) @@ -7470,12 +7483,12 @@ The state which existed when entering the ephemeral is reset." ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. (defun gnus-summary-describe-group (&optional force) "Describe the current newsgroup." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-group-describe-group force gnus-newsgroup-name)) (defun gnus-summary-describe-briefly () "Describe summary mode commands briefly." - (interactive) + (interactive nil gnus-summary-mode) (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) ;; Walking around group mode buffer from summary mode. @@ -7485,7 +7498,7 @@ The state which existed when entering the ephemeral is reset." If prefix argument NO-ARTICLE is non-nil, no article is selected initially. If TARGET-GROUP, go to this group. If BACKWARD, go to previous group instead." - (interactive "P") + (interactive "P" gnus-summary-mode) ;; Stop pre-fetching. (gnus-async-halt-prefetch) (let ((current-group gnus-newsgroup-name) @@ -7531,7 +7544,7 @@ previous group instead." (defun gnus-summary-prev-group (&optional no-article) "Exit current newsgroup and then select previous unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-next-group no-article nil t)) ;; Walking around summary lines. @@ -7542,7 +7555,7 @@ If UNREAD is non-nil, the article should be unread. If UNDOWNLOADED is non-nil, the article should be undownloaded. If UNSEEN is non-nil, the article should be unseen as well as unread. Returns the article selected or nil if there are no matching articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (cond ;; Empty summary. ((null gnus-newsgroup-data) @@ -7594,7 +7607,7 @@ If N is negative, go to the previous N'th subject line. If UNREAD is non-nil, only unread articles are selected. The difference between N and the actual number of steps taken is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) @@ -7613,18 +7626,18 @@ returned." (defun gnus-summary-next-unread-subject (n) "Go to next N'th unread summary line." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-next-subject n t)) (defun gnus-summary-prev-subject (n &optional unread) "Go to previous N'th summary line. If optional argument UNREAD is non-nil, only unread article is selected." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-next-subject (- n) unread)) (defun gnus-summary-prev-unread-subject (n) "Go to previous N'th unread summary line." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-next-subject (- n) t)) (defun gnus-summary-goto-subjects (articles) @@ -7638,7 +7651,7 @@ If optional argument UNREAD is non-nil, only unread article is selected." (defun gnus-summary-goto-subject (article &optional force silent) "Go to the subject line of ARTICLE. If FORCE, also allow jumping to articles not currently shown." - (interactive "nArticle number: ") + (interactive "nArticle number: " gnus-summary-mode) (unless (numberp article) (error "Article %s is not a number" article)) (let ((b (point)) @@ -7668,7 +7681,7 @@ If FORCE, also allow jumping to articles not currently shown." (defun gnus-summary-expand-window (&optional arg) "Make the summary buffer take up the entire Emacs frame. Given a prefix, will force an `article' buffer configuration." - (interactive "P") + (interactive "P" gnus-summary-mode) (if arg (gnus-configure-windows 'article 'force) (gnus-configure-windows 'summary 'force))) @@ -7751,7 +7764,7 @@ be displayed." (defun gnus-summary-force-verify-and-decrypt () "Display buttons for signed/encrypted parts and verify/decrypt them." - (interactive) + (interactive nil gnus-summary-mode) (let ((mm-verify-option 'known) (mm-decrypt-option 'known) (gnus-article-emulate-mime t) @@ -7765,7 +7778,7 @@ be displayed." If UNREAD, only unread articles are selected. If SUBJECT, only articles with SUBJECT are selected. If BACKWARD, the previous article is selected instead of the next." - (interactive "P") + (interactive "P" gnus-summary-mode) ;; Make sure we are in the summary buffer. (unless (derived-mode-p 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) @@ -7877,7 +7890,7 @@ If BACKWARD, the previous article is selected instead of the next." (defun gnus-summary-next-unread-article () "Select unread article after current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-next-article (or (not (eq gnus-summary-goto-unread 'never)) (gnus-summary-last-article-p (gnus-summary-article-number))) @@ -7887,12 +7900,12 @@ If BACKWARD, the previous article is selected instead of the next." (defun gnus-summary-prev-article (&optional unread subject) "Select the article before the current one. If UNREAD is non-nil, only unread articles are selected." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-next-article unread subject t)) (defun gnus-summary-prev-unread-article () "Select unread article before current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-prev-article (or (not (eq gnus-summary-goto-unread 'never)) (gnus-summary-first-article-p (gnus-summary-article-number))) @@ -7913,7 +7926,7 @@ article. If STOP is non-nil, just stop when reaching the end of the message. Also see the variable `gnus-article-skip-boring'." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-set-global-variables) (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) @@ -7958,7 +7971,7 @@ Also see the variable `gnus-article-skip-boring'." Argument LINES specifies lines to be scrolled down. If MOVE, move to the previous unread article if point is at the beginning of the buffer." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) endp) @@ -7988,14 +8001,14 @@ the beginning of the buffer." "Show previous page of selected article. Argument LINES specifies lines to be scrolled down. If at the beginning of the article, go to the next article." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-prev-page lines t)) (defun gnus-summary-scroll-up (lines) "Scroll up (or down) one line current article. Argument LINES specifies lines to be scrolled up (or down if negative). If no article is selected, then the current article will be selected first." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-configure-windows 'article) (gnus-summary-show-thread) (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) @@ -8012,33 +8025,33 @@ If no article is selected, then the current article will be selected first." "Scroll down (or up) one line current article. Argument LINES specifies lines to be scrolled down (or up if negative). If no article is selected, then the current article will be selected first." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-scroll-up (- lines))) (defun gnus-summary-next-same-subject () "Select next article which has the same subject as current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-next-article nil (gnus-summary-article-subject))) (defun gnus-summary-prev-same-subject () "Select previous article which has the same subject as current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-prev-article nil (gnus-summary-article-subject))) (defun gnus-summary-next-unread-same-subject () "Select next unread article which has the same subject as current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-next-article t (gnus-summary-article-subject))) (defun gnus-summary-prev-unread-same-subject () "Select previous unread article which has the same subject as current one." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-prev-article t (gnus-summary-article-subject))) (defun gnus-summary-first-unread-article () "Select the first unread article. Return nil if there are no unread articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when (gnus-summary-first-subject t) (gnus-summary-show-thread) @@ -8049,7 +8062,7 @@ Return nil if there are no unread articles." (defun gnus-summary-first-unread-subject () "Place the point on the subject line of the first unread article. Return nil if there are no unread articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when (gnus-summary-first-subject t) (gnus-summary-show-thread) @@ -8058,7 +8071,7 @@ Return nil if there are no unread articles." (defun gnus-summary-next-unseen-article (&optional backward) "Select the next unseen article." - (interactive) + (interactive nil gnus-summary-mode) (let* ((article (gnus-summary-article-number)) (articles (gnus-data-find-list article (gnus-data-list backward)))) (when (or (not gnus-summary-check-current) @@ -8079,13 +8092,13 @@ Return nil if there are no unread articles." (defun gnus-summary-prev-unseen-article () "Select the previous unseen article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-next-unseen-article t)) (defun gnus-summary-first-unseen-subject () "Place the point on the subject line of the first unseen article. Return nil if there are no unseen articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when (gnus-summary-first-subject nil nil t) (gnus-summary-show-thread) @@ -8094,9 +8107,9 @@ Return nil if there are no unseen articles." (defun gnus-summary-first-unseen-or-unread-subject () "Place the point on the subject line of the first unseen and unread article. -If all article have been seen, on the subject line of the first unread +If all articles have been seen, on the subject line of the first unread article." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (unless (when (gnus-summary-first-subject nil nil t) (gnus-summary-show-thread) @@ -8109,7 +8122,7 @@ article." (defun gnus-summary-first-article () "Select the first article. Return nil if there are no articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when (gnus-summary-first-subject) (gnus-summary-show-thread) @@ -8121,7 +8134,7 @@ Return nil if there are no articles." "Select the unread article with the highest score. If given a prefix argument, select the next unread article that has a score higher than the default score." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((article (if arg (gnus-summary-better-unread-subject) (gnus-summary-best-unread-subject)))) @@ -8131,7 +8144,7 @@ score higher than the default score." (defun gnus-summary-best-unread-subject () "Select the unread subject with the highest score." - (interactive) + (interactive nil gnus-summary-mode) (let ((best -1000000) (data gnus-newsgroup-data) article score) @@ -8150,7 +8163,7 @@ score higher than the default score." (defun gnus-summary-better-unread-subject () "Select the first unread subject that has a score over the default score." - (interactive) + (interactive nil gnus-summary-mode) (let ((data gnus-newsgroup-data) article) (while (and (setq article (gnus-data-number (car data))) @@ -8176,11 +8189,10 @@ If FORCE, go to the article even if it isn't displayed. If FORCE is a number, it is the line the article is to be displayed on." (interactive (list - (gnus-completing-read - "Article number or Message-ID" - (mapcar #'int-to-string gnus-newsgroup-limit)) - current-prefix-arg - t)) + (gnus-completing-read "Article number or Message-ID" + (mapcar #'int-to-string gnus-newsgroup-limit)) + current-prefix-arg t) + gnus-summary-mode) (prog1 (if (and (stringp article) (string-match "@\\|%40" article)) @@ -8194,7 +8206,7 @@ is a number, it is the line the article is to be displayed on." (defun gnus-summary-goto-last-article () "Go to the previously read article." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (when gnus-last-article (gnus-summary-goto-article gnus-last-article nil t)) @@ -8203,7 +8215,7 @@ is a number, it is the line the article is to be displayed on." (defun gnus-summary-pop-article (number) "Pop one article off the history and go to the previous. NUMBER articles will be popped off." - (interactive "p") + (interactive "p" gnus-summary-mode) (let (to) (setq gnus-newsgroup-history (cdr (setq to (nthcdr number gnus-newsgroup-history)))) @@ -8217,7 +8229,7 @@ NUMBER articles will be popped off." (defun gnus-summary-limit-to-articles (n) "Limit the summary buffer to the next N articles. If not given a prefix, use the process marked articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (prog1 (let ((articles (gnus-summary-work-articles n))) (setq gnus-newsgroup-processable nil) @@ -8227,7 +8239,7 @@ If not given a prefix, use the process marked articles instead." (defun gnus-summary-pop-limit (&optional total) "Restore the previous limit. If given a prefix, remove all limits." - (interactive "P") + (interactive "P" gnus-summary-mode) (when total (setq gnus-newsgroup-limits (list (mapcar #'mail-header-number gnus-newsgroup-headers)))) @@ -8241,10 +8253,11 @@ If given a prefix, remove all limits." "Limit the summary buffer to articles that have subjects that match a regexp. If NOT-MATCHING, excluding articles that have subjects that match a regexp." (interactive - (list (read-string (if current-prefix-arg - "Exclude subject (regexp): " - "Limit to subject (regexp): ")) - nil current-prefix-arg)) + (list + (read-string + (if current-prefix-arg "Exclude subject (regexp): " "Limit to subject (regexp): ")) + nil current-prefix-arg) + gnus-summary-mode) (unless header (setq header "subject")) (when (not (equal "" subject)) @@ -8252,7 +8265,7 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp." (let ((articles (gnus-summary-find-matching (or header "subject") subject 'all nil nil not-matching))) - (unless articles + (unless (or articles not-matching) (error "Found no matches for \"%s\"" subject)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) @@ -8261,18 +8274,25 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp." "Limit the summary buffer to articles that have authors that match a regexp. If NOT-MATCHING, excluding articles that have authors that match a regexp." (interactive - (list (let* ((header (gnus-summary-article-header)) - (default (and header (car (mail-header-parse-address - (mail-header-from header)))))) - (read-string (concat (if current-prefix-arg - "Exclude author (regexp" - "Limit to author (regexp") - (if default - (concat ", default \"" default "\"): ") - "): ")) - nil nil - default)) - current-prefix-arg)) + (list + (let* + ((header + (gnus-summary-article-header)) + (default + (and header + (car + (mail-header-parse-address + (mail-header-from header)))))) + (read-string + (concat + (if current-prefix-arg + "Exclude author (regexp" "Limit to author (regexp") + (if default + (concat ", default \"" default "\"): ") + "): ")) + nil nil default)) + current-prefix-arg) + gnus-summary-mode) (gnus-summary-limit-to-subject from "from" not-matching)) (defun gnus-summary-limit-to-recipient (recipient &optional not-matching) @@ -8284,9 +8304,12 @@ To and Cc headers are checked. You need to include them in `nnmail-extra-headers'." ;; Unlike `rmail-summary-by-recipients', doesn't include From. (interactive - (list (read-string (format "%s recipient (regexp): " - (if current-prefix-arg "Exclude" "Limit to"))) - current-prefix-arg)) + (list + (read-string + (format "%s recipient (regexp): " + (if current-prefix-arg "Exclude" "Limit to"))) + current-prefix-arg) + gnus-summary-mode) (when (not (equal "" recipient)) (prog1 (let* ((to (if (memq 'To nnmail-extra-headers) @@ -8313,7 +8336,7 @@ To and Cc headers are checked. You need to include them in (and (memq a to) a)) cc) (nconc to cc)))) - (unless articles + (unless (or articles not-matching) (error "Found no matches for \"%s\"" recipient)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) @@ -8326,9 +8349,12 @@ If NOT-MATCHING, exclude ADDRESS. To, Cc and From headers are checked. You need to include `To' and `Cc' in `nnmail-extra-headers'." (interactive - (list (read-string (format "%s address (regexp): " - (if current-prefix-arg "Exclude" "Limit to"))) - current-prefix-arg)) + (list + (read-string + (format "%s address (regexp): " + (if current-prefix-arg "Exclude" "Limit to"))) + current-prefix-arg) + gnus-summary-mode) (when (not (equal "" address)) (prog1 (let* ((to (if (memq 'To nnmail-extra-headers) @@ -8366,7 +8392,7 @@ in `nnmail-extra-headers'." (nconc (if (eq to t) nil to) (if (eq cc t) nil cc) from)))) - (unless articles + (unless (or articles not-matching) (error "Found no matches for \"%s\"" address)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) @@ -8415,7 +8441,8 @@ articles that are younger than AGE days." (setq days (* days -1)))) (message "Please enter a number.") (sleep-for 1))) - (list days younger))) + (list days younger)) + gnus-summary-mode) (prog1 (let ((data gnus-newsgroup-data) (cutoff (days-to-time age)) @@ -8439,30 +8466,31 @@ articles that are younger than AGE days." (let ((header (intern (gnus-completing-read - (if current-prefix-arg - "Exclude extra header" - "Limit extra header") + (if current-prefix-arg "Exclude extra header" "Limit extra header") (mapcar #'symbol-name gnus-extra-headers) t nil nil - (symbol-name (car gnus-extra-headers)))))) + (symbol-name + (car gnus-extra-headers)))))) (list header - (read-string (format "%s header %s (regexp): " - (if current-prefix-arg "Exclude" "Limit to") - header)) - current-prefix-arg))) + (read-string + (format "%s header %s (regexp): " + (if current-prefix-arg "Exclude" "Limit to") + header)) + current-prefix-arg)) + gnus-summary-mode) (when (not (equal "" regexp)) (prog1 (let ((articles (gnus-summary-find-matching (cons 'extra header) regexp 'all nil nil not-matching))) - (unless articles + (unless (or articles not-matching) (error "Found no matches for \"%s\"" regexp)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) (defun gnus-summary-limit-to-display-predicate () "Limit the summary buffer to the predicated in the `display' group parameter." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-newsgroup-display (error "There is no `display' group parameter")) (let (articles) @@ -8475,7 +8503,7 @@ articles that are younger than AGE days." (defun gnus-summary-limit-to-unread (&optional all) "Limit the summary buffer to articles that are not marked as read. If ALL is non-nil, limit strictly to unread articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (if all (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) (gnus-summary-limit-to-marks @@ -8491,7 +8519,7 @@ If ALL is non-nil, limit strictly to unread articles." (defun gnus-summary-limit-to-headers (match &optional reverse) "Limit the summary buffer to articles that have headers that match MATCH. If REVERSE (the prefix), limit to articles that don't match." - (interactive "sMatch headers (regexp): \nP") + (interactive "sMatch headers (regexp): \nP" gnus-summary-mode) (gnus-summary-limit-to-bodies match reverse t)) (declare-function article-goto-body "gnus-art" ()) @@ -8499,7 +8527,7 @@ If REVERSE (the prefix), limit to articles that don't match." (defun gnus-summary-limit-to-bodies (match &optional reverse headersp) "Limit the summary buffer to articles that have bodies that match MATCH. If REVERSE (the prefix), limit to articles that don't match." - (interactive "sMatch body (regexp): \nP") + (interactive "sMatch body (regexp): \nP" gnus-summary-mode) (let ((articles nil) (gnus-select-article-hook nil) ;Disable hook. (gnus-article-prepare-hook nil) @@ -8532,7 +8560,7 @@ If REVERSE (the prefix), limit to articles that don't match." (defun gnus-summary-limit-to-singletons (&optional threadsp) "Limit the summary buffer to articles that aren't part on any thread. If THREADSP (the prefix), limit to articles that are in threads." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((articles nil) thread-articles threads) @@ -8556,11 +8584,12 @@ If THREADSP (the prefix), limit to articles that are in threads." (defun gnus-summary-limit-to-replied (&optional unreplied) "Limit the summary buffer to replied articles. If UNREPLIED (the prefix), limit to unreplied articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (if unreplied (gnus-summary-limit - (gnus-set-difference gnus-newsgroup-articles - gnus-newsgroup-replied)) + (seq-difference gnus-newsgroup-articles + gnus-newsgroup-replied + #'eq)) (gnus-summary-limit gnus-newsgroup-replied)) (gnus-summary-position-point)) @@ -8569,7 +8598,7 @@ If UNREPLIED (the prefix), limit to unreplied articles." If REVERSE, limit the summary buffer to articles that are marked with MARKS. MARKS can either be a string of marks or a list of marks. Returns how many articles were removed." - (interactive "sMarks: ") + (interactive "sMarks: " gnus-summary-mode) (gnus-summary-limit-to-marks marks t)) (defun gnus-summary-limit-to-marks (marks &optional reverse) @@ -8578,7 +8607,7 @@ If REVERSE (the prefix), limit the summary buffer to articles that are not marked with MARKS. MARKS can either be a string of marks or a list of marks. Returns how many articles were removed." - (interactive "sMarks: \nP") + (interactive "sMarks: \nP" gnus-summary-mode) (prog1 (let ((data gnus-newsgroup-data) (marks (if (listp marks) marks @@ -8597,10 +8626,13 @@ Returns how many articles were removed." With a prefix argument, limit to articles with score at or below SCORE." - (interactive (list (string-to-number - (read-string - (format "Limit to articles with score of at %s: " - (if current-prefix-arg "most" "least")))))) + (interactive + (list + (string-to-number + (read-string + (format "Limit to articles with score of at %s: " + (if current-prefix-arg "most" "least"))))) + gnus-summary-mode) (let ((data gnus-newsgroup-data) (compare (if (or below current-prefix-arg) #'<= #'>=)) articles) @@ -8616,7 +8648,7 @@ SCORE." (defun gnus-summary-limit-to-unseen () "Limit to unseen articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (gnus-summary-limit gnus-newsgroup-unseen) (gnus-summary-position-point))) @@ -8626,8 +8658,12 @@ SCORE." When called interactively, ID is the Message-ID of the current article. If thread-only is non-nil limit the summary buffer to these articles." - (interactive (list (mail-header-id (gnus-summary-article-header)) - current-prefix-arg)) + (interactive + (list + (mail-header-id + (gnus-summary-article-header)) + current-prefix-arg) + gnus-summary-mode) (let ((articles (gnus-articles-in-thread (gnus-id-to-thread (gnus-root-id id)))) ;;we REALLY want the whole thread---this prevents cut-threads @@ -8653,8 +8689,11 @@ these articles." (defun gnus-summary-limit-include-matching-articles (header regexp) "Display all the hidden articles that have HEADERs that match REGEXP." - (interactive (list (read-string "Match on header: ") - (read-string "Regexp: "))) + (interactive + (list + (read-string "Match on header: ") + (read-string "Regexp: ")) + gnus-summary-mode) (let ((articles (gnus-find-matching-articles header regexp))) (prog1 (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) @@ -8662,7 +8701,7 @@ these articles." (defun gnus-summary-insert-dormant-articles () "Insert all the dormant articles for this group into the current buffer." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-verbose (max 6 gnus-verbose))) (if (not gnus-newsgroup-dormant) (gnus-message 3 "No dormant articles for this group") @@ -8670,7 +8709,7 @@ these articles." (defun gnus-summary-insert-ticked-articles () "Insert ticked articles for this group into the current buffer." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-verbose (max 6 gnus-verbose))) (if (not gnus-newsgroup-marked) (gnus-message 3 "No ticked articles for this group") @@ -8680,7 +8719,7 @@ these articles." "Display all the hidden articles that are marked as dormant. Note that this command only works on a subset of the articles currently fetched for this group." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-newsgroup-dormant (error "There are no dormant articles in this group")) (prog1 @@ -8703,14 +8742,14 @@ fetched for this group." (defun gnus-summary-limit-exclude-dormant () "Hide all dormant articles." - (interactive) + (interactive nil gnus-summary-mode) (prog1 (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) (gnus-summary-position-point))) (defun gnus-summary-limit-exclude-childless-dormant () "Hide all dormant articles that have no children." - (interactive) + (interactive nil gnus-summary-mode) (let ((data (gnus-data-list t)) articles d children) ;; Find all articles that are either not dormant or have @@ -8735,7 +8774,7 @@ fetched for this group." (defun gnus-summary-limit-mark-excluded-as-read (&optional all) "Mark all unread excluded articles as read. If ALL, mark even excluded ticked and dormants as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<)) (let ((articles (gnus-sorted-ndifference (sort @@ -8974,7 +9013,7 @@ fetch-old-headers verbiage, and so on." "Refer parent article N times. If N is negative, go to ancestor -N instead. The difference between N and the number of articles fetched is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (let ((skip 1) error header ref) (when (not (natnump n)) @@ -9016,7 +9055,7 @@ The difference between N and the number of articles fetched is returned." (defun gnus-summary-refer-references () "Fetch all articles mentioned in the References header. Return the number of articles fetched." - (interactive) + (interactive nil gnus-summary-mode) (let ((ref (mail-header-references (gnus-summary-article-header))) (current (gnus-summary-article-number)) (n 0)) @@ -9059,7 +9098,7 @@ has the reverse meaning. If no backend-specific `request-thread' function is available fetch LIMIT (the numerical prefix) old headers. If LIMIT is non-numeric or nil fetch the number specified by the `gnus-refer-thread-limit' variable." - (interactive "P") + (interactive "P" gnus-summary-mode) (let* ((header (gnus-summary-article-header)) (id (mail-header-id header)) (gnus-inhibit-demon t) @@ -9114,7 +9153,7 @@ specified by the `gnus-refer-thread-limit' variable." (defun gnus-summary-open-group-with-article (message-id) "Open a group containing the article with the given MESSAGE-ID." - (interactive "sMessage-ID: ") + (interactive "sMessage-ID: " gnus-summary-mode) (require 'nndoc) (with-temp-buffer ;; Prepare a dummy article @@ -9149,10 +9188,10 @@ specified by the `gnus-refer-thread-limit' variable." (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." - (interactive "sMessage-ID: ") + (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) @@ -9160,7 +9199,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 @@ -9222,12 +9261,12 @@ specified by the `gnus-refer-thread-limit' variable." (defun gnus-summary-edit-parameters () "Edit the group parameters of the current group." - (interactive) + (interactive nil gnus-summary-mode) (gnus-group-edit-group gnus-newsgroup-name 'params)) (defun gnus-summary-customize-parameters () "Customize the group parameters of the current group." - (interactive) + (interactive nil gnus-summary-mode) (gnus-group-customize gnus-newsgroup-name)) (defun gnus-summary-enter-digest-group (&optional force) @@ -9237,7 +9276,7 @@ what the document format is. To control what happens when you exit the group, see the `gnus-auto-select-on-ephemeral-exit' variable." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((conf gnus-current-window-configuration)) (save-window-excursion (save-excursion @@ -9322,7 +9361,7 @@ To control what happens when you exit the group, see the This will allow you to read digests and other similar documents as newsgroups. Obeys the standard process/prefix convention." - (interactive "P") + (interactive "P" gnus-summary-mode) (let* ((ogroup gnus-newsgroup-name) (params (append (gnus-info-params (gnus-get-info ogroup)) (list (cons 'to-group ogroup)))) @@ -9371,7 +9410,7 @@ Obeys the standard process/prefix convention." (defun gnus-summary-button-forward (arg) "Move point to the next field or button in the article. With optional ARG, move across that many fields." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (let ((win (or (gnus-get-buffer-window gnus-article-buffer t) @@ -9385,7 +9424,7 @@ With optional ARG, move across that many fields." (defun gnus-summary-button-backward (arg) "Move point to the previous field or button in the article. With optional ARG, move across that many fields." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (let ((win (or (gnus-get-buffer-window gnus-article-buffer t) @@ -9442,7 +9481,7 @@ If only one link is found, browse that directly, otherwise use completion to select a link. The first link marked in the article text with `gnus-collect-urls-primary-text' is the default." - (interactive "P") + (interactive "P" gnus-summary-mode) (let (urls target) (gnus-summary-select-article) (gnus-with-article-buffer @@ -9467,7 +9506,7 @@ default." (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9477,14 +9516,14 @@ If REGEXP-P (the prefix) is non-nil, do regexp isearch." (defun gnus-summary-repeat-search-article-forward () "Repeat the previous search forwards." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-last-search-regexp (error "No previous search")) (gnus-summary-search-article-forward gnus-last-search-regexp)) (defun gnus-summary-repeat-search-article-backward () "Repeat the previous search backwards." - (interactive) + (interactive nil gnus-summary-mode) (unless gnus-last-search-regexp (error "No previous search")) (gnus-summary-search-article-forward gnus-last-search-regexp t)) @@ -9493,13 +9532,13 @@ If REGEXP-P (the prefix) is non-nil, do regexp isearch." "Search for an article containing REGEXP forward. If BACKWARD, search backward instead." (interactive - (list (read-string - (format "Search article %s (regexp%s): " - (if current-prefix-arg "backward" "forward") - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))) - current-prefix-arg)) + (list + (read-string + (format-prompt "Search article %s (regexp)" + gnus-last-search-regexp + (if current-prefix-arg "backward" "forward"))) + current-prefix-arg) + gnus-summary-mode) (if (string-equal regexp "") (setq regexp (or gnus-last-search-regexp "")) (setq gnus-last-search-regexp regexp) @@ -9514,11 +9553,11 @@ If BACKWARD, search backward instead." (defun gnus-summary-search-article-backward (regexp) "Search for an article containing REGEXP backward." (interactive - (list (read-string - (format "Search article backward (regexp%s): " - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))))) + (list + (read-string + (format-prompt "Search article backward (regexp)" + gnus-last-search-regexp))) + gnus-summary-mode) (gnus-summary-search-article-forward regexp 'backward)) (defun gnus-summary-search-article (regexp &optional backward) @@ -9653,18 +9692,20 @@ that not match REGEXP on HEADER." If HEADER is an empty string (or nil), the match is done on the entire article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive - (list (let ((completion-ignore-case t)) - (gnus-completing-read - "Header name" - (mapcar #'symbol-name - (append - '(Number Subject From Lines Date - Message-ID Xref References Body) - gnus-extra-headers)) - 'require-match)) - (read-string "Regexp: ") - (read-key-sequence "Command: ") - current-prefix-arg)) + (list + (let ((completion-ignore-case t)) + (gnus-completing-read + "Header name" + (mapcar #'symbol-name + (append + '(Number Subject From Lines Date Message-ID + Xref References Body) + gnus-extra-headers)) + 'require-match)) + (read-string "Regexp: ") + (read-key-sequence "Command: ") + current-prefix-arg) + gnus-summary-mode) (when (equal header "Body") (setq header "")) ;; Hidden thread subtrees must be searched as well. @@ -9688,7 +9729,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (defun gnus-summary-beginning-of-article () "Scroll the article back to the beginning." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9699,7 +9740,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (defun gnus-summary-end-of-article () "Scroll to the end of the article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (gnus-configure-windows 'article) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9732,7 +9773,9 @@ If the optional first argument FILENAME is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name. If FILENAME is a number, prompt the user for the name of the file to save in." - (interactive (list (ps-print-preprint current-prefix-arg))) + (interactive + (list (ps-print-preprint current-prefix-arg)) + gnus-summary-mode) (dolist (article (gnus-summary-work-articles n)) (gnus-summary-select-article nil nil 'pseudo article) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9772,7 +9815,7 @@ to save in." "Show a complete version of the current article. This is only useful if you're looking at a partial version of the article currently." - (interactive) + (interactive nil gnus-summary-mode) (let ((gnus-keep-backlog nil) (gnus-use-cache nil) (gnus-agent nil) @@ -9799,7 +9842,7 @@ 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." - (interactive "P") + (interactive "P" gnus-summary-mode) (cond ((numberp arg) (gnus-summary-show-article t) @@ -9875,14 +9918,14 @@ C-u g', show the raw article." (defun gnus-summary-show-raw-article () "Show the raw article without any article massaging functions being run." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-show-article t)) (defun gnus-summary-verbose-headers (&optional arg) "Toggle permanent full header display. If ARG is a positive number, turn header display on. If ARG is a negative number, turn header display off." - (interactive "P") + (interactive "P" gnus-summary-mode) (setq gnus-show-all-headers (cond ((or (not (numberp arg)) (zerop arg)) @@ -9901,7 +9944,7 @@ If ARG is a negative number, turn header display off." "Show the headers if they are hidden, or hide them if they are shown. If ARG is a positive number, show the entire header. If ARG is a negative number, hide the unwanted header lines." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((window (and (gnus-buffer-live-p gnus-article-buffer) (get-buffer-window gnus-article-buffer t)))) (with-current-buffer gnus-article-buffer @@ -9947,14 +9990,14 @@ If ARG is a negative number, hide the unwanted header lines." (defun gnus-summary-show-all-headers () "Make all header lines visible." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-toggle-header 1)) (defun gnus-summary-caesar-message (&optional arg) "Caesar rotate the current article by 13. With a non-numerical prefix, also rotate headers. A numerical prefix specifies how many places to rotate each letter forward." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9977,7 +10020,7 @@ invalid IDNA string (`xn--bar' is invalid). You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/') installed for this command to work." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9991,7 +10034,7 @@ installed for this command to work." (defun gnus-summary-morse-message (&optional _arg) "Morse decode the current article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -10012,7 +10055,7 @@ installed for this command to work." (defun gnus-summary-stop-page-breaking () "Stop page breaking in the current article." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (widen) @@ -10042,7 +10085,7 @@ newsgroup that you want to move to have to support the `request-move' and `request-accept' functions. ACTION can be either `move' (the default), `crosspost' or `copy'." - (interactive "P") + (interactive "P" gnus-summary-mode) (unless action (setq action 'move)) ;; Check whether the source group supports the required functions. @@ -10348,13 +10391,13 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Copy the current article to some other group. Arguments have the same meanings as in `gnus-summary-move-article'." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-move-article n to-newsgroup select-method 'copy)) (defun gnus-summary-crosspost-article (&optional n) "Crosspost the current article to some other group. Arguments have the same meanings as in `gnus-summary-move-article'." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-move-article n nil nil 'crosspost)) (defcustom gnus-summary-respool-default-method nil @@ -10398,7 +10441,8 @@ latter case, they will be copied into the relevant groups." (t (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms))) (cdr (assoc (gnus-completing-read "Server name" ms-alist t) - ms-alist)))))))) + ms-alist))))))) + gnus-summary-mode) (unless method (error "No method given for respooling")) (if (assoc (symbol-name @@ -10409,7 +10453,7 @@ latter case, they will be copied into the relevant groups." (defun gnus-summary-import-article (file &optional edit) "Import an arbitrary file into a mail newsgroup." - (interactive "fImport file: \nP") + (interactive "fImport file: \nP" gnus-summary-mode) (let ((group gnus-newsgroup-name) atts lines group-art) (unless (gnus-check-backend-function 'request-accept-article group) @@ -10453,7 +10497,7 @@ latter case, they will be copied into the relevant groups." (defun gnus-summary-create-article () "Create an article in a mail newsgroup." - (interactive) + (interactive nil gnus-summary-mode) (let ((group gnus-newsgroup-name) (now (current-time)) group-art) @@ -10477,7 +10521,7 @@ latter case, they will be copied into the relevant groups." (defun gnus-summary-article-posted-p () "Say whether the current (mail) article is available from news as well. This will be the case if the article has both been mailed and posted." - (interactive) + (interactive nil gnus-summary-mode) (let ((id (mail-header-references (gnus-summary-article-header))) (gnus-override-method (car (gnus-refer-article-methods)))) (if (gnus-request-head id "") @@ -10489,7 +10533,7 @@ This will be the case if the article has both been mailed and posted." (defun gnus-summary-expire-articles (&optional now) "Expire all articles that are marked as expirable in the current group." - (interactive) + (interactive nil gnus-summary-mode) (when (and (not gnus-group-is-exiting-without-update-p) (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)) @@ -10558,7 +10602,7 @@ This will be the case if the article has both been mailed and posted." "Expunge all expirable articles in the current group. This means that *all* articles that are marked as expirable will be deleted forever, right now." - (interactive) + (interactive nil gnus-summary-mode) (or gnus-expert-user (gnus-yes-or-no-p "Are you really, really sure you want to delete all expirable messages? ") @@ -10578,7 +10622,7 @@ delete these instead. If `gnus-novice-user' is non-nil you will be asked for confirmation before the articles are deleted." - (interactive "P") + (interactive "P" gnus-summary-mode) (unless (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion")) @@ -10628,7 +10672,7 @@ If ARG is 2, edit the raw articles even in read-only groups. If ARG is 3, edit the articles with the current handles. Otherwise, allow editing of articles even in read-only groups." - (interactive "P") + (interactive "P" gnus-summary-mode) (let (force raw current-handles) (cond ((null arg)) @@ -10708,7 +10752,7 @@ groups." (defun gnus-summary-edit-article-done (&optional references read-only buffer no-highlight) "Make edits to the current article permanent." - (interactive) + (interactive nil gnus-summary-mode) (save-excursion ;; The buffer restriction contains the entire article if it exists. (when (article-goto-body) @@ -10796,7 +10840,8 @@ groups." (list (progn (message "%s" (concat (this-command-keys) "- ")) - (read-char)))) + (read-char))) + gnus-summary-mode) (message "") (gnus-summary-edit-article) (execute-kbd-macro (concat (this-command-keys) key)) @@ -10809,7 +10854,7 @@ groups." (defun gnus-summary-respool-query (&optional silent trace) "Query where the respool algorithm would put this article." - (interactive) + (interactive nil gnus-summary-mode) (let (gnus-mark-article-hook) (gnus-summary-select-article) (with-current-buffer gnus-original-article-buffer @@ -10839,7 +10884,7 @@ groups." (defun gnus-summary-respool-trace () "Trace where the respool algorithm would put this article. Display a buffer showing all fancy splitting patterns which matched." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-respool-query nil t)) ;; Summary marking commands. @@ -10848,7 +10893,7 @@ Display a buffer showing all fancy splitting patterns which matched." "Mark articles which has the same subject as read, and then select the next. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (when unmark (setq unmark (prefix-numeric-value unmark))) (let ((count @@ -10866,7 +10911,7 @@ If UNMARK is negative, tick articles." "Mark articles which has the same subject as read. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (when unmark (setq unmark (prefix-numeric-value unmark))) (let ((count @@ -10916,7 +10961,7 @@ If optional argument UNMARK is negative, mark articles as unread instead." If N is negative, mark backward instead. If UNMARK is non-nil, remove the process mark instead. The difference between N and the actual number of articles marked is returned." - (interactive "P") + (interactive "P" gnus-summary-mode) (if (and (null n) (and transient-mark-mode mark-active)) (gnus-uu-mark-region (region-beginning) (region-end) unmark) (setq n (prefix-numeric-value n)) @@ -10924,10 +10969,14 @@ number of articles marked is returned." (n (abs n))) (while (and (> n 0) - (if unmark - (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) + (let ((article (gnus-summary-article-number))) + (if unmark + (gnus-summary-remove-process-mark article) + (if gnus-process-mark-toggle + (if (memq article gnus-newsgroup-processable) + (gnus-summary-remove-process-mark article) + (gnus-summary-set-process-mark article)) + (gnus-summary-set-process-mark article)))) (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) (setq n (1- n))) (when (/= 0 n) @@ -10940,12 +10989,12 @@ number of articles marked is returned." "Remove the process mark from the next N articles. If N is negative, unmark backward instead. The difference between N and the actual number of articles unmarked is returned." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mark-as-processable n t)) (defun gnus-summary-unmark-all-processable () "Remove the process mark from all articles." - (interactive) + (interactive nil gnus-summary-mode) (save-excursion (while gnus-newsgroup-processable (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) @@ -10969,20 +11018,21 @@ the actual number of articles unmarked is returned." "Mark N articles forward as expirable. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-expirable-mark)) (defun gnus-summary-mark-as-spam (n) "Mark N articles forward as spam. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-spam-mark)) (defun gnus-summary-mark-article-as-replied (article) "Mark ARTICLE as replied to and update the summary line. ARTICLE can also be a list of articles." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) + gnus-summary-mode) (let ((articles (if (listp article) article (list article)))) (dolist (article articles) (unless (numberp article) @@ -11004,7 +11054,8 @@ ARTICLE can also be a list of articles." (defun gnus-summary-set-bookmark (article) "Set a bookmark in current article." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) + gnus-summary-mode) (when (or (not (get-buffer gnus-article-buffer)) (not gnus-current-article) (not gnus-article-current) @@ -11028,7 +11079,8 @@ ARTICLE can also be a list of articles." (defun gnus-summary-remove-bookmark (article) "Remove the bookmark from the current article." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) + gnus-summary-mode) ;; Remove old bookmark, if one exists. (if (not (assq article gnus-newsgroup-bookmarks)) (gnus-message 6 "No bookmark in current article.") @@ -11040,7 +11092,7 @@ ARTICLE can also be a list of articles." "Mark N articles forward as dormant. If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-dormant-mark)) (defun gnus-summary-set-process-mark (article) @@ -11075,7 +11127,7 @@ If N is negative, mark backwards instead. Mark with MARK, ?r by default. The difference between N and the actual number of articles marked is returned. If NO-EXPIRE, auto-expiry will be inhibited." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-show-thread) (let ((backward (< n 0)) (gnus-summary-goto-unread @@ -11339,20 +11391,20 @@ If NO-EXPIRE, auto-expiry will be inhibited." "Tick N articles forwards. If N is negative, tick backwards instead. The difference between N and the number of articles ticked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-ticked-mark)) (defun gnus-summary-tick-article-backward (n) "Tick N articles backwards. The difference between N and the number of articles ticked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward (- n) gnus-ticked-mark)) (defun gnus-summary-tick-article (&optional article clear-mark) "Mark current article as unread. Optional 1st argument ARTICLE specifies article number to be marked as unread. Optional 2nd argument CLEAR-MARK remove any kinds of mark." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-mark-article article (if clear-mark gnus-unread-mark gnus-ticked-mark))) @@ -11361,14 +11413,14 @@ Optional 2nd argument CLEAR-MARK remove any kinds of mark." If N is negative, mark backwards instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire)) (defun gnus-summary-mark-as-read-backward (n) "Mark the N articles as read backwards. The difference between N and the actual number of articles marked is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward (- n) gnus-del-mark gnus-inhibit-user-auto-expire)) @@ -11382,13 +11434,13 @@ MARK specifies a string to be inserted at the beginning of the line." "Clear marks from N articles forward. If N is negative, clear backward instead. The difference between N and the number of marks cleared is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward n gnus-unread-mark)) (defun gnus-summary-clear-mark-backward (n) "Clear marks from N articles backward. The difference between N and the number of marks cleared is returned." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-mark-forward (- n) gnus-unread-mark)) (defun gnus-summary-mark-unread-as-read () @@ -11421,7 +11473,7 @@ The difference between N and the number of marks cleared is returned." "Mark all unread articles between point and mark as read. If given a prefix, mark all articles between point and mark as read, even ticked and dormant ones." - (interactive "r\nP") + (interactive "r\nP" gnus-summary-mode) (save-excursion (let (article) (goto-char point) @@ -11438,7 +11490,7 @@ even ticked and dormant ones." (defun gnus-summary-mark-below (score mark) "Mark articles with score less than SCORE with MARK." - (interactive "P\ncMark: ") + (interactive "P\ncMark: " gnus-summary-mode) (setq score (if score (prefix-numeric-value score) (or gnus-summary-default-score 0))) @@ -11452,22 +11504,22 @@ even ticked and dormant ones." (defun gnus-summary-kill-below (&optional score) "Mark articles with score below SCORE as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mark-below score gnus-killed-mark)) (defun gnus-summary-clear-above (&optional score) "Clear all marks from articles with score above SCORE." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mark-above score gnus-unread-mark)) (defun gnus-summary-tick-above (&optional score) "Tick all articles with score above SCORE." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-mark-above score gnus-ticked-mark)) (defun gnus-summary-mark-above (score mark) "Mark articles with score over SCORE with MARK." - (interactive "P\ncMark: ") + (interactive "P\ncMark: " gnus-summary-mode) (setq score (if score (prefix-numeric-value score) (or gnus-summary-default-score 0))) @@ -11483,7 +11535,7 @@ even ticked and dormant ones." (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) (defun gnus-summary-limit-include-expunged (&optional no-error) "Display all the hidden articles that were expunged for low scores." - (interactive) + (interactive nil gnus-summary-mode) (let ((inhibit-read-only t)) (let ((scored gnus-newsgroup-scored) headers h) @@ -11520,7 +11572,7 @@ Note that this function will only catch up the unread article in the current summary buffer limitation. The number of articles marked as read is returned." - (interactive "P") + (interactive "P" gnus-summary-mode) (prog1 (save-excursion (when (or quietly @@ -11569,7 +11621,7 @@ The number of articles marked as read is returned." (defun gnus-summary-catchup-to-here (&optional all) "Mark all unticked articles before the current one as read. If ALL is non-nil, also mark ticked and dormant articles as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (gnus-save-hidden-threads (let ((beg (point))) @@ -11581,7 +11633,7 @@ If ALL is non-nil, also mark ticked and dormant articles as read." (defun gnus-summary-catchup-from-here (&optional all) "Mark all unticked articles after (and including) the current one as read. If ALL is non-nil, also mark ticked and dormant articles as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (gnus-save-hidden-threads (let ((beg (point))) @@ -11594,14 +11646,14 @@ If ALL is non-nil, also mark ticked and dormant articles as read." "Mark all articles in this newsgroup as read. This command is dangerous. Normally, you want \\[gnus-summary-catchup] instead, which marks only unread articles as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-catchup t quietly)) (defun gnus-summary-catchup-and-exit (&optional all quietly) "Mark all unread articles in this group as read, then exit. If prefix argument ALL is non-nil, all articles are marked as read. If QUIETLY is non-nil, no questions will be asked." - (interactive "P") + (interactive "P" gnus-summary-mode) (when (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. (if (and (not (gnus-group-quit-config gnus-newsgroup-name)) @@ -11613,14 +11665,14 @@ If QUIETLY is non-nil, no questions will be asked." "Mark all articles in this newsgroup as read, and then exit. This command is dangerous. Normally, you want \\[gnus-summary-catchup-and-exit] instead, which marks only unread articles as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-catchup-and-exit t quietly)) (defun gnus-summary-catchup-and-goto-next-group (&optional all) "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (gnus-summary-catchup all)) (gnus-summary-next-group)) @@ -11629,7 +11681,7 @@ read." "Mark all articles in this group as read and select the previous group. If given a prefix, mark all articles, unread as well as ticked, as read." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-excursion (gnus-summary-catchup all)) (gnus-summary-next-group nil nil t)) @@ -11705,7 +11757,7 @@ with that article." (defun gnus-summary-rethread-current () "Rethread the thread the current article is part of." - (interactive) + (interactive nil gnus-summary-mode) (let* ((gnus-show-threads t) (article (gnus-summary-article-number)) (id (mail-header-id (gnus-summary-article-header))) @@ -11720,7 +11772,7 @@ with that article." Note that the re-threading will only work if `gnus-thread-ignore-subject' is non-nil or the Subject: of both articles are the same." - (interactive) + (interactive nil gnus-summary-mode) (unless (not (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing")) (unless (<= (length gnus-newsgroup-processable) 1) @@ -11739,9 +11791,10 @@ is non-nil or the Subject: of both articles are the same." "Make PARENT the parent of CHILDREN. When called interactively, PARENT is the current article and CHILDREN are the process-marked articles." - (interactive - (list (gnus-summary-article-number) - (gnus-summary-work-articles nil))) + (interactive (list + (gnus-summary-article-number) + (gnus-summary-work-articles nil)) + gnus-summary-mode) (dolist (child children) (save-window-excursion (let ((gnus-article-buffer " *reparent*")) @@ -11774,7 +11827,7 @@ are the process-marked articles." (defun gnus-summary-toggle-threads (&optional arg) "Toggle showing conversation threads. If ARG is positive number, turn showing conversation threads on." - (interactive "P") + (interactive "P" gnus-summary-mode) (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) (setq gnus-show-threads (if (null arg) (not gnus-show-threads) @@ -11786,7 +11839,7 @@ If ARG is positive number, turn showing conversation threads on." (defun gnus-summary-show-all-threads () "Show all threads." - (interactive) + (interactive nil gnus-summary-mode) (remove-overlays (point-min) (point-max) 'invisible 'gnus-sum) (gnus-summary-position-point)) @@ -11796,7 +11849,7 @@ If ARG is positive number, turn showing conversation threads on." (defun gnus-summary-show-thread () "Show thread subtrees. Returns nil if no thread was there to be shown." - (interactive) + (interactive nil gnus-summary-mode) (let* ((orig (point)) (end (point-at-eol)) (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end)))) @@ -11837,7 +11890,7 @@ Returns nil if no thread was there to be shown." "Hide all thread subtrees. If PREDICATE is supplied, threads that satisfy this predicate will not be hidden." - (interactive) + (interactive nil gnus-summary-mode) (save-excursion (goto-char (point-min)) (let ((end nil) @@ -11856,7 +11909,7 @@ will not be hidden." (defun gnus-summary-hide-thread () "Hide thread subtrees. Returns nil if no threads were there to be hidden." - (interactive) + (interactive nil gnus-summary-mode) (beginning-of-line) (let ((start (point)) (starteol (line-end-position)) @@ -11908,7 +11961,7 @@ Returns the difference between N and the number of skips actually done. If SILENT, don't output messages." - (interactive "p") + (interactive "p" gnus-summary-mode) (let ((backward (< n 0)) (n (abs n))) (while (and (> n 0) @@ -11924,7 +11977,7 @@ If SILENT, don't output messages." "Go to the same level previous N'th thread. Returns the difference between N and the number of skips actually done." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-next-thread (- n))) (defun gnus-summary-go-down-thread () @@ -11944,7 +11997,7 @@ done." If N is negative, go up instead. Returns the difference between N and how many steps down that were taken." - (interactive "p") + (interactive "p" gnus-summary-mode) (let ((up (< n 0)) (n (abs n))) (while (and (> n 0) @@ -11961,18 +12014,18 @@ taken." If N is negative, go down instead. Returns the difference between N and how many steps down that were taken." - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-down-thread (- n))) (defun gnus-summary-top-thread () "Go to the top of the thread." - (interactive) + (interactive nil gnus-summary-mode) (while (gnus-summary-go-up-thread)) (gnus-summary-article-number)) (defun gnus-summary-expire-thread () "Mark articles under current thread as expired." - (interactive) + (interactive nil gnus-summary-mode) (gnus-summary-kill-thread 0)) (defun gnus-summary-kill-thread (&optional unmark) @@ -11980,7 +12033,7 @@ taken." If the prefix argument is positive, remove any kinds of marks. If the prefix argument is zero, mark thread as expired. If the prefix argument is negative, tick articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (when unmark (setq unmark (prefix-numeric-value unmark))) (let ((articles (gnus-summary-articles-in-thread)) @@ -12015,82 +12068,88 @@ If the prefix argument is negative, tick articles instead." (defun gnus-summary-sort-by-number (&optional reverse) "Sort the summary buffer by article number. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'number reverse)) (defun gnus-summary-sort-by-most-recent-number (&optional reverse) "Sort the summary buffer by most recent article number. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'most-recent-number reverse)) (defun gnus-summary-sort-by-random (&optional reverse) "Randomize the order in the summary buffer. Argument REVERSE means to randomize in reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'random reverse)) (defun gnus-summary-sort-by-author (&optional reverse) "Sort the summary buffer by author name alphabetically. If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'author reverse)) (defun gnus-summary-sort-by-recipient (&optional reverse) "Sort the summary buffer by recipient name alphabetically. If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'recipient reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'subject reverse)) (defun gnus-summary-sort-by-date (&optional reverse) "Sort the summary buffer by date. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'date reverse)) (defun gnus-summary-sort-by-most-recent-date (&optional reverse) "Sort the summary buffer by most recent date. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'most-recent-date reverse)) (defun gnus-summary-sort-by-score (&optional reverse) "Sort the summary buffer by score. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'score reverse)) (defun gnus-summary-sort-by-lines (&optional reverse) "Sort the summary buffer by the number of lines. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'lines reverse)) (defun gnus-summary-sort-by-chars (&optional reverse) "Sort the summary buffer by article length. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'chars reverse)) (defun gnus-summary-sort-by-marks (&optional reverse) "Sort the summary buffer by article marks. Argument REVERSE means reverse order." - (interactive "P") + (interactive "P" gnus-summary-mode) (gnus-summary-sort 'marks reverse)) +(defun gnus-summary-sort-by-newsgroups (&optional reverse) + "Sort the summary buffer by newsgroups alphabetically. +Argument REVERSE means reverse order." + (interactive "P" gnus-summary-mode) + (gnus-summary-sort 'newsgroups reverse)) + (defun gnus-summary-sort-by-original (&optional _reverse) "Sort the summary buffer using the default sorting method. Argument REVERSE means reverse order." - (interactive) + (interactive nil gnus-summary-mode) (let* ((inhibit-read-only t) (gnus-summary-prepare-hook nil)) ;; We do the sorting by regenerating the threads. @@ -12098,6 +12157,24 @@ Argument REVERSE means reverse order." ;; Hide subthreads if needed. (gnus-summary-maybe-hide-threads))) +(defun gnus-summary-sort-by-extra (&optional reverse) + "Sort the summary buffer using an extra header. +Argument REVERSE means reverse order." + (interactive "P" gnus-summary-mode) + (let* ((extra-header + (gnus-completing-read "Sort by extra header" + (mapcar #'symbol-name gnus-extra-headers) + t nil nil + (symbol-name + (car gnus-extra-headers)))) + (header (downcase extra-header))) + (if (and (fboundp (intern + (format "gnus-thread-sort-by-%s" header))) + (fboundp + (intern (format "gnus-article-sort-by-%s" header)))) + (gnus-summary-sort header reverse) + (error "No sort function defined for header: %s" extra-header)))) + (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." (let* ((current (gnus-summary-article-number)) @@ -12139,7 +12216,7 @@ will not be marked as saved. The `gnus-prompt-before-saving' variable says how prompting is performed." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let* ((articles (gnus-summary-work-articles n)) (save-buffer (save-excursion @@ -12208,7 +12285,7 @@ is neither omitted nor the symbol `r', force including all headers regardless of the `:headers' property. If it is the symbol `r', articles that are not decoded and include all headers will be piped no matter what the properties `:decode' and `:headers' are." - (interactive (gnus-interactive "P\ny")) + (interactive (gnus-interactive "P\ny") gnus-summary-mode) (require 'gnus-art) (let* ((articles (gnus-summary-work-articles n)) (result-buffer shell-command-buffer-name) @@ -12260,7 +12337,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) (gnus-summary-save-article arg))) @@ -12271,7 +12348,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) (gnus-summary-save-article arg))) @@ -12282,7 +12359,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) (gnus-summary-save-article arg))) @@ -12293,7 +12370,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-write-to-file)) (gnus-summary-save-article arg))) @@ -12304,7 +12381,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) (gnus-summary-save-article arg))) @@ -12315,7 +12392,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-write-body-to-file)) (gnus-summary-save-article arg))) @@ -12326,14 +12403,14 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint)) (gnus-summary-save-article arg t))) (defun gnus-summary-pipe-message (program) "Pipe the current article through PROGRAM." - (interactive "sProgram: ") + (interactive "sProgram: " gnus-summary-mode) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -12451,7 +12528,8 @@ If REVERSE, save parts that do not match TYPE." (read-directory-name "Save to directory: " gnus-summary-save-parts-last-directory nil t)) - current-prefix-arg)) + current-prefix-arg) + gnus-summary-mode) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) gnus-article-prepare-hook @@ -12590,12 +12668,12 @@ If REVERSE, save parts that do not match TYPE." (defun gnus-summary-edit-global-kill (article) "Edit the \"global\" kill file." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) gnus-summary-mode) (gnus-group-edit-global-kill article)) (defun gnus-summary-edit-local-kill () "Edit a local kill file applied to the current newsgroup." - (interactive) + (interactive nil gnus-summary-mode) (setq gnus-current-headers (gnus-summary-article-header)) (gnus-group-edit-local-kill (gnus-summary-article-number) gnus-newsgroup-name)) @@ -12707,7 +12785,7 @@ If REVERSE, save parts that do not match TYPE." ;; so we highlight the entire line instead. (when (= (+ to 2) from) (setq from beg) - (setq to end)) + (setq to (1+ end))) (if gnus-newsgroup-selected-overlay ;; Move old overlay. (move-overlay @@ -12762,7 +12840,7 @@ If REVERSE, save parts that do not match TYPE." (let ((face (funcall (gnus-summary-highlight-line-0)))) (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (gnus-put-text-property-excluding-characters-with-faces - beg (point-at-eol) 'face + beg (1+ (point-at-eol)) 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function (funcall gnus-summary-highlight-line-function article face)))))) @@ -12893,7 +12971,7 @@ UNREAD is a sorted list." "Display the current article buffer fully MIME-buttonized. If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are treated as multipart/mixed." - (interactive "P") + (interactive "P" gnus-summary-mode) (require 'gnus-art) (let ((gnus-unbuttonized-mime-types nil) (gnus-mime-display-multipart-as-mixed show-all-parts)) @@ -12901,7 +12979,7 @@ treated as multipart/mixed." (defun gnus-summary-repair-multipart (article) "Add a Content-Type header to a multipart article without one." - (interactive (list (gnus-summary-article-number))) + (interactive (list (gnus-summary-article-number)) gnus-summary-mode) (gnus-with-article article (message-narrow-to-head) (message-remove-header "Mime-Version") @@ -12921,7 +12999,7 @@ treated as multipart/mixed." (defun gnus-summary-toggle-display-buttonized () "Toggle the buttonizing of the article buffer." - (interactive) + (interactive nil gnus-summary-mode) (require 'gnus-art) (if (setq gnus-inhibit-mime-unbuttonizing (not gnus-inhibit-mime-unbuttonizing)) @@ -12976,7 +13054,7 @@ If N is negative, move in reverse order. The difference between N and the actual number of articles marked is returned." name (cadr lway)) - (interactive "p") + (interactive "p" gnus-summary-mode) (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway)))) (defun gnus-summary-generic-mark (n mark move unread) @@ -13059,7 +13137,7 @@ returned." "Insert all old articles in this group. If ALL is non-nil, already read articles become readable. If ALL is a number, fetch this number of articles." - (interactive "P") + (interactive "P" gnus-summary-mode) (prog1 (let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<)) older len) @@ -13133,7 +13211,7 @@ If ALL is a number, fetch this number of articles." (defun gnus-summary-insert-new-articles () "Insert all new articles in this group." - (interactive) + (interactive nil gnus-summary-mode) (let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<)) (old-high gnus-newsgroup-highest) (nnmail-fetched-sources (list t)) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index e7d1cf86161..c8bcccdfdde 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -54,6 +54,7 @@ with some simple extensions. %n Topic name. %v Nothing if the topic is visible, \"...\" otherwise. %g Number of groups in the topic. +%G Number of groups in the topic and its subtopics. %a Number of unread articles in the groups in the topic. %A Number of unread articles in the groups in the topic and its subtopics. @@ -70,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) @@ -87,6 +96,7 @@ See Info node `(gnus)Formatting Variables'." (?v visible ?s) (?i indentation ?s) (?g number-of-groups ?d) + (?G total-number-of-groups ?d) (?a (gnus-topic-articles-in-topic entries) ?d) (?A total-number-of-articles ?d) (?l level ?d))) @@ -146,7 +156,8 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-topic-jump-to-topic (topic) "Go to TOPIC." (interactive - (list (gnus-completing-read "Go to topic" (gnus-topic-list) t))) + (list (gnus-completing-read "Go to topic" (gnus-topic-list) t)) + gnus-topic-mode) (let ((inhibit-read-only t)) (dolist (topic (gnus-current-topics topic)) (unless (gnus-topic-goto-topic topic) @@ -235,12 +246,12 @@ If RECURSIVE is t, return groups in its subtopics too." (defun gnus-topic-goto-previous-topic (n) "Go to the N'th previous topic." - (interactive "p") + (interactive "p" gnus-topic-mode) (gnus-topic-goto-next-topic (- n))) (defun gnus-topic-goto-next-topic (n) "Go to the N'th next topic." - (interactive "p") + (interactive "p" gnus-topic-mode) (let ((backward (< n 0)) (n (abs n)) (topic (gnus-current-topic))) @@ -484,16 +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)) - (entries (gnus-topic-find-groups - (car type) - (if gnus-group-listed-groups - gnus-level-killed - list-level) - (or predicate gnus-group-listed-groups - (cdr (assq 'visible - (gnus-topic-hierarchical-parameters - (car type))))) - (if gnus-group-listed-groups 0 lowest))) + (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 name))))) + (lowest (if gnus-group-listed-groups 0 lowest)) + (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) ? )) @@ -503,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)) - (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." @@ -626,11 +641,19 @@ articles in the topic and its subtopics." (defvar gnus-tmp-header) (defun gnus-topic-insert-topic-line (name visiblep shownp level entries - &optional unread) + &optional unread all-groups) + (gnus--\,@ + (let ((vars '(indentation visible name level number-of-groups + total-number-of-groups total-number-of-articles entries))) + `((with-suppressed-warnings ((lexical ,@vars)) + ,@(mapcar (lambda (s) `(defvar ,s)) vars))))) (let* ((visible (if visiblep "" "...")) + (level level) + (name name) (indentation (make-string (* gnus-topic-indent-level level) ? )) (total-number-of-articles unread) (number-of-groups (length entries)) + (total-number-of-groups (length all-groups)) (active-topic (eq gnus-topic-alist gnus-topic-active-alist)) gnus-tmp-header) (gnus-topic-update-unreads name unread) @@ -640,14 +663,7 @@ articles in the topic and its subtopics." (add-text-properties (point) (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec - `((indentation . ,indentation) - (visible . ,visible) - (name . ,name) - (level . ,level) - (number-of-groups . ,number-of-groups) - (total-number-of-articles . ,total-number-of-articles) - (entries . ,entries)))) + (eval gnus-topic-line-format-spec t)) (list 'gnus-topic name 'gnus-topic-level level 'gnus-topic-unread unread @@ -661,7 +677,7 @@ articles in the topic and its subtopics." (defun gnus-topic-update-topics-containing-group (group) "Update all topics that have GROUP as a member." - (when (and (eq major-mode 'gnus-group-mode) + (when (and (eq major-mode 'gnus-topic-mode) gnus-topic-mode) (save-excursion (let ((alist gnus-topic-alist)) @@ -677,7 +693,7 @@ articles in the topic and its subtopics." (defun gnus-topic-update-topic () "Update all parent topics to the current group." - (when (and (eq major-mode 'gnus-group-mode) + (when (and (eq major-mode 'gnus-topic-mode) gnus-topic-mode) (let ((group (gnus-group-group-name)) (m (point-marker)) @@ -730,6 +746,9 @@ articles in the topic and its subtopics." (entries (gnus-topic-find-groups (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) + (all-groups (gnus-topic-find-groups + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode) nil t)) entry) (while children (cl-incf unread (gnus-topic-unread (caar (pop children))))) @@ -737,7 +756,7 @@ articles in the topic and its subtopics." (when (numberp (car entry)) (cl-incf unread (car entry)))) (gnus-topic-insert-topic-line - topic t t (car (gnus-topic-find-topology topic)) nil unread))) + topic t t (car (gnus-topic-find-topology topic)) nil unread all-groups))) (defun gnus-topic-goto-missing-topic (topic) (if (gnus-topic-goto-topic topic) @@ -767,6 +786,9 @@ articles in the topic and its subtopics." (entries (gnus-topic-find-groups (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) + (all-groups (gnus-topic-find-groups + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode) t)) (parent (gnus-topic-parent-topic topic-name)) (all-entries entries) (unread 0) @@ -785,7 +807,7 @@ articles in the topic and its subtopics." (gnus-topic-insert-topic-line (car type) (gnus-topic-visible-p) (not (eq (nth 2 type) 'hidden)) - (gnus-group-topic-level) all-entries unread) + (gnus-group-topic-level) all-entries unread all-groups) (gnus-delete-line) (forward-line -1) (setq new-unread (gnus-group-topic-unread))) @@ -1111,7 +1133,7 @@ articles in the topic and its subtopics." ["Delete" gnus-topic-delete t] ["Rename..." gnus-topic-rename t] ["Create..." gnus-topic-create-topic t] - ["Mark" gnus-topic-mark-topic t] + ["Toggle/Set mark" gnus-topic-mark-topic t] ["Indent" gnus-topic-indent t] ["Sort" gnus-topic-sort-topics t] ["Previous topic" gnus-topic-goto-previous-topic t] @@ -1122,7 +1144,9 @@ articles in the topic and its subtopics." (define-minor-mode gnus-topic-mode "Minor mode for topicsifying Gnus group buffers." - :lighter " Topic" :keymap gnus-topic-mode-map + :lighter " Topic" + :keymap gnus-topic-mode-map + :interactive (gnus-group-mode) (if (not (derived-mode-p 'gnus-group-mode)) (setq gnus-topic-mode nil) ;; Infest Gnus with topics. @@ -1172,7 +1196,7 @@ articles in the group. If ALL is a negative number, fetch this number of the earliest articles in the group. If performed over a topic line, toggle folding the topic." - (interactive "P") + (interactive "P" gnus-topic-mode) (when (and (eobp) (not (gnus-group-group-name))) (forward-line -1)) (if (gnus-group-topic-p) @@ -1184,13 +1208,13 @@ If performed over a topic line, toggle folding the topic." (defun gnus-mouse-pick-topic (e) "Select the group or topic under the mouse pointer." - (interactive "e") + (interactive "e" gnus-topic-mode) (mouse-set-point e) (gnus-topic-read-group nil)) (defun gnus-topic-expire-articles (topic) "Expire articles in this topic or group." - (interactive (list (gnus-group-topic-name))) + (interactive (list (gnus-group-topic-name)) gnus-topic-mode) (if (not topic) (call-interactively 'gnus-group-expire-articles) (save-excursion @@ -1205,7 +1229,7 @@ If performed over a topic line, toggle folding the topic." (defun gnus-topic-catchup-articles (topic) "Catchup this topic or group. Also see `gnus-group-catchup'." - (interactive (list (gnus-group-topic-name))) + (interactive (list (gnus-group-topic-name)) gnus-topic-mode) (if (not topic) (call-interactively 'gnus-group-catchup-current) (save-excursion @@ -1232,7 +1256,7 @@ be auto-selected upon group entry. If GROUP is non-nil, fetch that group. If performed over a topic line, toggle folding the topic." - (interactive "P") + (interactive "P" gnus-topic-mode) (when (and (eobp) (not (gnus-group-group-name))) (forward-line -1)) (if (gnus-group-topic-p) @@ -1247,7 +1271,8 @@ When used interactively, PARENT will be the topic under point." (interactive (list (read-string "New topic: ") - (gnus-current-topic))) + (gnus-current-topic)) + gnus-topic-mode) ;; Check whether this topic already exists. (when (gnus-topic-find-topology topic) (error "Topic already exists")) @@ -1284,7 +1309,8 @@ If COPYP, copy the groups instead." (interactive (list current-prefix-arg (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t - nil 'gnus-topic-history))) + nil 'gnus-topic-history)) + gnus-topic-mode) (let ((use-marked (and (not n) (not (and transient-mark-mode mark-active)) gnus-group-marked t)) (groups (gnus-group-process-prefix n)) @@ -1309,7 +1335,7 @@ If COPYP, copy the groups instead." (defun gnus-topic-remove-group (&optional n) "Remove the current group from the topic." - (interactive "P") + (interactive "P" gnus-topic-mode) (let ((use-marked (and (not n) (not (and transient-mark-mode mark-active)) gnus-group-marked t)) (groups (gnus-group-process-prefix n))) @@ -1331,12 +1357,13 @@ If COPYP, copy the groups instead." (interactive (list current-prefix-arg (gnus-completing-read - "Copy to topic" (mapcar #'car gnus-topic-alist) t))) + "Copy to topic" (mapcar #'car gnus-topic-alist) t)) + gnus-topic-mode) (gnus-topic-move-group n topic t)) (defun gnus-topic-kill-group (&optional n discard) "Kill the next N groups." - (interactive "P") + (interactive "P" gnus-topic-mode) (if (gnus-group-topic-p) (let ((topic (gnus-group-topic-name))) (push (cons @@ -1356,7 +1383,7 @@ If COPYP, copy the groups instead." (defun gnus-topic-yank-group (&optional arg) "Yank the last topic." - (interactive "p") + (interactive "p" gnus-topic-mode) (if gnus-topic-killed-topics (let* ((previous (or (gnus-group-topic-name) @@ -1405,7 +1432,7 @@ If COPYP, copy the groups instead." (defun gnus-topic-hide-topic (&optional permanent) "Hide the current topic. If PERMANENT, make it stay hidden in subsequent sessions as well." - (interactive "P") + (interactive "P" gnus-topic-mode) (when (gnus-current-topic) (gnus-topic-goto-topic (gnus-current-topic)) (if permanent @@ -1418,7 +1445,7 @@ If PERMANENT, make it stay hidden in subsequent sessions as well." (defun gnus-topic-show-topic (&optional permanent) "Show the hidden topic. If PERMANENT, make it stay shown in subsequent sessions as well." - (interactive "P") + (interactive "P" gnus-topic-mode) (when (gnus-group-topic-p) (if (not permanent) (gnus-topic-remove-topic t nil) @@ -1430,34 +1457,42 @@ If PERMANENT, make it stay shown in subsequent sessions as well." (setcar (cdr (cadr topic)) 'visible) (gnus-group-list-groups))))) -(defun gnus-topic-mark-topic (topic &optional unmark non-recursive) +(defun gnus-topic-mark-topic (topic &optional unmark non-recursive no-toggle) "Mark all groups in the TOPIC with the process mark. If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." - (interactive (list (gnus-group-topic-name) - nil - (and current-prefix-arg t))) + (interactive + (list (gnus-group-topic-name) + nil + (and current-prefix-arg t)) + gnus-topic-mode) (if (not topic) (call-interactively 'gnus-group-mark-group) (save-excursion (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil (not non-recursive)))) (while groups - (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) - (gnus-info-group (nth 1 (pop groups))))))))) + (let ((group (gnus-info-group (nth 1 (pop groups))))) + (if (and gnus-process-mark-toggle (not no-toggle)) + (if (memq group gnus-group-marked) + (gnus-group-remove-mark group ) + (gnus-group-set-mark group)) + (if unmark (gnus-group-remove-mark group) + (gnus-group-set-mark group))))))))) (defun gnus-topic-unmark-topic (topic &optional _dummy non-recursive) "Remove the process mark from all groups in the TOPIC. If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (interactive (list (gnus-group-topic-name) nil - (and current-prefix-arg t))) + (and current-prefix-arg t)) + gnus-topic-mode) (if (not topic) (call-interactively 'gnus-group-unmark-group) - (gnus-topic-mark-topic topic t non-recursive))) + (gnus-topic-mark-topic topic t non-recursive t))) (defun gnus-topic-get-new-news-this-topic (&optional n) "Check for new news in the current topic." - (interactive "P") + (interactive "P" gnus-topic-mode) (if (not (gnus-group-topic-p)) (gnus-group-get-new-news-this-group n) (let* ((topic (gnus-group-topic-name)) @@ -1475,7 +1510,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (list (setq topic (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t)) - (read-string (format "Move to %s (regexp): " topic)))))) + (read-string (format "Move to %s (regexp): " topic))))) + gnus-topic-mode) (gnus-group-mark-regexp regexp) (gnus-topic-move-group nil topic copyp)) @@ -1486,12 +1522,13 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (mapcar #'car gnus-topic-alist) t))) (nreverse (list topic - (read-string (format "Copy to %s (regexp): " topic)))))) + (read-string (format "Copy to %s (regexp): " topic))))) + gnus-topic-mode) (gnus-topic-move-matching regexp topic t)) (defun gnus-topic-delete (topic) "Delete a topic." - (interactive (list (gnus-group-topic-name))) + (interactive (list (gnus-group-topic-name)) gnus-topic-mode) (unless topic (error "No topic to be deleted")) (let ((entry (assoc topic gnus-topic-alist)) @@ -1512,7 +1549,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (interactive (let ((topic (gnus-current-topic))) (list topic - (read-string (format "Rename %s to: " topic) topic)))) + (read-string (format "Rename %s to: " topic) topic))) + gnus-topic-mode) ;; Check whether the new name exists. (when (gnus-topic-find-topology new-name) (error "Topic `%s' already exists" new-name)) @@ -1535,7 +1573,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (defun gnus-topic-indent (&optional unindent) "Indent a topic -- make it a sub-topic of the previous topic. If UNINDENT, remove an indentation." - (interactive "P") + (interactive "P" gnus-topic-mode) (if unindent (gnus-topic-unindent) (let* ((topic (gnus-current-topic)) @@ -1555,7 +1593,7 @@ If UNINDENT, remove an indentation." (defun gnus-topic-unindent () "Unindent a topic." - (interactive) + (interactive nil gnus-topic-mode) (let* ((topic (gnus-current-topic)) (parent (gnus-topic-parent-topic topic)) (grandparent (gnus-topic-parent-topic parent))) @@ -1574,7 +1612,7 @@ If UNINDENT, remove an indentation." (defun gnus-topic-list-active (&optional force) "List all groups that Gnus knows about in a topicsified fashion. If FORCE, always re-read the active file." - (interactive "P") + (interactive "P" gnus-topic-mode) (when force (gnus-get-killed-groups)) (gnus-topic-grok-active force) @@ -1585,7 +1623,7 @@ If FORCE, always re-read the active file." (defun gnus-topic-toggle-display-empty-topics () "Show/hide topics that have no unread articles." - (interactive) + (interactive nil gnus-topic-mode) (setq gnus-topic-display-empty-topics (not gnus-topic-display-empty-topics)) (gnus-group-list-groups) @@ -1598,7 +1636,7 @@ If FORCE, always re-read the active file." (defun gnus-topic-edit-parameters (group) "Edit the group parameters of GROUP. If performed on a topic, edit the topic parameters instead." - (interactive (list (gnus-group-group-name))) + (interactive (list (gnus-group-group-name)) gnus-topic-mode) (if group (gnus-group-edit-group-parameters group) (if (not (gnus-group-topic-p)) @@ -1642,7 +1680,8 @@ If performed on a topic, edit the topic parameters instead." (defun gnus-topic-sort-groups (func &optional reverse) "Sort the current topic according to FUNC. If REVERSE, reverse the sorting order." - (interactive (list gnus-group-sort-function current-prefix-arg)) + (interactive (list gnus-group-sort-function current-prefix-arg) + gnus-topic-mode) (let ((topic (assoc (gnus-current-topic) gnus-topic-alist))) (gnus-topic-sort-topic topic (gnus-make-sort-function func) reverse) @@ -1651,43 +1690,43 @@ If REVERSE, reverse the sorting order." (defun gnus-topic-sort-groups-by-alphabet (&optional reverse) "Sort the current topic alphabetically by group name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse)) (defun gnus-topic-sort-groups-by-unread (&optional reverse) "Sort the current topic by number of unread articles. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse)) (defun gnus-topic-sort-groups-by-level (&optional reverse) "Sort the current topic by group level. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-level reverse)) (defun gnus-topic-sort-groups-by-score (&optional reverse) "Sort the current topic by group score. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-score reverse)) (defun gnus-topic-sort-groups-by-rank (&optional reverse) "Sort the current topic by group rank. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse)) (defun gnus-topic-sort-groups-by-method (&optional reverse) "Sort the current topic alphabetically by backend name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse)) (defun gnus-topic-sort-groups-by-server (&optional reverse) "Sort the current topic alphabetically by server name. If REVERSE, sort in reverse order." - (interactive "P") + (interactive "P" gnus-topic-mode) (gnus-topic-sort-groups 'gnus-group-sort-by-server reverse)) (defun gnus-topic-sort-topics-1 (top reverse) @@ -1708,7 +1747,8 @@ If REVERSE, reverse the sorting order." (list (gnus-completing-read "Sort topics in" (mapcar #'car gnus-topic-alist) t (gnus-current-topic)) - current-prefix-arg)) + current-prefix-arg) + gnus-topic-mode) (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) gnus-topic-topology))) (gnus-topic-sort-topics-1 topic-topology reverse) @@ -1721,7 +1761,8 @@ If REVERSE, reverse the sorting order." (interactive (list (gnus-group-topic-name) - (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t))) + (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t)) + gnus-topic-mode) (unless (and current to) (error "Can't find topic")) (let ((current-top (cdr (gnus-topic-find-topology current))) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 3c7c948c2b5..70ae81d95ea 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 "/") @@ -408,7 +408,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'." @@ -1068,6 +1068,11 @@ ARG is passed to the first function." ;;; Various +(defmacro gnus--\,@ (exp) + "Splice EXP's value (a list of Lisp forms) into the code." + (declare (debug t)) + `(progn ,@(eval exp t))) + (defvar gnus-group-buffer) ; Compiler directive (defun gnus-alive-p () "Say whether Gnus is running or not." @@ -1286,61 +1291,6 @@ forbidden in URL encoding." (setq tmp (concat tmp str)) tmp)) -(defun gnus-base64-repad (str &optional reject-newlines line-length no-check) - "Take a base 64-encoded string and return it padded correctly. -Existing padding is ignored. - -If any combination of CR and LF characters are present and -REJECT-NEWLINES is nil, remove them; otherwise raise an error. -If LINE-LENGTH is set and the string (or any line in the string -if REJECT-NEWLINES is nil) is longer than that number, raise an -error. Common line length for input characters are 76 plus CRLF -\(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including -CRLF (RFC 5321 SMTP). - -If NOCHECK, don't check anything, but just repad." - ;; RFC 4648 specifies that: - ;; - three 8-bit inputs make up a 24-bit group - ;; - the 24-bit group is broken up into four 6-bit values - ;; - each 6-bit value is mapped to one character of the base 64 alphabet - ;; - if the final 24-bit quantum is filled with only 8 bits the output - ;; will be two base 64 characters followed by two "=" padding characters - ;; - if the final 24-bit quantum is filled with only 16 bits the output - ;; will be three base 64 character followed by one "=" padding character - ;; - ;; RFC 4648 section 3 considerations: - ;; - if reject-newlines is nil (default), concatenate multi-line - ;; input (3.1, 3.3) - ;; - if line-length is set, error on input exceeding the limit (3.1) - ;; - reject characters outside base encoding (3.3, also section 12) - ;; - ;; RFC 5322 section 2.2.3 consideration: - ;; Because base 64-encoded strings can appear in long header fields, remove - ;; folding whitespace while still observing the RFC 4648 decisions above. - (when no-check - (setq str (replace-regexp-in-string "[\n\r \t]+" "" str))); - (let ((splitstr (split-string str "[ \t]*[\r\n]+[ \t]?" t))) - (when (and reject-newlines (> (length splitstr) 1)) - (error "Invalid Base64 string")) - (dolist (substr splitstr) - (when (and line-length (> (length substr) line-length)) - (error "Base64 string exceeds line-length")) - (when (string-match "[^A-Za-z0-9+/=]" substr) - (error "Invalid Base64 string"))) - (let* ((str (string-join splitstr)) - (len (length str))) - (when (string-match "=" str) - (setq len (match-beginning 0))) - (concat - (substring str 0 len) - (make-string (/ - (- 24 - (pcase (mod (* len 6) 24) - (`0 24) - (n n))) - 6) - ?=))))) - (defun gnus-make-predicate (spec) "Transform SPEC into a function that can be called. SPEC is a predicate specifier that contains stuff like `or', `and', @@ -1607,8 +1557,8 @@ empty directories from OLD-PATH." "Rescale IMAGE to SIZE if possible. SIZE is in format (WIDTH . HEIGHT). Return a new image. Sizes are in pixels." - (if (not (display-graphic-p)) - image + (when (display-images-p) + (declare-function image-size "image.c" (spec &optional pixels frame)) (let ((new-width (car size)) (new-height (cdr size))) (when (> (cdr (image-size image t)) new-height) @@ -1616,8 +1566,8 @@ Sizes are in pixels." :max-height new-height))) (when (> (car (image-size image t)) new-width) (setq image (create-image (plist-get (cdr image) :data) nil t - :max-width new-width))) - image))) + :max-width new-width))))) + image) (defun gnus-recursive-directory-files (dir) "Return all regular files below DIR. diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 32a87851549..6c926384c97 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -355,7 +355,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-decode-uu (&optional n) "Uudecodes the current article." - (interactive "P") + (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) @@ -364,13 +364,14 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (file-name-as-directory (read-directory-name "Uudecode and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) + gnus-uu-default-dir + gnus-uu-default-dir t))) + gnus-article-mode gnus-summary-mode) (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." - (interactive "P") + (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) @@ -379,8 +380,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (file-name-as-directory (read-directory-name "Unshar and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) + gnus-uu-default-dir + gnus-uu-default-dir t))) + gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-unshar-article n dir nil 'scan t)) (defun gnus-uu-decode-save (n file) @@ -391,7 +393,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (read-directory-name "Save articles in dir: " gnus-uu-default-dir gnus-uu-default-dir) (read-file-name - "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir)))) + "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir))) + gnus-article-mode gnus-summary-mode) (setq gnus-uu-saved-article-name file) (gnus-uu-decode-with-method #'gnus-uu-save-article n nil t)) @@ -401,8 +404,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (file-name-as-directory (read-directory-name "Unbinhex and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir)))) + gnus-uu-default-dir + gnus-uu-default-dir))) + gnus-article-mode gnus-summary-mode) (gnus-uu-initialize) (setq gnus-uu-binhex-article-name (make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) @@ -414,14 +418,15 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (file-name-as-directory (read-directory-name "yEnc decode and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir)))) + gnus-uu-default-dir + gnus-uu-default-dir))) + gnus-article-mode gnus-summary-mode) (setq gnus-uu-yenc-article-name nil) (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." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu n))) @@ -431,13 +436,14 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (read-file-name "Uudecode, view and save in dir: " gnus-uu-default-dir - gnus-uu-default-dir t))) + gnus-uu-default-dir t)) + gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu-and-save n dir))) (defun gnus-uu-decode-unshar-view (&optional n) "Unshars and views the current article." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-unshar n))) @@ -447,7 +453,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (list current-prefix-arg (read-file-name "Unshar, view and save in dir: " gnus-uu-default-dir - gnus-uu-default-dir t))) + gnus-uu-default-dir t)) + gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-unshar-and-save n dir))) @@ -459,7 +466,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (read-directory-name "Save articles in dir: " gnus-uu-default-dir gnus-uu-default-dir) (read-file-name "Save articles in file: " - gnus-uu-default-dir gnus-uu-default-dir)))) + gnus-uu-default-dir gnus-uu-default-dir))) + gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-save n file))) @@ -468,7 +476,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive (list current-prefix-arg (read-file-name "Unbinhex, view and save in dir: " - gnus-uu-default-dir gnus-uu-default-dir))) + gnus-uu-default-dir gnus-uu-default-dir)) + gnus-article-mode gnus-summary-mode) (gnus-uu-initialize) (setq gnus-uu-binhex-article-name (make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) @@ -480,7 +489,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-digest-mail-forward (&optional n post) "Digests and forwards all articles in this series." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-initialize) (let ((gnus-uu-save-in-digest t) (file (make-temp-file (nnheader-concat gnus-uu-work-dir "forward"))) @@ -546,7 +555,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-digest-post-forward (&optional n) "Digest and forward to a newsgroup." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-digest-mail-forward n t)) ;; Process marking. @@ -569,14 +578,14 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-new-processable (unmarkp articles) (if unmarkp - (gnus-intersection gnus-newsgroup-processable articles) - (gnus-set-difference articles gnus-newsgroup-processable))) + (nreverse (seq-intersection gnus-newsgroup-processable articles #'eq)) + (seq-difference articles gnus-newsgroup-processable #'eq))) (defun gnus-uu-mark-by-regexp (regexp &optional unmark) "Set the process mark on articles whose subjects match REGEXP. When called interactively, prompt for REGEXP. Optional UNMARK non-nil means unmark instead of mark." - (interactive "sMark (regexp): \nP") + (interactive "sMark (regexp): \nP" gnus-article-mode gnus-summary-mode) (save-excursion (let* ((articles (gnus-uu-find-articles-matching regexp)) (new-marked (gnus-new-processable unmark articles))) @@ -590,12 +599,12 @@ Optional UNMARK non-nil means unmark instead of mark." (defun gnus-uu-unmark-by-regexp (regexp) "Remove the process mark from articles whose subjects match REGEXP. When called interactively, prompt for REGEXP." - (interactive "sUnmark (regexp): ") + (interactive "sUnmark (regexp): " gnus-article-mode gnus-summary-mode) (gnus-uu-mark-by-regexp regexp t)) (defun gnus-uu-mark-series (&optional silent) "Mark the current series with the process mark." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let* ((articles (gnus-uu-find-articles-matching)) (l (length articles))) (while articles @@ -608,7 +617,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-region (beg end &optional unmark) "Set the process mark on all articles between point and mark." - (interactive "r") + (interactive "r" gnus-article-mode gnus-summary-mode) (save-excursion (goto-char beg) (while (< (point) end) @@ -620,22 +629,22 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-unmark-region (beg end) "Remove the process mark from all articles between point and mark." - (interactive "r") + (interactive "r" gnus-article-mode gnus-summary-mode) (gnus-uu-mark-region beg end t)) (defun gnus-uu-mark-buffer () "Set the process mark on all articles in the buffer." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-uu-mark-region (point-min) (point-max))) (defun gnus-uu-unmark-buffer () "Remove the process mark on all articles in the buffer." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-uu-mark-region (point-min) (point-max) t)) (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (gnus-save-hidden-threads (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) @@ -646,7 +655,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-unmark-thread () "Unmarks all articles downwards in this thread." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((level (gnus-summary-thread-level))) (while (and (gnus-summary-remove-process-mark (gnus-summary-article-number)) @@ -656,7 +665,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-invert-processable () "Invert the list of process-marked articles." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((data gnus-newsgroup-data) number) (save-excursion @@ -669,7 +678,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-over (&optional score) "Mark all articles with a score over SCORE (the prefix)." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((score (or score gnus-summary-default-score 0)) (data gnus-newsgroup-data)) (save-excursion @@ -684,7 +693,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-sparse () "Mark all series that have some articles marked." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (let ((marked (nreverse gnus-newsgroup-processable)) subject articles total headers) (unless marked @@ -708,7 +717,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-all () "Mark all articles in \"series\" order." - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (setq gnus-newsgroup-processable nil) (save-excursion (let ((data gnus-newsgroup-data) @@ -728,33 +737,33 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-decode-postscript (&optional n) "Gets PostScript of the current article." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article n)) (defun gnus-uu-decode-postscript-view (&optional n) "Gets and views the current article." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-postscript n))) (defun gnus-uu-decode-postscript-and-save (n dir) "Extracts PostScript and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-directory-name "Save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) + (interactive (list current-prefix-arg + (file-name-as-directory + (read-directory-name "Save in dir: " + gnus-uu-default-dir + gnus-uu-default-dir t))) + gnus-article-mode gnus-summary-mode) (gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article n dir nil nil t)) (defun gnus-uu-decode-postscript-and-save-view (n dir) "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Where do you want to save the file(s)? " - gnus-uu-default-dir - gnus-uu-default-dir t))) + (interactive (list current-prefix-arg + (read-file-name "Where do you want to save the file(s)? " + gnus-uu-default-dir + gnus-uu-default-dir t)) + gnus-article-mode gnus-summary-mode) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-postscript-and-save n dir))) @@ -1425,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)))) diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el index b7e6b2a8890..ec3601109e9 100644 --- a/lisp/gnus/gnus-vm.el +++ b/lisp/gnus/gnus-vm.el @@ -72,7 +72,7 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-vm)) (gnus-summary-save-article arg))) @@ -80,7 +80,7 @@ save those articles instead." (declare-function vm-save-message "ext:vm-save" (folder &optional count)) (defun gnus-summary-save-in-vm (&optional folder) - (interactive) + (interactive nil gnus-article-mode gnus-summary-mode) (require 'vm) (setq folder (gnus-read-save-file-name diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 98664ac2b44..d52bd26a2cb 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) @@ -1138,7 +1139,7 @@ no need to set this variable." :group 'gnus-message :type '(choice (const :tag "default" nil) string)) -(make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1") +(make-obsolete-variable 'gnus-local-domain nil "24.1") ;; Customization variables @@ -1183,6 +1184,14 @@ newsgroups." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-process-mark-toggle t + "If nil the process mark command only sets the process mark." + :version "28.1" + :group 'gnus-summary + :group 'gnus-group-various + :group 'gnus-group-topic + :type 'boolean) + (defcustom gnus-large-newsgroup 200 "The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, @@ -2310,7 +2319,7 @@ automatically cache the article in the agent cache." ;; The carpal mode has been removed, but define the variable for ;; backwards compatibility. (defvar gnus-carpal nil) -(make-obsolete-variable 'gnus-carpal nil "Emacs 24.1") +(make-obsolete-variable 'gnus-carpal nil "24.1") (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") @@ -2513,7 +2522,7 @@ are always t.") '(("info" :interactive t Info-goto-node) ("qp" quoted-printable-decode-region quoted-printable-decode-string) ("ps-print" ps-print-preprint) - ("message" :interactive t + ("message" :interactive (message-mode) message-send-and-exit message-yank-original) ("babel" babel-as-string) ("nnmail" nnmail-split-fancy nnmail-article-group) @@ -2530,7 +2539,7 @@ are always t.") ("score-mode" :interactive t gnus-score-mode) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) - ("gnus-mh" :interactive t gnus-summary-save-in-folder) + ("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder) ("gnus-demon" gnus-demon-add-scanmail gnus-demon-add-rescan gnus-demon-add-scan-timestamps gnus-demon-add-disconnection gnus-demon-add-handler @@ -2545,7 +2554,7 @@ are always t.") ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info gnus-server-server-name) ("gnus-srvr" gnus-browse-foreign-server) - ("gnus-cite" :interactive t + ("gnus-cite" :interactive (gnus-article-mode gnus-summary-mode) gnus-article-highlight-citation gnus-article-hide-citation-maybe gnus-article-hide-citation gnus-article-fill-cited-article gnus-article-hide-citation-in-followups @@ -2561,29 +2570,34 @@ are always t.") gnus-cache-enter-remove-article gnus-cached-article-p gnus-cache-open gnus-cache-close gnus-cache-update-article gnus-cache-articles-in-group) - ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article + ("gnus-cache" :interactive (gnus-summary-mode) + gnus-summary-insert-cached-articles gnus-cache-enter-article gnus-cache-remove-article gnus-summary-insert-cached-articles) + ("gnus-cache" :interactive t gnus-jog-cache) ("gnus-score" :interactive t + gnus-score-flush-cache gnus-score-close) + ("gnus-score" :interactive (gnus-summary-mode) gnus-summary-increase-score gnus-summary-set-score gnus-summary-raise-thread gnus-summary-raise-same-subject gnus-summary-raise-score gnus-summary-raise-same-subject-and-select gnus-summary-lower-thread gnus-summary-lower-same-subject gnus-summary-lower-score gnus-summary-lower-same-subject-and-select gnus-summary-current-score gnus-score-delta-default - gnus-score-flush-cache gnus-score-close gnus-possibly-score-headers gnus-score-followup-article gnus-score-followup-thread) ("gnus-score" (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers gnus-current-score-file-nondirectory gnus-score-adaptive gnus-score-find-trace gnus-score-file-name) - ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize) - ("gnus-topic" :interactive t gnus-topic-mode) + ("gnus-cus" :interactive (gnus-group-mode) gnus-group-customize) + ("gnus-cus" :interactive (gnus-summary-mode) gnus-score-customize) + ("gnus-topic" :interactive (gnus-group-mode) gnus-topic-mode) ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters gnus-subscribe-topics) - ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode) + ("gnus-salt" :interactive (gnus-summary-mode) + gnus-pick-mode gnus-binary-mode) ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) - ("gnus-uu" :interactive t + ("gnus-uu" :interactive (gnus-article-mode gnus-summary-mode) gnus-uu-digest-mail-forward gnus-uu-digest-post-forward gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer gnus-uu-mark-by-regexp gnus-uu-mark-all @@ -2598,12 +2612,13 @@ are always t.") ("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) - ("gnus-msg" :interactive t - gnus-group-post-news gnus-group-mail gnus-group-news + ("gnus-msg" :interactive (gnus-group-mode) + gnus-group-post-news gnus-group-mail gnus-group-news) + ("gnus-msg" :interactive (gnus-summary-mode) gnus-summary-post-news gnus-summary-news-other-window gnus-summary-followup gnus-summary-followup-with-original gnus-summary-cancel-article gnus-summary-supersede-article - gnus-post-news gnus-summary-reply gnus-summary-reply-with-original + gnus-summary-reply gnus-summary-reply-with-original gnus-summary-mail-forward gnus-summary-mail-other-window gnus-summary-resend-message gnus-summary-resend-bounced-mail gnus-summary-wide-reply gnus-summary-followup-to-mail @@ -2611,7 +2626,9 @@ are always t.") gnus-summary-wide-reply-with-original gnus-summary-post-forward gnus-summary-wide-reply-with-original gnus-summary-post-forward) - ("gnus-picon" :interactive t gnus-treat-from-picon) + ("gnus-msg" gnus-post-news) + ("gnus-picon" :interactive (gnus-article-mode gnus-summary-mode) + gnus-treat-from-picon) ("smiley" :interactive t smiley-region) ("gnus-win" gnus-configure-windows gnus-add-configuration) ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group @@ -2634,7 +2651,7 @@ are always t.") gnus-request-article-this-buffer gnus-article-mode gnus-article-setup-buffer gnus-narrow-to-page gnus-article-delete-invisible-text gnus-treat-article) - ("gnus-art" :interactive t + ("gnus-art" :interactive (gnus-summary-mode gnus-article-mode) gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-remove-cr gnus-article-remove-trailing-blank-lines @@ -2646,7 +2663,6 @@ are always t.") gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed - ;;gnus-article-show-all-headers 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 @@ -2671,12 +2687,13 @@ are always t.") gnus-agent-store-article gnus-agent-group-covered-p) ("gnus-agent" :interactive t gnus-unplugged gnus-agentize gnus-agent-batch) - ("gnus-vm" :interactive t gnus-summary-save-in-vm + ("gnus-vm" :interactive (gnus-summary-mode) gnus-summary-save-in-vm gnus-summary-save-article-vm) ("compface" uncompface) - ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue) + ("gnus-draft" :interactive (gnus-summary-mode) gnus-draft-mode) + ("gnus-draft" :interactive t gnus-group-send-queue) ("gnus-mlspl" gnus-group-split gnus-group-split-fancy) - ("gnus-mlspl" :interactive t gnus-group-split-setup + ("gnus-mlspl" :interactive (gnus-group-mode) gnus-group-split-setup gnus-group-split-update) ("gnus-delay" gnus-delay-initialize)))) @@ -3212,9 +3229,9 @@ that that variable is buffer-local to the summary buffers." (format "%s" (car method)) (format "%s:%s" (car method) (cadr method)))) (name-method (cons name method))) - (when (and (not no-enter-cache) - (not (member name-method gnus-server-method-cache)) - (not (assoc (car name-method) gnus-server-method-cache))) + (unless (or no-enter-cache + (member name-method gnus-server-method-cache) + (assoc (car name-method) gnus-server-method-cache)) (push name-method gnus-server-method-cache)) name))) @@ -3509,7 +3526,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." @@ -3725,13 +3742,13 @@ 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)))) @@ -4148,8 +4165,9 @@ prompt the user for the name of an NNTP server to use." ;; file. (unless (string-match "^Gnus" gnus-version) (load "gnus-load" nil t)) - (unless (byte-code-function-p (symbol-function 'gnus)) - (message "You should byte-compile Gnus") + (unless (or (byte-code-function-p (symbol-function 'gnus)) + (subr-native-elisp-p (symbol-function 'gnus))) + (message "You should compile Gnus") (sit-for 2)) (let ((gnus-action-message-log (list nil))) (gnus-1 arg dont-connect child) diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el index 091e3899c26..4f800891b2b 100644 --- a/lisp/gnus/legacy-gnus-agent.el +++ b/lisp/gnus/legacy-gnus-agent.el @@ -1,4 +1,4 @@ -;;; gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding: t; -*- +;;; legacy-gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 5a5dbcebc1e..bff1b2a60d9 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -120,12 +120,13 @@ :group 'message-buffers :type 'integer) -(defcustom message-send-rename-function nil +(defcustom message-send-rename-function #'message-default-send-rename-function "Function called to rename the buffer after sending it." :group 'message-buffers - :type '(choice function (const nil))) + :version "28.1" + :type 'function) -(defcustom message-fcc-handler-function 'message-output +(defcustom message-fcc-handler-function #'message-output "A function called to save outgoing articles. This function will be called with the name of the file to store the article in. The default function is `message-output' which saves in Unix @@ -186,22 +187,26 @@ Otherwise, most addresses look like `angles', but they look like (defcustom message-syntax-checks (if message-insert-canlock '((sender . disabled)) nil) - ;; Guess this one shouldn't be easy to customize... "Controls what syntax checks should not be performed on outgoing posts. To disable checking of long signatures, for instance, add `(signature . disabled)' to this list. Don't touch this variable unless you really know what you're doing. -Checks include `approved', `bogus-recipient', `continuation-headers', -`control-chars', `empty', `existing-newsgroups', `from', `illegible-text', -`invisible-text', `long-header-lines', `long-lines', `message-id', -`multiple-headers', `new-text', `newsgroups', `quoting-style', -`repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot', -`shorten-followup-to', `signature', `size', `subject', `subject-cmsg' -and `valid-newsgroups'." - :group 'message-news - :type '(repeat sexp)) ; Fixme: improve this +See the Message manual for the meanings of the valid syntax check +types." + :group 'message-headers + :link '(custom-manual "(message)Message Headers") + :type '(alist + :key-type symbol + :value-type (const disabled) + :options (approved bogus-recipient continuation-headers + control-chars empty existing-newsgroups from illegible-text + invisible-text long-header-lines long-lines message-id + multiple-headers new-text newgroups quoting-style + repeated-newsgroups reply-to sender sendsys shoot + shorten-followup-to signature size subject subject-cmsg + valid-newsgroups))) (defcustom message-required-headers '((optional . References) From) @@ -382,7 +387,7 @@ Archives \(such as groups.google.com) respect this header." :group 'message-various) (defcustom message-archive-note - "X-No-Archive: Yes - save http://groups.google.com/" + "X-No-Archive: Yes - save https://groups.google.com/" "Note to insert why you wouldn't want this posting archived. If nil, don't insert any text in the body." :version "22.1" @@ -418,7 +423,7 @@ you can explicitly override this setting by calling :type 'string :group 'message-various) -(defcustom message-cross-post-note-function 'message-cross-post-insert-note +(defcustom message-cross-post-note-function #'message-cross-post-insert-note "Function to use to insert note about Crosspost or Followup-To. The function will be called with four arguments. The function should not only insert a note, but also ensure old notes are deleted. See the documentation @@ -756,7 +761,7 @@ See also `send-mail-function'." :link '(custom-manual "(message)Mail Variables") :group 'message-mail) -(defcustom message-send-news-function 'message-send-news +(defcustom message-send-news-function #'message-send-news "Function to call to send the current buffer as news. The headers should be delimited by a line whose contents match the variable `mail-header-separator'." @@ -765,29 +770,32 @@ variable `mail-header-separator'." :link '(custom-manual "(message)News Variables") :type 'function) -(defcustom message-reply-to-function nil +(defcustom message-reply-to-function #'ignore "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :link '(custom-manual "(message)Reply") - :type '(choice function (const nil))) + :version "28.1" + :type 'function) -(defcustom message-wide-reply-to-function nil +(defcustom message-wide-reply-to-function #'ignore "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :link '(custom-manual "(message)Wide Reply") - :type '(choice function (const nil))) + :version "28.1" + :type 'function) -(defcustom message-followup-to-function nil +(defcustom message-followup-to-function #'ignore "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :link '(custom-manual "(message)Followup") - :type '(choice function (const nil))) + :version "28.1" + :type 'function) (defcustom message-extra-wide-headers nil "If non-nil, a list of additional address headers. @@ -1021,7 +1029,7 @@ the signature is inserted." :version "22.1" :group 'message-various) -(defcustom message-citation-line-function 'message-insert-citation-line +(defcustom message-citation-line-function #'message-insert-citation-line "Function called to insert the \"Whomever writes:\" line. Predefined functions include `message-insert-citation-line' and @@ -1103,7 +1111,7 @@ Used by `message-yank-original' via `message-yank-cite'." :link '(custom-manual "(message)Insertion Variables") :type 'integer) -(defcustom message-cite-function 'message-cite-original-without-signature +(defcustom message-cite-function #'message-cite-original-without-signature "Function for citing an original message. Predefined functions include `message-cite-original' and `message-cite-original-without-signature'. @@ -1116,7 +1124,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil." :version "22.3" ;; Gnus 5.10.12 (changed default) :group 'message-insertion) -(defcustom message-indent-citation-function 'message-indent-citation +(defcustom message-indent-citation-function #'message-indent-citation "Function for modifying a citation just inserted in the mail buffer. This can also be a list of functions. Each function can find the citation between (point) and (mark t). And each function should leave @@ -1650,6 +1658,11 @@ starting with `not' and followed by regexps." "Face used for displaying MML." :group 'message-faces) +(defface message-signature-separator '((t :bold t)) + "Face used for displaying the signature separator." + :group 'message-faces + :version "28.1") + (defun message-match-to-eoh (_limit) (let ((start (point))) (rfc822-goto-eoh) @@ -1743,9 +1756,22 @@ number of levels specified in the faces `message-cited-text-*'." (0 ',cited-text-face)) keywords)) (setq level (1+ level))) - keywords)) + keywords) + ;; Match signature. This `field' stuff ensures that hitting `RET' + ;; after the signature separator doesn't remove the trailing space. + (list + '(message--match-signature (0 '( face message-signature-separator + rear-nonsticky t + field signature))))) "Additional expressions to highlight in Message mode.") +(defun message--match-signature (limit) + (save-excursion + (and (re-search-forward message-signature-separator limit t) + ;; It's the last one in the buffer. + (not (save-excursion + (re-search-forward message-signature-separator nil t)))))) + (defvar message-face-alist '((bold . message-bold-region) (underline . underline-region) @@ -2334,7 +2360,8 @@ Leading \"Re: \" is not stripped by this function. Use the function "Ask for NEW-SUBJECT header, append (was: <Old Subject>)." (interactive (list - (read-from-minibuffer "New subject: "))) + (read-from-minibuffer "New subject: ")) + message-mode) (cond ((and (not (or (null new-subject) ; new subject not empty (zerop (string-width new-subject)) (string-match "^[ \t]*$" new-subject)))) @@ -2364,7 +2391,7 @@ Leading \"Re: \" is not stripped by this function. Use the function "Mark some region in the current article with enclosing tags. See `message-mark-insert-begin' and `message-mark-insert-end'. If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." - (interactive "r\nP") + (interactive "r\nP" message-mode) (save-excursion ;; add to the end of the region first, otherwise end would be invalid (goto-char end) @@ -2376,7 +2403,7 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." "Insert FILE at point, marking it with enclosing tags. See `message-mark-insert-begin' and `message-mark-insert-end'. If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." - (interactive "fFile to insert: \nP") + (interactive "fFile to insert: \nP" message-mode) ;; reverse insertion to get correct result. (let ((p (point))) (insert (if verbatim "#v-\n" message-mark-insert-end)) @@ -2390,7 +2417,7 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." The note can be customized using `message-archive-note'. When called with a prefix argument, ask for a text to insert. If you don't want the note in the body, set `message-archive-note' to nil." - (interactive) + (interactive nil message-mode) (if current-prefix-arg (setq message-archive-note (read-from-minibuffer "Reason for No-Archive: " @@ -2416,7 +2443,8 @@ With prefix-argument just set Follow-Up, don't cross-post." gnus-newsrc-alist) nil nil '("poster" . 0) (if (boundp 'gnus-group-history) - 'gnus-group-history))))) + 'gnus-group-history)))) + message-mode) (message-remove-header "Follow[Uu]p-[Tt]o" t) (message-goto-newsgroups) (beginning-of-line) @@ -2493,7 +2521,8 @@ With prefix-argument just set Follow-Up, don't cross-post." gnus-newsrc-alist) nil nil '("poster" . 0) (if (boundp 'gnus-group-history) - 'gnus-group-history))))) + 'gnus-group-history)))) + message-mode) (when (fboundp 'gnus-group-real-name) (setq target-group (gnus-group-real-name target-group))) (cond ((not (or (null target-group) ; new subject not empty @@ -2528,7 +2557,7 @@ With prefix-argument just set Follow-Up, don't cross-post." (defun message-reduce-to-to-cc () "Replace contents of To: header with contents of Cc: or Bcc: header." - (interactive) + (interactive nil message-mode) (let ((cc-content (save-restriction (message-narrow-to-headers) (message-fetch-field "cc"))) @@ -2694,7 +2723,7 @@ Point is left at the beginning of the narrowed-to region." (defun message-sort-headers () "Sort headers of the current message according to `message-header-format-alist'." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (let ((max (1+ (length message-header-format-alist))) @@ -2715,7 +2744,7 @@ Point is left at the beginning of the narrowed-to region." (defun message-kill-address () "Kill the address under point." - (interactive) + (interactive nil message-mode) (let ((start (point))) (message-skip-to-next-address) (kill-region start (if (bolp) (1- (point)) (point))))) @@ -2844,79 +2873,79 @@ Consider adding this function to `message-header-setup-hook'" (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?" #'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) + #'message-insert-or-toggle-importance) (define-key message-mode-map "\C-c\C-f\C-a" - 'message-generate-unsubscribed-mail-followup-to) + #'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) + (define-key message-mode-map "\C-c\C-fs" #'message-change-subject) ;; - (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to) + (define-key message-mode-map "\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) + (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) ;; 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\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-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-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\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)) + #'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)) (easy-menu-define message-mode-menu message-mode-map "Message Menu." @@ -3166,14 +3195,13 @@ Like `text-mode', but with these additional commands: ;; `electric-pair-mode', and C-M-* navigation by syntactically ;; excluding citations and other artifacts. ;; - (setq-local syntax-propertize-function 'message--syntax-propertize) + (setq-local syntax-propertize-function #'message--syntax-propertize) (setq-local parse-sexp-ignore-comments t) (setq-local message-encoded-mail-cache nil)) (defun message-setup-fill-variables () "Setup message fill variables." (setq-local fill-paragraph-function #'message-fill-paragraph) - (make-local-variable 'adaptive-fill-first-line-regexp) (let ((quote-prefix-regexp ;; User should change message-cite-prefix-regexp if ;; message-yank-prefix is set to an abnormal value. @@ -3208,87 +3236,87 @@ Like `text-mode', but with these additional commands: (defun message-goto-to () "Move point to the To header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "To")) (defun message-goto-from () "Move point to the From header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "From")) (defun message-goto-subject () "Move point to the Subject header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Subject")) (defun message-goto-cc () "Move point to the Cc header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Cc" "To")) (defun message-goto-bcc () "Move point to the Bcc header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Bcc" "Cc" "To")) (defun message-goto-fcc () "Move point to the Fcc header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Fcc" "To" "Newsgroups")) (defun message-goto-reply-to () "Move point to the Reply-To header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Reply-To" "Subject")) (defun message-goto-newsgroups () "Move point to the Newsgroups header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Newsgroups")) (defun message-goto-distribution () "Move point to the Distribution header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Distribution")) (defun message-goto-followup-to () "Move point to the Followup-To header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Followup-To" "Newsgroups")) (defun message-goto-mail-followup-to () "Move point to the Mail-Followup-To header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Mail-Followup-To" "To")) (defun message-goto-keywords () "Move point to the Keywords header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Keywords" "Subject")) (defun message-goto-summary () "Move point to the Summary header." - (interactive) + (interactive nil message-mode) (push-mark) (message-position-on-field "Summary" "Subject")) -(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1") +(define-obsolete-function-alias 'message-goto-body-1 #'message-goto-body "27.1") (defun message-goto-body (&optional interactive) "Move point to the beginning of the message body. Returns point." - (interactive "p") + (interactive "p" message-mode) (when interactive (when (looking-at "[ \t]*\n") (expand-abbrev)) @@ -3315,7 +3343,7 @@ Returns point." (defun message-goto-eoh (&optional interactive) "Move point to the end of the headers." - (interactive "p") + (interactive "p" message-mode) (message-goto-body interactive) (forward-line -1)) @@ -3323,7 +3351,7 @@ Returns point." "Move point to the beginning of the message signature. If there is no signature in the article, go to the end and return nil." - (interactive) + (interactive nil message-mode) (push-mark) (goto-char (point-min)) (if (re-search-forward message-signature-separator nil t) @@ -3342,7 +3370,7 @@ in the current mail buffer, and appends the current `user-mail-address'. If the optional argument INCLUDE-CC is non-nil, the addresses in the Cc: header are also put into the MFT." - (interactive "P") + (interactive "P" message-mode) (let* (cc tos) (save-restriction (message-narrow-to-headers) @@ -3360,7 +3388,7 @@ Cc: header are also put into the MFT." "Insert a To header that points to the author of the article being replied to. If the original author requested not to be sent mail, don't insert unless the prefix FORCE is given." - (interactive "P") + (interactive "P" message-mode) (let* ((mct (message-fetch-reply-field "mail-copies-to")) (dont (and mct (or (equal (downcase mct) "never") (equal (downcase mct) "nobody")))) @@ -3379,7 +3407,7 @@ prefix FORCE is given." (defun message-insert-wide-reply () "Insert To and Cc headers as if you were doing a wide reply." - (interactive) + (interactive nil message-mode) (let ((headers (message-with-reply-buffer (message-get-reply-headers t)))) (message-carefully-insert-headers headers))) @@ -3424,7 +3452,7 @@ or in the synonym headers, defined by `message-header-synonyms'." (defun message-widen-reply () "Widen the reply to include maximum recipients." - (interactive) + (interactive nil message-mode) (let ((follow-to (and (buffer-live-p message-reply-buffer) (with-current-buffer message-reply-buffer @@ -3440,7 +3468,7 @@ or in the synonym headers, defined by `message-header-synonyms'." (defun message-insert-newsgroups () "Insert the Newsgroups header from the article being replied to." - (interactive) + (interactive nil message-mode) (let ((old-newsgroups (mail-fetch-field "newsgroups")) (new-newsgroups (message-fetch-reply-field "newsgroups")) (first t) @@ -3475,13 +3503,13 @@ or in the synonym headers, defined by `message-header-synonyms'." (defun message-widen-and-recenter () "Widen the buffer and go to the start." - (interactive) + (interactive nil message-mode) (widen) (goto-char (point-min))) (defun message-delete-not-region (beg end) "Delete everything in the body of the current message outside of the region." - (interactive "r") + (interactive "r" message-mode) (let (citeprefix) (save-excursion (goto-char beg) @@ -3508,7 +3536,7 @@ or in the synonym headers, defined by `message-header-synonyms'." "Kill all text up to the signature. If a numeric argument or prefix arg is given, leave that number of lines before the signature intact." - (interactive "P") + (interactive "P" message-mode) (save-excursion (save-restriction (let ((point (point))) @@ -3526,7 +3554,7 @@ of lines before the signature intact." (defun message-newline-and-reformat (&optional arg not-break) "Insert four newlines, and then reformat if inside quoted text. Prefix arg means justify as well." - (interactive (list (if current-prefix-arg 'full))) + (interactive (list (if current-prefix-arg 'full)) message-mode) (unless (message-in-body-p) (error "This command only works in the body of the message")) (let (quoted point beg end leading-space bolp fill-paragraph-function) @@ -3617,7 +3645,7 @@ Prefix arg means justify as well." "Message specific function to fill a paragraph. This function is used as the value of `fill-paragraph-function' in Message buffers and is not meant to be called directly." - (interactive (list (if current-prefix-arg 'full))) + (interactive (list (if current-prefix-arg 'full)) message-mode) (if (message-point-in-header-p) (message-fill-field) (message-newline-and-reformat arg t)) @@ -3648,7 +3676,7 @@ more information. If FORCE is 0 (or when called interactively), the global values of the signature variables will be consulted if the local ones are null." - (interactive (list 0)) + (interactive (list 0) message-mode) (let ((message-signature message-signature) (message-signature-file message-signature-file)) ;; If called interactively and there's no signature to insert, @@ -3707,7 +3735,7 @@ are null." (defun message-insert-importance-high () "Insert header to mark message as important." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (message-narrow-to-headers) @@ -3717,7 +3745,7 @@ are null." (defun message-insert-importance-low () "Insert header to mark message as unimportant." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (message-narrow-to-headers) @@ -3729,7 +3757,7 @@ are null." "Insert a \"Importance: high\" header, or cycle through the header values. The three allowed values according to RFC 1327 are `high', `normal' and `low'." - (interactive) + (interactive nil message-mode) (save-excursion (let ((new "high") cur) @@ -3749,7 +3777,7 @@ and `low'." (defun message-insert-disposition-notification-to () "Request a disposition notification (return receipt) to this message. Note that this should not be used in newsgroups." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (message-narrow-to-headers) @@ -3764,7 +3792,7 @@ Note that this should not be used in newsgroups." "Elide the text in the region. An ellipsis (from `message-elide-ellipsis') will be inserted where the text was killed." - (interactive "r") + (interactive "r" message-mode) (let ((lines (count-lines b e)) (chars (- e b))) (kill-region b e) @@ -3781,7 +3809,8 @@ text was killed." (min (point) (or (mark t) (point))) (max (point) (or (mark t) (point))) (when current-prefix-arg - (prefix-numeric-value current-prefix-arg)))) + (prefix-numeric-value current-prefix-arg))) + message-mode) (setq n (if (numberp n) (mod n 26) 13)) ;canonize N (unless (or (zerop n) ; no action needed for a rot of 0 @@ -3815,7 +3844,8 @@ 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." (interactive (if current-prefix-arg (list (prefix-numeric-value current-prefix-arg)) - (list nil))) + (list nil)) + message-mode) (save-excursion (save-restriction (when (and (not wide) (message-goto-body)) @@ -3835,7 +3865,7 @@ Mail and USENET news headers are not rotated unless WIDE is non-nil." "Rename the *message* buffer to \"*message* RECIPIENT\". If the function is run with a prefix, it will ask for a new buffer name, rather than giving an automatic name." - (interactive "Pbuffer name: ") + (interactive "Pbuffer name: " message-mode) (save-excursion (save-restriction (goto-char (point-min)) @@ -3858,7 +3888,7 @@ name, rather than giving an automatic name." (defun message-fill-yanked-message (&optional justifyp) "Fill the paragraphs of a message yanked into this one. Numeric argument means justify as well." - (interactive "P") + (interactive "P" message-mode) (save-excursion (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n") nil t) @@ -3923,7 +3953,7 @@ If REMOVE is non-nil, remove newlines, too. To use this automatically, you may add this function to `gnus-message-setup-hook'." - (interactive "P") + (interactive "P" message-mode) (let ((citexp (concat "^\\(" (concat message-yank-cited-prefix "\\|") message-yank-prefix @@ -3988,7 +4018,7 @@ This function uses `message-cite-function' to do the actual citing. Just \\[universal-argument] as argument means don't indent, insert no prefix, and don't delete any headers." - (interactive "P") + (interactive "P" message-mode) ;; eval the let forms contained in message-cite-style (let ((bindings (if (symbolp message-cite-style) (symbol-value message-cite-style) @@ -3999,7 +4029,7 @@ prefix, and don't delete any headers." (defun message-yank-buffer (buffer) "Insert BUFFER into the current buffer and quote it." - (interactive "bYank buffer: ") + (interactive "bYank buffer: " message-mode) (let ((message-reply-buffer (get-buffer buffer))) (save-window-excursion (message-yank-original)))) @@ -4226,7 +4256,7 @@ This function strips off the signature from the original message." "Send message like `message-send', then, if no errors, exit from mail buffer. The usage of ARG is defined by the instance that called Message. It should typically alter the sending method in some way or other." - (interactive "P") + (interactive "P" message-mode) (let ((buf (current-buffer)) (position (point-marker)) (actions message-exit-actions)) @@ -4246,7 +4276,7 @@ It should typically alter the sending method in some way or other." (defun message-dont-send () "Don't send the message you have been editing. Instead, just auto-save the buffer and then bury it." - (interactive) + (interactive nil message-mode) (set-buffer-modified-p t) (save-buffer) (let ((actions message-postpone-actions)) @@ -4255,7 +4285,7 @@ Instead, just auto-save the buffer and then bury it." (defun message-kill-buffer () "Kill the current buffer." - (interactive) + (interactive nil message-mode) (when (or (not (buffer-modified-p)) (not message-kill-buffer-query) (yes-or-no-p "Message modified; kill anyway? ")) @@ -4304,7 +4334,7 @@ Otherwise any failure is reported in a message back to the user from the mailer. The usage of ARG is defined by the instance that called Message. It should typically alter the sending method in some way or other." - (interactive "P") + (interactive "P" message-mode) ;; Make it possible to undo the coming changes. (undo-boundary) (let ((inhibit-read-only t)) @@ -4572,7 +4602,7 @@ An address might be bogus if there's a matching entry in "Warn before composing or sending a mail to an invalid address. This function could be useful in `message-setup-hook'." - (interactive) + (interactive nil message-mode) (save-restriction (message-narrow-to-headers) (dolist (hdr '("To" "Cc" "Bcc")) @@ -4892,6 +4922,7 @@ Each line should be no more than 79 characters long." (defvar smtpmail-smtp-service) (defvar smtpmail-smtp-user) (defvar smtpmail-stream-type) +(defvar smtpmail-store-queue-variables) (defun message-multi-smtp-send-mail () "Send the current buffer to `message-send-mail-function'. @@ -4907,7 +4938,8 @@ that instead." (message-send-mail-with-sendmail)) ((equal (car method) "smtp") (require 'smtpmail) - (let* ((smtpmail-smtp-server (nth 1 method)) + (let* ((smtpmail-store-queue-variables t) + (smtpmail-smtp-server (nth 1 method)) (service (nth 2 method)) (port (string-to-number service)) ;; If we're talking to the TLS SMTP port, then force a @@ -5308,7 +5340,7 @@ 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 @@ -5325,7 +5357,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. @@ -5339,11 +5371,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))))) @@ -5465,8 +5497,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) @@ -5491,7 +5523,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))) @@ -5499,8 +5531,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) @@ -5744,7 +5776,7 @@ If NOW, use that time instead." (defun message-insert-expires (days) "Insert the Expires header. Expiry in DAYS days." - (interactive "NExpire article in how many days? ") + (interactive "NExpire article in how many days? " message-mode) (save-excursion (message-position-on-field "Expires" "X-Draft-From") (insert (message-make-expires-date days)))) @@ -5774,7 +5806,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) ">")) @@ -5990,7 +6022,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))) @@ -6021,7 +6053,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) @@ -6036,8 +6068,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." @@ -6047,7 +6078,7 @@ give as trustworthy answer as possible." (defun message-to-list-only () "Send a message to the list only. Remove all addresses but the list address from To and Cc headers." - (interactive) + (interactive nil message-mode) (let ((listaddr (message-make-mail-followup-to t))) (when listaddr (save-excursion @@ -6133,7 +6164,7 @@ subscribed address (and not the additional To and Cc header contents)." (defun message-idna-to-ascii-rhs () "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers. See `message-idna-encode'." - (interactive) + (interactive nil message-mode) (when message-use-idna (save-excursion (save-restriction @@ -6351,7 +6382,7 @@ Headers already prepared in the buffer are not modified." (defun message-split-line () "Split current line, moving portion beyond point vertically down. If the current line has `message-yank-prefix', insert it on the new line." - (interactive "*") + (interactive "*" message-mode) (split-line message-yank-prefix)) (defun message-insert-header (header value) @@ -6549,7 +6580,7 @@ When called without a prefix argument, header value spanning multiple lines is treated as a single line. Otherwise, even if N is 1, when point is on a continuation header line, it will be moved to the beginning " - (interactive "^p") + (interactive "^p" message-mode) (cond ;; Go to beginning of header or beginning of line. ((and message-beginning-of-line (message-point-in-header-p)) @@ -6657,9 +6688,8 @@ moved to the beginning " (not (buffer-modified-p buffer))) (kill-buffer buffer)))) ;; Rename the buffer. - (if message-send-rename-function - (funcall message-send-rename-function) - (message-default-send-rename-function)) + (funcall (or message-send-rename-function + #'message-default-send-rename-function)) ;; Push the current buffer onto the list. (when message-max-buffers (setq message-buffer-list @@ -6758,8 +6788,9 @@ are not included." (defun message-setup-1 (headers &optional yank-action actions return-action) (dolist (action actions) (condition-case nil + ;; FIXME: Use functions rather than expressions! (add-to-list 'message-send-actions - `(apply ',(car action) ',(cdr action))))) + `(apply #',(car action) ',(cdr action))))) (setq message-return-action return-action) (setq message-reply-buffer (if (and (consp yank-action) @@ -6874,7 +6905,7 @@ are not included." (defun message-insert-headers () "Generate the headers for the article." - (interactive) + (interactive nil message-mode) (save-excursion (save-restriction (message-narrow-to-headers) @@ -6898,7 +6929,7 @@ are not included." ;;;###autoload (defun message-mail (&optional to subject other-headers continue switch-function yank-action send-actions - return-action &rest ignored) + return-action &rest _) "Start editing a mail message to be sent. OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether to continue editing a message already being composed. SWITCH-FUNCTION @@ -7022,7 +7053,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") ". @@ -7122,15 +7153,12 @@ want to get rid of this query permanently."))) ;; specific, and just Cc-in the rest. (setq follow-to (list (cons 'To - (mapconcat - (lambda (addr) - (cdr addr)) recipients ", ")))) + (mapconcat #'cdr recipients ", ")))) ;; Put the first recipient in the To header. (setq follow-to (list (cons 'To (cdr (pop recipients))))) ;; Put the rest of the recipients in Cc. (when recipients - (setq recipients (mapconcat - (lambda (addr) (cdr addr)) recipients ", ")) + (setq recipients (mapconcat #'cdr recipients ", ")) (if (string-match "^ +" recipients) (setq recipients (substring recipients (match-end 0)))) (push (cons 'Cc recipients) follow-to))))) @@ -7329,7 +7357,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") ". @@ -7857,7 +7885,7 @@ is for the internal use." (interactive) (setq rmail-enable-mime-composing t) (setq rmail-insert-mime-forwarded-message-function - 'message-forward-rmail-make-body)) + #'message-forward-rmail-make-body)) ;;;###autoload (defun message-resend (address) @@ -8214,7 +8242,7 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed." Execute function specified by `message-tab-body-function' when not in those headers. If that variable is nil, indent with the regular text mode tabbing command." - (interactive) + (interactive nil message-mode) (cond ((let ((completion-fail-discreetly t)) (completion-at-point)) @@ -8571,7 +8599,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)) @@ -8591,7 +8619,7 @@ From headers in the original article." (defun message-display-abbrev (&optional choose) "Display the next possible abbrev for the text before point." - (interactive (list t)) + (interactive (list t) message-mode) (when (message--in-tocc-p) (let* ((end (point)) (start (save-excursion @@ -8678,7 +8706,7 @@ Unless FORCE, prompt before sending. The messages are separated by `message-form-letter-separator'. Header and body are separated by `mail-header-separator'." - (interactive "P") + (interactive "P" message-mode) (let ((sent 0) (skipped 0) start end text buff @@ -8713,17 +8741,18 @@ Header and body are separated by `mail-header-separator'." (defun message-replace-header (header new-value &optional after force) "Remove HEADER and insert the NEW-VALUE. -If AFTER, insert after this header. If FORCE, insert new field -even if NEW-VALUE is empty." +If AFTER, insert after this header. AFTER may be a list of +headers. If FORCE, insert new field even if NEW-VALUE is empty." ;; Similar to `nnheader-replace-header' but for message buffers. (save-excursion (save-restriction (message-narrow-to-headers) (message-remove-header header)) (when (or force (> (length new-value) 0)) - (if after - (message-position-on-field header after) - (message-position-on-field header)) + (apply #'message-position-on-field header + (if (listp after) + after + (list after))) (insert new-value)))) (make-obsolete-variable @@ -8746,7 +8775,7 @@ Used in `message-simplify-recipients'." (make-obsolete 'message-simplify-recipients nil "27.1") (defun message-simplify-recipients () - (interactive) + (interactive nil message-mode) (dolist (hdr '("Cc" "To")) (message-replace-header hdr @@ -8769,7 +8798,8 @@ Used in `message-simplify-recipients'." (defun message-make-html-message-with-image-files (files) "Make a message containing the current dired-marked image files." - (interactive (list (dired-get-marked-files nil current-prefix-arg))) + (interactive (list (dired-get-marked-files nil current-prefix-arg)) + dired-mode) (message-mail) (message-goto-body) (insert "<#part type=text/html>\n\n") @@ -8780,7 +8810,7 @@ Used in `message-simplify-recipients'." (defun message-toggle-image-thumbnails () "For any included image files, insert a thumbnail of that image." - (interactive) + (interactive nil message-mode) (let ((displayed nil)) (save-excursion (goto-char (point-min)) @@ -8816,7 +8846,7 @@ starting the screenshotting process. The `message-screenshot-command' variable says what command is used to take the screenshot." - (interactive "p") + (interactive "p" message-mode) (unless (executable-find (car message-screenshot-command)) (error "Can't find %s to take the screenshot" (car message-screenshot-command))) @@ -8859,7 +8889,7 @@ used to take the screenshot." (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) @@ -8885,24 +8915,25 @@ used to take the screenshot." retval)) ;;;###autoload -(defun message-mailto () +(defun message-mailto (&optional url) "Command to parse command line mailto: links. This is meant to be used for MIME handlers: Setting the handler for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\" -will then start up Emacs ready to compose mail." +will then start up Emacs ready to compose mail. For emacsclient use + emacsclient -e '(message-mailto \"%u\")'" (interactive) ;; <a href="mailto:someone@example.com?subject=This%20is%20the%20subject&cc=someone_else@example.com&body=This%20is%20the%20body">Send email</a> (message-mail) - (message-mailto-1 (pop command-line-args-left))) + (message-mailto-1 (or url (pop command-line-args-left)))) (defun message-mailto-1 (url) (let ((args (message-parse-mailto-url url))) (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-archive.el b/lisp/gnus/mm-archive.el index 1ecceeedeb7..fdc83e1de6e 100644 --- a/lisp/gnus/mm-archive.el +++ b/lisp/gnus/mm-archive.el @@ -108,4 +108,4 @@ (provide 'mm-archive) -;; mm-archive.el ends here +;;; mm-archive.el ends here diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 02cd6af0c98..82d1de25f3d 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)))) diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el index 0c25c8f8bcd..0c628055acb 100644 --- a/lisp/gnus/mm-partial.el +++ b/lisp/gnus/mm-partial.el @@ -72,14 +72,14 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." id (with-current-buffer gnus-summary-buffer (gnus-summary-article-number)))) - #'(lambda (a b) - (let ((anumber (string-to-number - (cdr (assq 'number - (cdr (mm-handle-type a)))))) - (bnumber (string-to-number - (cdr (assq 'number - (cdr (mm-handle-type b))))))) - (< anumber bnumber))))) + (lambda (a b) + (let ((anumber (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type a)))))) + (bnumber (string-to-number + (cdr (assq 'number + (cdr (mm-handle-type b))))))) + (< anumber bnumber))))) (setq gnus-article-mime-handles (mm-merge-handles gnus-article-mime-handles phandles)) (with-current-buffer (generate-new-buffer " *mm*") diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 3e36d6724ea..2ec75a0bc59 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -418,16 +418,18 @@ This is only used if `mm-inline-large-images' is set to (fundamental-mode) (goto-char (point-min))) -(defvar gnus-original-article-buffer) -(defvar gnus-article-prepare-hook) -(defvar gnus-displaying-mime) +(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.") (defun mm-inline-message (handle) + "Insert HANDLE (a message/rfc822 part) into the current buffer. +This function will call `mm-inline-message-prepare-function' +after inserting the part." (let ((b (point)) (bolp (bolp)) (charset (mail-content-type-get - (mm-handle-type handle) 'charset)) - gnus-displaying-mime handles) + (mm-handle-type handle) 'charset))) (when (and charset (stringp charset)) (setq charset (intern (downcase charset))) @@ -437,16 +439,8 @@ This is only used if `mm-inline-large-images' is set to (save-restriction (narrow-to-region b b) (mm-insert-part handle) - (let (gnus-article-mime-handles - ;; disable prepare hook - gnus-article-prepare-hook - (gnus-newsgroup-charset - (unless (eq charset 'gnus-decoded) ;; mm-uu might set it. - (or charset gnus-newsgroup-charset)))) - (let ((gnus-original-article-buffer (mm-handle-buffer handle))) - (run-hooks 'gnus-article-decode-hook)) - (gnus-article-prepare-display) - (setq handles gnus-article-mime-handles)) + (when mm-inline-message-prepare-function + (funcall mm-inline-message-prepare-function charset)) (goto-char (point-min)) (unless bolp (insert "\n")) @@ -454,9 +448,6 @@ This is only used if `mm-inline-large-images' is set to (unless (bolp) (insert "\n")) (insert "----------\n\n") - (when handles - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles))) (mm-handle-set-undisplayer handle (let ((beg (point-min-marker)) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index d41c9dd0d9a..b49793509fc 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -140,7 +140,7 @@ by default identifies the used encryption keys, giving away the Bcc'ed identities. Clearly, this contradicts the original goal of *blind* copies. For an academic paper explaining the problem, see URL -`http://crypto.stanford.edu/portia/papers/bb-bcc.pdf'. +`https://crypto.stanford.edu/portia/papers/bb-bcc.pdf'. Use this variable to specify e-mail addresses whose owners do not mind if they are identifiable as recipients. This may be useful if you use Bcc headers to encrypt e-mails to yourself." @@ -250,7 +250,7 @@ You can also customize or set `mml-signencrypt-style-alist' instead." "Add MML tags to sign this MML part. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-part (or method mml-secure-method mml-default-sign-method) 'sign)) @@ -259,43 +259,43 @@ Use METHOD if given. Else use `mml-secure-method' or "Add MML tags to encrypt this MML part. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-part (or method mml-secure-method mml-default-sign-method))) (defun mml-secure-sign-pgp () "Add MML tags to PGP sign this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgp" 'sign)) (defun mml-secure-sign-pgpauto () "Add MML tags to PGP-auto sign this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgpauto" 'sign)) (defun mml-secure-sign-pgpmime () "Add MML tags to PGP/MIME sign this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgpmime" 'sign)) (defun mml-secure-sign-smime () "Add MML tags to S/MIME sign this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "smime" 'sign)) (defun mml-secure-encrypt-pgp () "Add MML tags to PGP encrypt this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgp")) (defun mml-secure-encrypt-pgpmime () "Add MML tags to PGP/MIME encrypt this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "pgpmime")) (defun mml-secure-encrypt-smime () "Add MML tags to S/MIME encrypt this MML part." - (interactive) + (interactive nil mml-mode) (mml-secure-part "smime")) (defun mml-secure-is-encrypted-p (&optional tag-present) @@ -358,7 +358,7 @@ either an error is raised or not." (defun mml-unsecure-message () "Remove security related MML tags from message." - (interactive) + (interactive nil mml-mode) (save-excursion (goto-char (point-max)) (when (re-search-backward "^<#secure.*>\n" nil t) @@ -369,7 +369,7 @@ either an error is raised or not." "Add MML tags to sign the entire message. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-message (or method mml-secure-method mml-default-sign-method) 'sign)) @@ -378,7 +378,7 @@ Use METHOD if given. Else use `mml-secure-method' or "Add MML tag to sign and encrypt the entire message. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-message (or method mml-secure-method mml-default-sign-method) 'signencrypt)) @@ -387,53 +387,53 @@ Use METHOD if given. Else use `mml-secure-method' or "Add MML tag to encrypt the entire message. Use METHOD if given. Else use `mml-secure-method' or `mml-default-sign-method'." - (interactive) + (interactive nil mml-mode) (mml-secure-message (or method mml-secure-method mml-default-sign-method) 'encrypt)) (defun mml-secure-message-sign-smime () "Add MML tag to encrypt/sign the entire message." - (interactive) + (interactive nil mml-mode) (mml-secure-message "smime" 'sign)) (defun mml-secure-message-sign-pgp () "Add MML tag to encrypt/sign the entire message." - (interactive) + (interactive nil mml-mode) (mml-secure-message "pgp" 'sign)) (defun mml-secure-message-sign-pgpmime () "Add MML tag to encrypt/sign the entire message." - (interactive) + (interactive nil mml-mode) (mml-secure-message "pgpmime" 'sign)) (defun mml-secure-message-sign-pgpauto () "Add MML tag to encrypt/sign the entire message." - (interactive) + (interactive nil mml-mode) (mml-secure-message "pgpauto" 'sign)) (defun mml-secure-message-encrypt-smime (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") + (interactive "P" mml-mode) (mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt))) (defun mml-secure-message-encrypt-pgp (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") + (interactive "P" mml-mode) (mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt))) (defun mml-secure-message-encrypt-pgpmime (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") + (interactive "P" mml-mode) (mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt))) (defun mml-secure-message-encrypt-pgpauto (&optional dontsign) "Add MML tag to encrypt and sign the entire message. If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") + (interactive "P" mml-mode) (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt))) ;;; Common functionality for mml1991.el, mml2015.el, mml-smime.el @@ -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..959de0902e2 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -404,7 +404,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 f77e5c6434e..5f35e73cd7c 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -550,7 +550,7 @@ type detected." (end (point)) (parsed (url-generic-parse-url (cdr (assq 'src (cadr img)))))) (when (and (null (url-type parsed)) - (url-filename parsed) + (not (zerop (length (url-filename parsed)))) (file-exists-p (url-filename parsed))) (goto-char start) (when (search-forward (url-filename parsed) end t) @@ -1339,7 +1339,7 @@ If not set, `default-directory' will be used." (defun mml-quote-region (beg end) "Quote the MML tags in the region." - (interactive "r") + (interactive "r" mml-mode) (save-excursion (save-restriction ;; Temporarily narrow the region to defend from changes diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 1af7d10d055..8c40fc79f00 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -863,7 +863,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 diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 3e6f9e88eea..5f486f49703 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -323,7 +323,7 @@ (nnbabyl-possibly-change-newsgroup group server) (nnmail-check-syntax) (let ((buf (current-buffer)) - result beg) + result) ;; beg (and (nnmail-activate 'nnbabyl) (save-excursion @@ -331,7 +331,7 @@ (search-forward "\n\n" nil t) (forward-line -1) (save-excursion - (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) + (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) ;; beg (delete-region (point) (progn (forward-line 1) (point))))) (when nnmail-cache-accepted-message-ids (nnmail-cache-insert (nnmail-fetch-field "message-id") diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 15003fabcd2..adf4427523f 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -558,7 +558,7 @@ all. This may very well take some time.") (nnmail-activate 'nndiary) ;; Articles not listed in active-articles are already gone, ;; so don't try to expire them. - (setq articles (gnus-intersection articles active-articles)) + (setq articles (nreverse (seq-intersection articles active-articles #'eq))) (while articles (setq article (nndiary-article-to-file (setq number (pop articles)))) (if (and (nndiary-deletable-article-p group number) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 1dd784d5a5b..2de5b83a7b2 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -706,7 +706,7 @@ deleted. Point is left where the deleted region was." (if dont-check (setq nnfolder-current-group group nnfolder-current-buffer nil) - (let (inf file) + (let (file) ;; inf ;; If we have to change groups, see if we don't already have ;; the folder in memory. If we do, verify the modtime and ;; destroy the folder if needed so we can rescan it. @@ -718,7 +718,7 @@ deleted. Point is left where the deleted region was." ;; touched the file since last time. (when (and nnfolder-current-buffer (not (gnus-buffer-live-p nnfolder-current-buffer))) - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) + (setq nnfolder-buffer-alist (delq nil nnfolder-buffer-alist) ;; inf nnfolder-current-buffer nil)) (setq nnfolder-current-group group) 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 f4f4ef89a9e..8a48cd87dba 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -95,7 +95,7 @@ Uses the same syntax as `nnmail-split-methods'.") "Articles with the flags in the list will not be considered when splitting.") (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'." - "Emacs 24.1") + "24.1") (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. @@ -136,6 +136,16 @@ will fetch all parts that have types that match that string. A likely value would be \"text/\" to automatically fetch all textual parts.") +(defvoo nnimap-keepalive-intervals (cons (* 60 15) + (* 60 5)) + "Configuration for the nnimap keepalive timer. +The value is a cons of two integers (each representing a number +of seconds): the first is how often to run the keepalive +function, the second is the seconds of inactivity required to +send the actual keepalive command. + +Set to nil to disable keepalive commands altogether.") + (defgroup nnimap nil "IMAP for Gnus." :group 'gnus) @@ -405,20 +415,22 @@ during splitting, which may be slow." nil))) (defun nnimap-keepalive () - (let ((now (current-time))) + (let ((now (current-time)) + ;; Set this so we don't wait for a response. + (nnimap-streaming t)) (dolist (buffer nnimap-process-buffers) (when (buffer-live-p buffer) (with-current-buffer buffer (when (and nnimap-object (nnimap-last-command-time nnimap-object) (time-less-p - ;; More than five minutes since the last command. - (* 5 60) + (cdr nnimap-keepalive-intervals) (time-subtract now (nnimap-last-command-time nnimap-object)))) - (ignore-errors ;E.g. "buffer foo has no process". - (nnimap-send-command "NOOP")))))))) + (with-local-quit + (ignore-errors ;E.g. "buffer foo has no process". + (nnimap-send-command "NOOP"))))))))) (defun nnimap-open-connection (buffer) ;; Be backwards-compatible -- the earlier value of nnimap-stream was @@ -440,6 +452,7 @@ during splitting, which may be slow." ;; This is only needed for Windows XP or earlier (defun nnimap-map-port (port) + (declare-function x-server-version "xfns.c" (&optional terminal)) (if (and (eq system-type 'windows-nt) (<= (car (x-server-version)) 5) (equal port "imaps")) @@ -447,9 +460,12 @@ during splitting, which may be slow." port)) (defun nnimap-open-connection-1 (buffer) - (unless nnimap-keepalive-timer - (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15) - #'nnimap-keepalive))) + (unless (or nnimap-keepalive-timer + (null nnimap-keepalive-intervals)) + (setq nnimap-keepalive-timer (run-at-time + (car nnimap-keepalive-intervals) + (car nnimap-keepalive-intervals) + #'nnimap-keepalive))) (with-current-buffer (nnimap-make-process-buffer buffer) (let* ((coding-system-for-read 'binary) (coding-system-for-write 'binary) @@ -583,6 +599,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))) @@ -1061,7 +1084,9 @@ during splitting, which may be slow." "UID COPY %s %S") (nnimap-article-ranges (gnus-compress-sequence articles)) (nnimap-group-to-imap (gnus-group-real-name nnmail-expiry-target))) - (set (if can-move 'deleted-articles 'articles-to-delete) articles)))) + (if can-move + (setq deleted-articles articles) + (setq articles-to-delete articles))))) t) (t (dolist (article articles) @@ -1274,7 +1299,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") @@ -1613,13 +1638,15 @@ If LIMIT, first try to limit the search to the N last articles." (setq start-article 1)) (let* ((unread (gnus-compress-sequence - (gnus-set-difference - (gnus-set-difference + (seq-difference + (seq-difference existing (gnus-sorted-union (cdr (assoc '%Seen flags)) - (cdr (assoc '%Deleted flags)))) - (cdr (assoc '%Flagged flags))))) + (cdr (assoc '%Deleted flags))) + #'eq) + (cdr (assoc '%Flagged flags)) + #'eq))) (read (gnus-range-difference (cons start-article high) unread))) (when (> start-article 1) @@ -1734,7 +1761,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)))) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 9826bc6172c..bcf01cfa9e7 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -240,11 +240,6 @@ If non-nil, also update the cache when copy or move articles." :group 'nnmail :type 'boolean) -(make-obsolete-variable 'nnmail-spool-file 'mail-sources - "Gnus 5.9 (Emacs 22.1)") -;; revision 5.29 / p0-85 / Gnus 5.9 -;; Variable removed in No Gnus v0.7 - (defcustom nnmail-resplit-incoming nil "If non-nil, re-split incoming procmail sorted mail." :group 'nnmail-procmail @@ -1321,9 +1316,6 @@ Eudora has a broken References line, but an OK In-Reply-To." (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t) (replace-match "\\1" t)))) -(defalias 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references) -(make-obsolete 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references "Emacs 23.1") - (custom-add-option 'nnmail-prepare-incoming-header-hook 'nnmail-ignore-broken-references) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 46691e3494b..171f0813b38 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -21,7 +21,7 @@ ;;; Commentary: -;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>. +;; Maildir format is documented at <URL:https://cr.yp.to/proto/maildir.html>. ;; nnmaildir also stores extra information in the .nnmaildir/ directory ;; within a maildir. ;; @@ -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,"))) @@ -637,13 +637,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 +935,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 +966,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 +1096,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 +1260,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/nnmh.el b/lisp/gnus/nnmh.el index 231583fae83..0923b8eff34 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -503,6 +503,8 @@ as unread by Gnus.") (setcdr active (1+ (cdr active)))) (cdr active))) +(defvar nnmh-newsgroup-articles) + (defun nnmh-update-gnus-unreads (group) ;; Go through the .nnmh-articles file and compare with the actual ;; articles in this folder. The articles that are "new" will be diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el index 7759951662a..4e8490125f1 100644 --- a/lisp/gnus/nnoo.el +++ b/lisp/gnus/nnoo.el @@ -34,6 +34,7 @@ (defmacro defvoo (var init &optional doc &rest map) "The same as `defvar', only takes list of variables to MAP to." (declare (indent 2) + (doc-string 3) (debug (var init &optional doc &rest map))) `(prog1 ,(if doc @@ -44,6 +45,7 @@ (defmacro deffoo (func args &rest forms) "The same as `defun', only register FUNC." (declare (indent 2) + (doc-string 3) (debug (&define name lambda-list def-body))) `(prog1 (defun ,func ,args ,@forms) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index aa7c8e584a5..97c9f18a602 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -200,7 +200,7 @@ for decoding when the cdr that the data specify is not available.") (nnrss-possibly-change-group group server) (let ((e (assq article nnrss-group-data)) (nntp-server-buffer (or buffer nntp-server-buffer)) - err) ;; post + ) ;; err post (when e (with-current-buffer nntp-server-buffer (erase-buffer) @@ -302,8 +302,7 @@ for decoding when the cdr that the data specify is not available.") (when nnrss-content-function (funcall nnrss-content-function e group article)))) (cond - (err - (nnheader-report 'nnrss err)) + ;; (err (nnheader-report 'nnrss err)) ((not e) (nnheader-report 'nnrss "no such id: %d" article)) (t @@ -786,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]+\\|^ +\\| +$" "" @@ -850,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)))))) @@ -931,60 +930,7 @@ Use Mark Pilgrim's `ultra-liberal rss locator'." (setq rss-link (nnrss-rss-title-description rss-ns href-data (car hrefs)))) (setq hrefs (cdr hrefs))))) - (if rss-link - rss-link - ;; 4. check syndic8 - (nnrss-find-rss-via-syndic8 url)))))))) - -(declare-function xml-rpc-method-call "ext:xml-rpc" - (server-url method &rest params)) - -(defun nnrss-find-rss-via-syndic8 (url) - "Query syndic8 for the rss feeds it has for URL." - (if (not (locate-library "xml-rpc")) - (progn - (message "XML-RPC is not available... not checking Syndic8.") - nil) - (require 'xml-rpc) - (let ((feedid (xml-rpc-method-call - "http://www.syndic8.com/xmlrpc.php" - 'syndic8.FindSites - url))) - (when feedid - (let* ((feedinfo (xml-rpc-method-call - "http://www.syndic8.com/xmlrpc.php" - 'syndic8.GetFeedInfo - feedid)) - (urllist - (delq nil - (mapcar - (lambda (listinfo) - (if (string-equal - (cdr (assoc "status" listinfo)) - "Syndicated") - (cons - (cdr (assoc "sitename" listinfo)) - (list - (cons 'title - (cdr (assoc - "sitename" listinfo))) - (cons 'href - (cdr (assoc - "dataurl" listinfo))))))) - feedinfo)))) - (if (not (> (length urllist) 1)) - (cdar urllist) - (let ((completion-ignore-case t) - (selection - (mapcar (lambda (listinfo) - (cons (cdr (assoc "sitename" listinfo)) - (string-to-number - (cdr (assoc "feedid" listinfo))))) - feedinfo))) - (cdr (assoc - (gnus-completing-read - "Multiple feeds found. Select one" - selection t) urllist))))))))) + rss-link)))))) (defun nnrss-rss-p (data) "Test if DATA is an RSS feed. @@ -1008,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 @@ -1023,6 +970,11 @@ prefix), return the prefix." (concat ns ":") ns))) +(defun nnrss-find-rss-via-syndic8 (_url) + "This function is obsolete and does nothing. Syndic8 shut down in 2013." + (declare (obsolete nil "28.1")) + nil) + (provide 'nnrss) ;;; nnrss.el ends here diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index fffa2d27312..ecec705b326 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -33,7 +33,7 @@ ;; turn be a vector of three elements: a real prefixed group name, an ;; article number in that group, and an integer score. The score is ;; not used by nnselect but may be used by other code to help in -;; sorting. Most functions will just chose a fixed number, such as +;; sorting. Most functions will just choose a fixed number, such as ;; 100, for this score. ;; For example the search function `gnus-search-run-query' applied to @@ -100,8 +100,8 @@ (setq selection (vconcat (cl-map 'vector - #'(lambda (art) - (vector artgroup art artrsv)) + (lambda (art) + (vector artgroup art artrsv)) (gnus-uncompress-sequence artseq)) selection))) selection))) @@ -211,12 +211,12 @@ as `(keyfunc member)' and the corresponding element is just #'nnselect-article-group #'nnselect-article-number)) ((eq ,type 'tuple) (nnselect-categorize ,articles - #'(lambda (elem) - (nnselect-article-group (car elem))) - #'(lambda (elem) - (cons (nnselect-article-number - (car elem)) - (cdr elem))))) + (lambda (elem) + (nnselect-article-group (car elem))) + (lambda (elem) + (cons (nnselect-article-number + (car elem)) + (cdr elem))))) (t (nnselect-categorize ,articles #'nnselect-article-group @@ -464,8 +464,8 @@ If this variable is nil, or if the provided function returns nil, (error "Group %s does not support article expiration" artgroup)) (unless (gnus-check-server (gnus-find-method-for-group artgroup)) (error "Couldn't open server for group %s" artgroup)) - (push (mapcar #'(lambda (art) - (car (rassq art artids))) + (push (mapcar (lambda (art) + (car (rassq art artids))) (let ((nnimap-expunge 'immediately)) (gnus-request-expire-articles artlist artgroup force))) @@ -549,8 +549,8 @@ If this variable is nil, or if the provided function returns nil, (gnus-add-to-range (gnus-info-read info) (delq nil (mapcar - #'(lambda (art) - (unless (memq (cdr art) unread) (car art))) + (lambda (art) + (unless (memq (cdr art) unread) (car art))) artids)))) (pcase-dolist (`(,type . ,mark-list) marks) (let ((mark-type (gnus-article-mark-to-type type)) new) @@ -560,19 +560,19 @@ If this variable is nil, or if the provided function returns nil, (cond ((eq mark-type 'tuple) (mapcar - #'(lambda (id) - (let (mark) - (when - (setq mark (assq (cdr id) mark-list)) - (cons (car id) (cdr mark))))) + (lambda (id) + (let (mark) + (when + (setq mark (assq (cdr id) mark-list)) + (cons (car id) (cdr mark))))) artids)) (t (setq mark-list (gnus-uncompress-range mark-list)) (mapcar - #'(lambda (id) - (when (memq (cdr id) mark-list) - (car id))) artids))))) + (lambda (id) + (when (memq (cdr id) mark-list) + (car id))) artids))))) (let ((previous (alist-get type newmarks))) (if previous (nconc previous new) @@ -607,8 +607,8 @@ If this variable is nil, or if the provided function returns nil, (let ((thread (gnus-id-to-thread (mail-header-id header)))) (when thread - (cl-some #'(lambda (x) - (when (and x (> x 0)) x)) + (cl-some (lambda (x) + (when (and x (> x 0)) x)) (gnus-articles-in-thread thread))))))))) ;; Check if search-based thread referral is permitted, and ;; available. @@ -642,15 +642,15 @@ If this variable is nil, or if the provided function returns nil, old-arts seq headers) (mapc - #'(lambda (article) - (if - (setq seq - (cl-position article - gnus-newsgroup-selection :test 'equal)) - (push (1+ seq) old-arts) - (setq gnus-newsgroup-selection - (vconcat gnus-newsgroup-selection (vector article))) - (cl-incf last))) + (lambda (article) + (if + (setq seq + (cl-position article + gnus-newsgroup-selection :test 'equal)) + (push (1+ seq) old-arts) + (setq gnus-newsgroup-selection + (vconcat gnus-newsgroup-selection (vector article))) + (cl-incf last))) new-nnselect-artlist) (setq headers (gnus-fetch-headers @@ -671,9 +671,9 @@ If this variable is nil, or if the provided function returns nil, (when (setq new-marks (delq nil (mapcar - #'(lambda (art) - (when (memq (cdr art) marked) - (car art))) + (lambda (art) + (when (memq (cdr art) marked) + (car art))) artids))) (nconc (symbol-value @@ -777,7 +777,7 @@ If this variable is nil, or if the provided function returns nil, Return an article list." (let ((func (alist-get 'nnselect-function specs)) (args (alist-get 'nnselect-args specs))) - (condition-case err + (condition-case-unless-debug err (funcall func args) (error (gnus-error 3 "nnselect-run: %s on %s gave error %s" func args err) [])))) @@ -968,7 +968,6 @@ Pass NO-PARSE on to the search engine." (gnus-group-make-search-group no-parse spec))) -;; The end. (provide 'nnselect) ;;; nnselect.el ends here diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 1eb604d6754..615a3c931bf 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -233,7 +233,7 @@ server there that you can connect to. See also (const :format "" "password") (string :format "Password: %v"))))))) -(make-obsolete 'nntp-authinfo-file nil "Emacs 24.1") +(make-obsolete 'nntp-authinfo-file nil "24.1") @@ -1697,7 +1697,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 +1725,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 b3b701e4126..03a0ff296f2 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -362,9 +362,9 @@ It is computed from the marks of individual component groups.") (dolist (group nnvirtual-component-groups) (setq unexpired (nconc unexpired (mapcar - #'(lambda (article) - (nnvirtual-reverse-map-article - group article)) + (lambda (article) + (nnvirtual-reverse-map-article + group article)) (gnus-uncompress-range (gnus-group-expire-articles-1 group)))))) (sort (delq nil unexpired) #'<))) diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el index d3ed3600ad9..51408618904 100644 --- a/lisp/gnus/score-mode.el +++ b/lisp/gnus/score-mode.el @@ -83,12 +83,12 @@ This mode is an extended emacs-lisp mode. (defun gnus-score-edit-insert-date () "Insert date in numerical format." - (interactive) + (interactive nil gnus-score-mode) (princ (time-to-days nil) (current-buffer))) (defun gnus-score-pretty-print () "Format the current score file." - (interactive) + (interactive nil gnus-score-mode) (goto-char (point-min)) (let ((form (read (current-buffer)))) (erase-buffer) @@ -98,7 +98,7 @@ This mode is an extended emacs-lisp mode. (defun gnus-score-edit-exit () "Stop editing the score file." - (interactive) + (interactive nil gnus-score-mode) (unless (file-exists-p (file-name-directory (buffer-file-name))) (make-directory (file-name-directory (buffer-file-name)) t)) (let ((coding-system-for-write score-mode-coding-system)) diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index 3ee59479cf5..32283af52bf 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -242,7 +242,7 @@ interactively. If there's no argument, do it at the current buffer." (defun smiley-toggle-buffer (&optional arg) "Toggle displaying smiley faces in article buffer. With arg, turn displaying on if and only if arg is positive." - (interactive "P") + (interactive "P" gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer (if (if (numberp arg) (> arg 0) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 8900be5e4f1..e9f703e90c6 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -42,7 +42,7 @@ ;; reflect this. ;; ;; The home of this file is in Gnus, but also available from -;; http://josefsson.org/smime.html. +;; https://josefsson.org/smime.html. ;;; Quick introduction: @@ -672,7 +672,7 @@ The following commands are available: (defun smime-exit () "Quit the S/MIME buffer." - (interactive) + (interactive nil smime-mode) (kill-buffer (current-buffer))) ;; Other functions diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index d87a6c2af0d..5fa280ea058 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -120,7 +120,8 @@ submitted at once. Internal variable.") (defun spam-report-gmane-ham (&rest articles) "Report ARTICLES as ham (unregister) through Gmane." - (interactive (gnus-summary-work-articles current-prefix-arg)) + (interactive (gnus-summary-work-articles current-prefix-arg) + gnus-summary-mode) (let ((count 0)) (dolist (article articles) (setq count (1+ count)) @@ -130,7 +131,8 @@ submitted at once. Internal variable.") (defun spam-report-gmane-spam (&rest articles) "Report ARTICLES as spam through Gmane." - (interactive (gnus-summary-work-articles current-prefix-arg)) + (interactive (gnus-summary-work-articles current-prefix-arg) + gnus-summary-mode) (let ((count 0)) (dolist (article articles) (setq count (1+ count)) @@ -157,7 +159,7 @@ submitted at once. Internal variable.") rpt-host (concat "/" - (replace-regexp-in-string + (string-replace "/" ":" (replace-regexp-in-string "^.*article.gmane.org/" "" @@ -222,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 @@ -376,4 +378,4 @@ Process queued spam reports." (provide 'spam-report) -;;; spam-report.el ends here. +;;; spam-report.el ends here diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 70753cad9ca..ab9be0da890 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -492,7 +492,7 @@ Add user supplied modifications if supplied." (let* ((probs (mapcar #'cadr spam-stat-score-data)) (prod (apply #'* probs)) (score0 - (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x)) + (/ prod (+ prod (apply #'* (mapcar (lambda (x) (- 1 x)) probs))))) (score1s (condition-case nil @@ -575,7 +575,6 @@ check the variable `spam-stat-score-data'." (defun spam-stat-count () "Return size of `spam-stat'." - (interactive) (hash-table-count spam-stat)) (defun spam-stat-test-directory (dir &optional verbose) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index f7288c98f6f..3f978918b9a 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -710,16 +710,8 @@ 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." - (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))) + (declare (obsolete seq-difference "28.1")) + (seq-difference list1 list2 #'eq)) (defun spam-group-ham-mark-p (group mark &optional spam) "Checks if MARK is considered a ham mark in GROUP." @@ -1327,7 +1319,7 @@ In the case of mover backends, checks the setting of (new-articles (spam-list-articles gnus-newsgroup-articles classification)) - (changed-articles (spam-set-difference new-articles old-articles))) + (changed-articles (seq-difference new-articles old-articles #'eq))) ;; now that we have the changed articles, we go through the processors (dolist (backend (spam-backend-list)) (let (unregister-list) @@ -1604,7 +1596,6 @@ parameters. A string as a parameter will set the `spam-split-group' to that string. See the Info node `(gnus)Fancy Mail Splitting' for more details." - (interactive) (setq spam-split-last-successful-check nil) (unless spam-split-disabled (let ((spam-split-group-choice spam-split-group)) @@ -1654,7 +1645,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun spam-find-spam () "Detect spam in the current newsgroup using `spam-split'." - (interactive) + (interactive nil gnus-summary-mode) (let* ((group gnus-newsgroup-name) (autodetect (gnus-parameter-spam-autodetect group)) @@ -2434,7 +2425,7 @@ With a non-nil REMOVE, remove the ADDRESSES." ;; return something sensible if the score can't be determined (defun spam-bogofilter-score (&optional recheck) "Get the Bogofilter spamicity score." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) @@ -2606,7 +2597,7 @@ With a non-nil REMOVE, remove the ADDRESSES." ;; return something sensible if the score can't be determined (defun spam-spamassassin-score (&optional recheck) "Get the SpamAssassin score." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) @@ -2673,7 +2664,7 @@ With a non-nil REMOVE, remove the ADDRESSES." ;; return something sensible if the score can't be determined (defun spam-bsfilter-score (&optional recheck) "Get the Bsfilter spamicity score." - (interactive "P") + (interactive "P" gnus-summary-mode) (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) @@ -2759,7 +2750,7 @@ With a non-nil REMOVE, remove the ADDRESSES." ;; return something sensible if the score can't be determined (defun spam-crm114-score () "Get the CRM114 Mailfilter pR." - (interactive) + (interactive nil gnus-summary-mode) (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) |