diff options
Diffstat (limited to 'lisp/gnus')
73 files changed, 3200 insertions, 3423 deletions
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index d2edfdf09f4..41fc2d83ac3 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -223,6 +223,7 @@ (defconst gnus-outlook-deuglify-version "1.5 Gnus version" "Version of gnus-outlook-deuglify.") +(make-obsolete-variable 'gnus-outlook-deuglify-version 'emacs-version "29.1") ;;; User Customizable Variables: @@ -439,6 +440,7 @@ If NODISPLAY is non-nil, don't redisplay the article buffer." (unless nodisplay (gnus-outlook-display-article-buffer)) attrib-start)) +;;;###autoload (defun gnus-article-outlook-rearrange-citation (&optional nodisplay) "Repair broken citations. If NODISPLAY is non-nil, don't redisplay the article buffer." diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index e93ebb0cd38..fc18d8a1c51 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -134,47 +134,8 @@ ARGS are passed to `message'." (const :tag "No map") (plist :inline t :tag "Properties")))) -(define-widget 'gmm-tool-bar-zap-list 'lazy - "Tool bar zap list." - :tag "Tool bar zap list" - :type '(choice (const :tag "Zap all" t) - (const :tag "Keep all" nil) - (list - ;; :value - ;; Work around (bug in customize?), see - ;; <news:v9is48jrj1.fsf@marauder.physik.uni-ulm.de> - ;; (new-file open-file dired kill-buffer write-file - ;; print-buffer customize help) - (set :inline t - (const new-file) - (const open-file) - (const dired) - (const kill-buffer) - (const save-buffer) - (const write-file) - (const undo) - (const cut) - (const copy) - (const paste) - (const search-forward) - (const print-buffer) - (const customize) - (const help)) - (repeat :inline t - :tag "Other" - (symbol :tag "Icon item"))))) - -(defcustom gmm-tool-bar-style - (if (and (boundp 'tool-bar-mode) - tool-bar-mode - (not (memq (display-visual-class) - (list 'static-gray 'gray-scale - 'static-color 'pseudo-color)))) - 'gnome - 'retro) - "Preferred tool bar style." - :type '(choice (const :tag "GNOME style" gnome) - (const :tag "Retro look" retro))) +(defvar gmm-tool-bar-style 'gnome) +(make-obsolete-variable 'gmm-tool-bar-style nil "29.1") (defvar tool-bar-map) @@ -239,6 +200,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST." "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." + (declare (indent defun)) (let ((defined-p (fboundp function))) (if defined-p `(defalias ',name ',function) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 86a4f80483d..e1c7bcb467d 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -31,6 +31,7 @@ (require 'gnus-srvr) (require 'gnus-util) (require 'timer) +(require 'range) (eval-when-compile (require 'cl-lib)) (autoload 'gnus-server-update-server "gnus-srvr") @@ -475,17 +476,16 @@ manipulated as follows: (gnus-run-hooks 'gnus-agent-mode-hook (intern (format "gnus-agent-%s-mode-hook" buffer))))) -(defvar gnus-agent-group-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-group-mode-map - "Ju" gnus-agent-fetch-groups - "Jc" gnus-enter-category-buffer - "Jj" gnus-agent-toggle-plugged - "Js" gnus-agent-fetch-session - "JY" gnus-agent-synchronize-flags - "JS" gnus-group-send-queue - "Ja" gnus-agent-add-group - "Jr" gnus-agent-remove-group - "Jo" gnus-agent-toggle-group-plugged) +(defvar-keymap gnus-agent-group-mode-map + "J u" #'gnus-agent-fetch-groups + "J c" #'gnus-enter-category-buffer + "J j" #'gnus-agent-toggle-plugged + "J s" #'gnus-agent-fetch-session + "J Y" #'gnus-agent-synchronize-flags + "J S" #'gnus-group-send-queue + "J a" #'gnus-agent-add-group + "J r" #'gnus-agent-remove-group + "J o" #'gnus-agent-toggle-group-plugged) (defun gnus-agent-group-make-menu-bar () (unless (boundp 'gnus-agent-group-menu) @@ -504,16 +504,15 @@ manipulated as follows: ["Synchronize flags" gnus-agent-synchronize-flags t] )))) -(defvar gnus-agent-summary-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-summary-mode-map - "Jj" gnus-agent-toggle-plugged - "Ju" gnus-agent-summary-fetch-group - "JS" gnus-agent-fetch-group - "Js" gnus-agent-summary-fetch-series - "J#" gnus-agent-mark-article - "J\M-#" gnus-agent-unmark-article - "@" gnus-agent-toggle-mark - "Jc" gnus-agent-catchup) +(defvar-keymap gnus-agent-summary-mode-map + "J j" #'gnus-agent-toggle-plugged + "J u" #'gnus-agent-summary-fetch-group + "J S" #'gnus-agent-fetch-group + "J s" #'gnus-agent-summary-fetch-series + "J #" #'gnus-agent-mark-article + "J M-#" #'gnus-agent-unmark-article + "@" #'gnus-agent-toggle-mark + "J c" #'gnus-agent-catchup) (defun gnus-agent-summary-make-menu-bar () (unless (boundp 'gnus-agent-summary-menu) @@ -527,11 +526,10 @@ manipulated as follows: ["Fetch downloadable" gnus-agent-summary-fetch-group t] ["Catchup undownloaded" gnus-agent-catchup t])))) -(defvar gnus-agent-server-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-server-mode-map - "Jj" gnus-agent-toggle-plugged - "Ja" gnus-agent-add-server - "Jr" gnus-agent-remove-server) +(defvar-keymap gnus-agent-server-mode-map + "J j" #'gnus-agent-toggle-plugged + "J a" #'gnus-agent-add-server + "J r" #'gnus-agent-remove-server) (defun gnus-agent-server-make-menu-bar () (unless (boundp 'gnus-agent-server-menu) @@ -1222,8 +1220,8 @@ This can be added to `gnus-select-article-hook' or (cond ((eq mark 'read) (setf (gnus-info-read info) (funcall (if (eq what 'add) - #'gnus-range-add - #'gnus-remove-from-range) + #'range-concat + #'range-remove) (gnus-info-read info) range)) (gnus-get-unread-articles-in-group @@ -1236,8 +1234,8 @@ This can be added to `gnus-select-article-hook' or (gnus-info-marks info))) (setcdr info-marks (funcall (if (eq what 'add) - #'gnus-range-add - #'gnus-remove-from-range) + #'range-concat + #'range-remove) (cdr info-marks) range)))))))) @@ -1310,7 +1308,7 @@ downloaded into the agent." (let ((read (gnus-info-read info))) (setf (gnus-info-read info) - (gnus-range-add + (range-concat read (list (cons (1+ agent-max) (1- active-min)))))) @@ -1683,7 +1681,7 @@ and that there are no duplicates." (gnus-message 1 "Overview buffer contains garbage `%s'." (buffer-substring - p (point-at-eol)))) + p (line-end-position)))) ((= cur prev-num) (or backed-up (setq backed-up (gnus-agent-backup-overview-buffer))) @@ -1799,13 +1797,13 @@ article numbers will be returned." (articles (if fetch-all (if gnus-newsgroup-maximum-articles (let ((active (gnus-active group))) - (gnus-uncompress-range + (range-uncompress (cons (max (car active) (- (cdr active) gnus-newsgroup-maximum-articles -1)) (cdr active)))) - (gnus-uncompress-range (gnus-active group))) + (range-uncompress (gnus-active group))) (gnus-list-of-unread-articles group))) (gnus-decode-encoded-word-function 'identity) (gnus-decode-encoded-address-function 'identity) @@ -1820,7 +1818,7 @@ article numbers will be returned." ;; because otherwise the agent will remove their marks.) (dolist (arts (gnus-info-marks (gnus-get-info group))) (unless (memq (car arts) '(seen recent killed cache)) - (setq articles (gnus-range-add articles (cdr arts))))) + (setq articles (range-concat articles (cdr arts))))) (setq articles (sort (gnus-uncompress-sequence articles) #'<))) ;; At this point, I have the list of articles to consider for @@ -1854,15 +1852,15 @@ article numbers will be returned." ;; gnus-agent-article-alist) equals (cdr (gnus-active ;; group))}. The addition of one(the 1+ above) then ;; forces Low to be greater than High. When this happens, - ;; gnus-list-range-intersection returns nil which + ;; range-list-intersection returns nil which ;; indicates that no headers need to be fetched. -- Kevin - (setq articles (gnus-list-range-intersection + (setq articles (range-list-intersection articles (list (cons low high))))))) (when articles (gnus-message 10 "gnus-agent-fetch-headers: undownloaded articles are `%s'" - (gnus-compress-sequence articles t))) + (range-compress-list articles))) (with-current-buffer nntp-server-buffer (if articles @@ -2063,7 +2061,7 @@ doesn't exist, to valid the overview buffer." (let (state sequence uncomp) (while alist (setq state (caar alist) - sequence (inline (gnus-uncompress-range (cdar alist))) + sequence (inline (range-uncompress (cdar alist))) alist (cdr alist)) (while sequence (push (cons (pop sequence) state) uncomp))) @@ -2407,7 +2405,7 @@ contents, they are first saved to their own file." (let ((arts (cdr (assq mark (gnus-info-marks (setq info (gnus-get-info group))))))) (when arts - (setq marked-articles (nconc (gnus-uncompress-range arts) + (setq marked-articles (nconc (range-uncompress arts) marked-articles)) )))) (setq marked-articles (sort marked-articles #'<)) @@ -2547,7 +2545,7 @@ contents, they are first saved to their own file." (let ((read (gnus-info-read (or info (setq info (gnus-get-info group)))))) (setf (gnus-info-read info) - (gnus-add-to-range read unfetched-articles))) + (range-add-list read unfetched-articles))) (gnus-group-update-group group t) (sit-for 0) @@ -2597,25 +2595,20 @@ General format specifiers can also be used. See Info node (defvar gnus-category-line-format-spec nil) (defvar gnus-category-mode-line-format-spec nil) -(defvar gnus-category-mode-map nil) - -(unless gnus-category-mode-map - (setq gnus-category-mode-map (make-sparse-keymap)) - (suppress-keymap gnus-category-mode-map) - - (gnus-define-keys gnus-category-mode-map - "q" gnus-category-exit - "k" gnus-category-kill - "c" gnus-category-copy - "a" gnus-category-add - "e" gnus-agent-customize-category - "p" gnus-category-edit-predicate - "g" gnus-category-edit-groups - "s" gnus-category-edit-score - "l" gnus-category-list - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) +(defvar-keymap gnus-category-mode-map + :suppress t + "q" #'gnus-category-exit + "k" #'gnus-category-kill + "c" #'gnus-category-copy + "a" #'gnus-category-add + "e" #'gnus-agent-customize-category + "p" #'gnus-category-edit-predicate + "g" #'gnus-category-edit-groups + "s" #'gnus-category-edit-score + "l" #'gnus-category-list + + "C-c C-i" #'gnus-info-find-node + "C-c C-b" #'gnus-bug) (defcustom gnus-category-menu-hook nil "Hook run after the creation of the menu." @@ -2694,7 +2687,7 @@ The following commands are available: (gnus-category-position-point))) (defun gnus-category-name () - (or (intern (get-text-property (point-at-bol) 'gnus-category)) + (or (intern (get-text-property (line-beginning-position) 'gnus-category)) (error "No category on the current line"))) (defun gnus-category-read () @@ -2906,8 +2899,8 @@ The following commands are available: (defun gnus-agent-read-p () "Say whether an article is read or not." - (gnus-member-of-range (mail-header-number gnus-headers) - (gnus-info-read (gnus-get-info gnus-newsgroup-name)))) + (range-member-p (mail-header-number gnus-headers) + (gnus-info-read (gnus-get-info gnus-newsgroup-name)))) (defun gnus-category-make-function (predicate) "Make a function from PREDICATE." @@ -3123,7 +3116,7 @@ FORCE is equivalent to setting the expiration predicates to true." ;; All articles EXCEPT those named by the caller ;; are protected from expiration (gnus-sorted-difference - (gnus-uncompress-range + (range-uncompress (cons (caar alist) (caar (last alist)))) (sort articles #'<))))) @@ -3145,9 +3138,9 @@ FORCE is equivalent to setting the expiration predicates to true." ;; Ticked and/or dormant articles are excluded ;; from expiration (nconc - (gnus-uncompress-range + (range-uncompress (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range + (range-uncompress (cdr (assq 'dormant (gnus-info-marks info)))))))) (nov-file (concat dir ".overview")) @@ -3370,7 +3363,7 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) (cl-incf nov-entries-deleted) - (let* ((from (point-at-bol)) + (let* ((from (line-beginning-position)) (to (progn (forward-line 1) (point))) (freed (- to from))) (cl-incf bytes-freed freed) @@ -3646,7 +3639,7 @@ has been fetched." (file-name-directory file) t)) (when fetch-old - (setq articles (gnus-uncompress-range + (setq articles (range-uncompress (cons (if (numberp fetch-old) (max 1 (- (car articles) fetch-old)) 1) @@ -3702,7 +3695,7 @@ has been fetched." ;; Clip this list to the headers that will ;; actually be returned - (setq fetched-articles (gnus-list-range-intersection + (setq fetched-articles (range-list-intersection (cdr fetched-articles) (cons min max))) @@ -3711,7 +3704,7 @@ has been fetched." ;; excluded IDs may be fetchable using HEAD. (if (car tail-fetched-articles) (setq uncached-articles - (gnus-list-range-intersection + (range-list-intersection uncached-articles (cons (car uncached-articles) (car tail-fetched-articles))))) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 5b5343f5bcd..83ba72c091f 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -42,6 +42,7 @@ (require 'message) (require 'mouse) (require 'seq) +(require 'range) (autoload 'gnus-msg-mail "gnus-msg" nil t) (autoload 'gnus-button-mailto "gnus-msg") @@ -267,7 +268,7 @@ This can also be a list of the above values." (defcustom gnus-hidden-properties ;; We use to have `intangible' here as well, but Emacs's command loop moves ;; point out of invisible text anyway, so `intangible' is clearly not - ;; needed there. And XEmacs doesn't handle `intangible' anyway. + ;; needed there. '(invisible t) "Property list to use for hiding text." :type 'plist @@ -742,7 +743,7 @@ Each element is a regular expression." "Face used for highlighting buttons in the article buffer. An article button is a piece of text that you can activate by pressing -`RET' or `mouse-2' above it." +\\`RET' or `mouse-2' above it." :type 'face :group 'gnus-article-buttons) @@ -768,28 +769,37 @@ Obsolete; use the face `gnus-signature' for customizations instead." :group 'gnus-article-highlight :group 'gnus-article-signature) +(defface gnus-header + '((t :inherit variable-pitch-text)) + "Base face used for all Gnus header faces. +All the other `gnus-header-' faces inherit from this face." + :version "29.1" + :group 'gnus-article-headers + :group 'gnus-article-highlight) + (defface gnus-header-from '((((class color) (background dark)) - (:foreground "PaleGreen1")) + (:foreground "PaleGreen1" :inherit gnus-header)) (((class color) (background light)) - (:foreground "red3")) + (:foreground "red3" :inherit gnus-header)) (t - (:italic t))) + (:italic t :inherit gnus-header))) "Face used for displaying from headers." + :version "29.1" :group 'gnus-article-headers :group 'gnus-article-highlight) (defface gnus-header-subject '((((class color) (background dark)) - (:foreground "SeaGreen1")) + (:foreground "SeaGreen1" :inherit gnus-header)) (((class color) (background light)) - (:foreground "red4")) + (:foreground "red4" :inherit gnus-header)) (t - (:bold t :italic t))) + (:bold t :italic t :inherit gnus-header))) "Face used for displaying subject headers." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -797,7 +807,7 @@ Obsolete; use the face `gnus-signature' for customizations instead." (defface gnus-header-newsgroups '((((class color) (background dark)) - (:foreground "yellow" :italic t)) + (:foreground "yellow" :italic t :inherit gnus-header)) (((class color) (background light)) (:foreground "MidnightBlue" :italic t)) @@ -812,12 +822,12 @@ articles." (defface gnus-header-name '((((class color) (background dark)) - (:foreground "SpringGreen2")) + (:foreground "SpringGreen2" :inherit gnus-header)) (((class color) (background light)) - (:foreground "maroon")) + (:foreground "maroon" :inherit gnus-header)) (t - (:bold t))) + (:bold t :inherit gnus-header))) "Face used for displaying header names." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -825,12 +835,13 @@ articles." (defface gnus-header-content '((((class color) (background dark)) - (:foreground "SpringGreen1" :italic t)) + (:foreground "SpringGreen1" :italic t :inherit gnus-header)) (((class color) (background light)) - (:foreground "indianred4" :italic t)) + (:foreground "indianred4" :italic t :inherit gnus-header)) (t - (:italic t))) "Face used for displaying header content." + (:italic t :inherit gnus-header))) + "Face used for displaying header content." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -1080,9 +1091,9 @@ positive (negative), move point forward (backwards) this many parts. When nil, redisplay article." :version "23.1" ;; No Gnus :group 'gnus-article-mime - :type '(choice (const nil :tag "Redisplay article.") - (const 1 :tag "Next part.") - (const 0 :tag "Current part.") + :type '(choice (const :value nil :tag "Redisplay article") + (const :value 1 :tag "Next part") + (const :value 0 :tag "Current part") integer)) ;;; @@ -1149,13 +1160,15 @@ predicate. See Info node `(gnus)Customizing Articles'." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) -(defcustom gnus-treat-emphasize 50000 +(defcustom gnus-treat-emphasize '(and 50000 + (not (typep "text/html"))) "Emphasize text. Valid values are nil, t, `head', `first', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) + :type gnus-article-treat-custom + :version "29.1") (put 'gnus-treat-emphasize 'highlight t) (defcustom gnus-treat-strip-cr nil @@ -1167,6 +1180,19 @@ predicate. See Info node `(gnus)Customizing Articles'." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) +(defcustom gnus-treat-emojize-symbols nil + "Display emoji versions of symbol. +Some symbols have both a non-emoji presentation and an emoji +presentation. This treatment will make Gnus display the latter +as emojis even when they weren't sent as such. + +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." + :version "29.1" + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + (defcustom gnus-treat-unsplit-urls nil "Remove newlines from within URLs. Valid values are nil, t, `head', `first', `last', an integer or a @@ -1360,11 +1386,20 @@ This variable has no effect if `gnus-treat-unfold-headers' is nil." (const :tag "all" t) (regexp))) -(defcustom gnus-treat-fold-headers nil +(defcustom gnus-treat-fold-headers 'head "Fold headers. Valid values are nil, t, `head', `first', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles'." - :version "22.1" + :version "29.1" + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + +(defcustom gnus-treat-suspicious-headers 'head + "Mark headers that are suspicious. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." + :version "29.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1650,6 +1685,7 @@ regexp." (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist '((gnus-treat-strip-cr gnus-article-remove-cr) + (gnus-treat-emojize-symbols gnus-article-emojize-symbols) (gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig) (gnus-treat-strip-banner gnus-article-strip-banner) (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body) @@ -1685,6 +1721,7 @@ regexp." (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) (gnus-treat-fold-headers gnus-article-treat-fold-headers) + (gnus-treat-suspicious-headers gnus-article-treat-suspicious-headers) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) (gnus-treat-display-smileys gnus-treat-smiley) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) @@ -1893,7 +1930,7 @@ always hide." (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) (forward-line -1) (gnus-article-hide-text-type - (point-at-bol) + (line-beginning-position) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -1902,8 +1939,8 @@ always hide." 'boring-headers))) ;; Hide boring Newsgroups header. ((eq elem 'newsgroups) - (when (gnus-string-equal - (gnus-fetch-field "newsgroups") + (when (string-equal-ignore-case + (or (gnus-fetch-field "newsgroups") "") (gnus-group-real-name (if (boundp 'gnus-newsgroup-name) gnus-newsgroup-name @@ -1917,7 +1954,7 @@ always hide." gnus-newsgroup-name "")))) (when (and to to-address (ignore-errors - (gnus-string-equal + (string-equal-ignore-case ;; only one address in To (nth 1 (mail-extract-address-components to)) to-address))) @@ -1930,7 +1967,7 @@ always hide." gnus-newsgroup-name "")))) (when (and to to-list (ignore-errors - (gnus-string-equal + (string-equal-ignore-case ;; only one address in To (nth 1 (mail-extract-address-components to)) to-list))) @@ -1943,15 +1980,15 @@ always hide." gnus-newsgroup-name "")))) (when (and cc to-list (ignore-errors - (gnus-string-equal + (string-equal-ignore-case ;; only one address in Cc (nth 1 (mail-extract-address-components cc)) to-list))) (gnus-article-hide-header "cc")))) ((eq elem 'followup-to) - (when (gnus-string-equal - (message-fetch-field "followup-to") - (message-fetch-field "newsgroups")) + (when (string-equal-ignore-case + (or (message-fetch-field "followup-to") "") + (or (message-fetch-field "newsgroups") "")) (gnus-article-hide-header "followup-to"))) ((eq elem 'reply-to) (if (gnus-group-find-parameter @@ -2023,7 +2060,7 @@ always hide." (goto-char (point-min)) (when (re-search-forward (concat "^" header ":") nil t) (gnus-article-hide-text-type - (point-at-bol) + (line-beginning-position) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -2044,7 +2081,7 @@ always hide." (article-narrow-to-head) (while (not (eobp)) (cond - ((< (setq column (- (point-at-eol) (point))) + ((< (setq column (- (line-end-position) (point))) gnus-article-normalized-header-length) (end-of-line) (insert (make-string @@ -2055,7 +2092,7 @@ always hide." (progn (forward-char gnus-article-normalized-header-length) (point)) - (point-at-eol) + (line-end-position) 'invisible t)) (t ;; Do nothing. @@ -2188,6 +2225,14 @@ unfolded." (replace-match " " t t)))) (goto-char (point-max))))))) +(defun gnus--variable-pitch-p (face) + (when face + (or (eq face 'variable-pitch) + (let ((parent (face-attribute face :inherit))) + (if (eq parent 'unspecified) + nil + (seq-some #'gnus--variable-pitch-p (ensure-list parent))))))) + (defun gnus-article-treat-fold-headers () "Fold message headers." (interactive nil gnus-article-mode gnus-summary-mode) @@ -2195,9 +2240,26 @@ unfolded." (while (not (eobp)) (save-restriction (mail-header-narrow-to-field) - (mail-header-fold-field) + (if (not (gnus--variable-pitch-p (get-text-property (point) 'face))) + (mail-header-fold-field) + (forward-char 1) + (pixel-fill-region (point) (point-max) (pixel-fill-width))) (goto-char (point-max)))))) +(defun gnus-article-treat-suspicious-headers () + "Mark suspicious headers." + (interactive nil gnus-article-mode gnus-summary-mode) + (gnus-with-article-headers + (let (match) + (while (setq match (text-property-search-forward 'textsec-suspicious)) + (add-text-properties (prop-match-beginning match) + (prop-match-end match) + (list 'help-echo (prop-match-value match) + 'face 'textsec-suspicious)) + (overlay-put (make-overlay (prop-match-end match) + (prop-match-end match)) + 'after-string "⚠️"))))) + (defun gnus-treat-smiley () "Toggle display of textual emoticons (\"smileys\") as small graphical icons." (interactive nil gnus-article-mode gnus-summary-mode) @@ -2264,9 +2326,7 @@ This only works if the article in question is HTML." (goto-char (point-max)))))) (defcustom gnus-article-truncate-lines (default-value 'truncate-lines) - "Value of `truncate-lines' in Gnus Article buffer. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." + "Value of `truncate-lines' in Gnus Article buffer." :version "23.1" ;; No Gnus :group 'gnus-article ;; :link '(custom-manual "(gnus)Customizing Articles") @@ -2329,7 +2389,7 @@ fill width." (end-of-line) (when (>= (current-column) width) (narrow-to-region (min (1+ (point)) (point-max)) - (point-at-bol)) + (line-beginning-position)) (let ((goback (point-marker)) (fill-column width)) (fill-paragraph nil) @@ -2360,6 +2420,20 @@ fill width." (while (search-forward "\r" nil t) (replace-match "\n" t t))))) +(defun article-emojize-symbols () + "Display symbols (that have an emoji version) as emojis." + (interactive nil gnus-article-mode) + (when-let ((font (and (display-multi-font-p) + (car (internal-char-font nil ?😀))))) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (while (re-search-forward "[[:multibyte:]]" nil t) + ;; If there's already a grapheme cluster here, skip it. + (when (and (not (find-composition (point))) + (font-has-char-p font (char-after (match-beginning 0)))) + (insert "\N{VARIATION SELECTOR-16}"))))))) + (defun article-remove-trailing-blank-lines () "Remove all trailing blank lines from the article." (interactive nil gnus-article-mode) @@ -2372,7 +2446,7 @@ fill width." (while (and (not (bobp)) (looking-at "^[ \t]*$") (not (gnus-annotation-in-region-p - (point) (point-at-eol)))) + (point) (line-end-position)))) (forward-line -1)) (forward-line 1) (point)))))) @@ -2560,17 +2634,37 @@ If PROMPT (the prefix), prompt for a coding system to use." (forward-line -1)) (setq end (point)) (while (not (bobp)) - (while (progn - (forward-line -1) - (and (not (bobp)) - (memq (char-after) '(?\t ? ))))) - (setq start (point)) - (if (looking-at "\ + (let (addresses) + (while (progn + (forward-line -1) + (and (not (bobp)) + (memq (char-after) '(?\t ? ))))) + (setq start (point)) + (save-restriction + (narrow-to-region start end) + (if (looking-at "\ \\(?:Resent-\\)?\\(?:From\\|Cc\\|To\\|Bcc\\|\\(?:In-\\)?Reply-To\\|Sender\ \\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\):") - (funcall gnus-decode-address-function start end) - (funcall gnus-decode-header-function start end)) - (goto-char (setq end start))))) + (progn + (setq addresses (buffer-string)) + (funcall gnus-decode-address-function (point-min) (point-max))) + (funcall gnus-decode-header-function (point-min) (point-max)))) + (when addresses + (article--check-suspicious-addresses addresses)) + (goto-char (point-max)) + (goto-char (setq end start)))))) + +(defun article--check-suspicious-addresses (addresses) + (setq addresses (replace-regexp-in-string "\\`[^:]+:[ \t\n]*" "" addresses)) + (dolist (header (mail-header-parse-addresses addresses t)) + (when-let* ((address (car (ignore-errors + (mail-header-parse-address header)))) + (warning (and (string-match "@" address) + (textsec-suspicious-p address 'email-address)))) + (goto-char (point-min)) + (while (search-forward address nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'textsec-suspicious warning))))) (defun article-decode-group-name () "Decode group names in Newsgroups, Followup-To and Xref headers." @@ -3489,9 +3583,10 @@ possible values." 'original-date) bface (get-text-property (match-beginning 0) 'face) eface (get-text-property (match-end 0) 'face)) - (delete-region (point-at-bol) (progn - (gnus-article-forward-header) - (point))))) + (delete-region (line-beginning-position) + (progn + (gnus-article-forward-header) + (point))))) (when (and (not date) visible-date) (setq date visible-date)) @@ -3933,8 +4028,8 @@ This format is defined by the `gnus-article-time-format' variable." ;; No split name was found. ((null split-name) (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) "): ") + (format-prompt prompt + (file-name-nondirectory default-name)) (file-name-directory default-name) default-name)) ;; A single group name is returned. @@ -3943,8 +4038,8 @@ This format is defined by the `gnus-article-time-format' variable." (funcall function split-name headers (symbol-value variable))) (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) "): ") + (format-prompt prompt + (file-name-nondirectory default-name)) (file-name-directory default-name) default-name)) ;; A single split name was found @@ -3956,9 +4051,8 @@ This format is defined by the `gnus-article-time-format' variable." (file-name-as-directory name)) ((file-exists-p name) name) (t gnus-article-save-directory)))) - (read-file-name - (concat prompt " (default " name "): ") - dir name))) + (read-file-name (format-prompt prompt name) + dir name))) ;; A list of splits was found. (t (setq split-name (nreverse split-name)) @@ -4295,8 +4389,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (message-narrow-to-head) (goto-char (point-max)) (forward-line -1) - (setq bface (get-text-property (point-at-bol) 'face) - eface (get-text-property (1- (point-at-eol)) 'face)) + (setq bface (get-text-property (line-beginning-position) 'face) + eface (get-text-property (1- (line-end-position)) 'face)) (message-remove-header "X-Gnus-PGP-Verify") (if (re-search-forward "^X-PGP-Sig:" nil t) (forward-line) @@ -4342,6 +4436,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-fill-long-lines article-capitalize-sentences article-remove-cr + article-emojize-symbols article-remove-leading-whitespace article-display-x-face article-display-face @@ -4387,44 +4482,44 @@ If variable `gnus-use-long-file-name' is non-nil, it is ;;; Gnus article mode ;;; -(set-keymap-parent gnus-article-mode-map button-buffer-map) - -(gnus-define-keys gnus-article-mode-map - " " gnus-article-goto-next-page - [?\S-\ ] gnus-article-goto-prev-page - "\177" gnus-article-goto-prev-page - [delete] gnus-article-goto-prev-page - "\C-c^" gnus-article-refer-article - "h" gnus-article-show-summary - "s" gnus-article-show-summary - "\C-c\C-m" gnus-article-mail - "?" gnus-article-describe-briefly - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug - "R" gnus-article-reply-with-original - "F" gnus-article-followup-with-original - "\C-hk" gnus-article-describe-key - "\C-hc" gnus-article-describe-key-briefly - "\C-hb" gnus-article-describe-bindings - - "e" gnus-article-read-summary-keys - "\C-d" gnus-article-read-summary-keys - "\C-c\C-f" gnus-summary-mail-forward - "\M-*" gnus-article-read-summary-keys - "\M-#" gnus-article-read-summary-keys - "\M-^" gnus-article-read-summary-keys - "\M-g" gnus-article-read-summary-keys) +(defvar gnus-article-send-map nil) + +(define-keymap :keymap gnus-article-mode-map :suppress t + :parent button-buffer-map + "SPC" #'gnus-article-goto-next-page + "S-SPC" #'gnus-article-goto-prev-page + "DEL" #'gnus-article-goto-prev-page + "<delete>" #'gnus-article-goto-prev-page + "C-c ^" #'gnus-article-refer-article + "h" #'gnus-article-show-summary + "s" #'gnus-article-show-summary + "C-c C-m" #'gnus-article-mail + "?" #'gnus-article-describe-briefly + "<" #'beginning-of-buffer + ">" #'end-of-buffer + "C-c C-i" #'gnus-info-find-node + "C-c C-b" #'gnus-bug + "R" #'gnus-article-reply-with-original + "F" #'gnus-article-followup-with-original + "C-h k" #'gnus-article-describe-key + "C-h c" #'gnus-article-describe-key-briefly + "C-h b" #'gnus-article-describe-bindings + + "e" #'gnus-article-read-summary-keys + "C-d" #'gnus-article-read-summary-keys + "C-c C-f" #'gnus-summary-mail-forward + "M-*" #'gnus-article-read-summary-keys + "M-#" #'gnus-article-read-summary-keys + "M-^" #'gnus-article-read-summary-keys + "M-g" #'gnus-article-read-summary-keys + + "S" (define-keymap :prefix 'gnus-article-send-map + "W" #'gnus-article-wide-reply-with-original + "<t>" #'gnus-article-read-summary-send-keys)) (substitute-key-definition #'undefined #'gnus-article-read-summary-keys gnus-article-mode-map) -(defvar gnus-article-send-map) -(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) - "W" gnus-article-wide-reply-with-original - [t] gnus-article-read-summary-send-keys) - (defun gnus-article-make-menu-bar () (unless (boundp 'gnus-article-commands-menu) (gnus-summary-make-menu-bar)) @@ -4449,6 +4544,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Treat overstrike" gnus-article-treat-overstrike t] ["Treat ANSI sequences" gnus-article-treat-ansi-sequences t] ["Remove carriage return" gnus-article-remove-cr t] + ["Emojize Symbols" gnus-article-emojize-symbols t] ["Remove leading whitespace" gnus-article-remove-leading-whitespace t] ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] ["Remove base64" gnus-article-de-base64-unreadable t] @@ -4509,7 +4605,8 @@ commands: (setq show-trailing-whitespace nil) ;; Arrange a callback from `mm-inline-message' if we're ;; displaying a message/rfc822 part. - (setq-local mm-inline-message-prepare-function #'gnus-mime--inline-message) + (setq-local mm-inline-message-prepare-function + #'gnus-mime--inline-message-function) (mm-enable-multibyte)) (defun gnus-article-setup-buffer () @@ -4549,7 +4646,6 @@ commands: (let ((summary gnus-summary-buffer)) (with-current-buffer name (setq-local gnus-article-edit-mode nil) - (gnus-article-stop-animations) (when gnus-article-mime-handles (mm-destroy-parts gnus-article-mime-handles) (setq gnus-article-mime-handles nil)) @@ -4575,6 +4671,7 @@ commands: (current-buffer)))))) (defun gnus-article-stop-animations () + (declare (obsolete nil "29.1")) (cancel-function-timers 'image-animate-timeout)) (defun gnus-stop-downloads () @@ -5829,7 +5926,7 @@ all parts." ;; Go to the displayed subpart, assuming this is ;; multipart/alternative. (setq part start - end (point-at-eol)) + end (line-end-position)) (while (and (not handle) part (< part end) @@ -6033,6 +6130,34 @@ If nil, don't show those extra buttons." ((equal (car handle) "multipart/encrypted") (gnus-add-wash-type 'encrypted) (gnus-mime-display-security handle)) + ;; pkcs7-mime handling: + ;; + ;; although not really multipart these are structured internally by + ;; mm-dissect-buffer like multipart to not discard the decryption + ;; and verification results + ;; + ;; application/pkcs7-mime + ((and (equal (car handle) "application/pkcs7-mime") + (equal (mm-handle-multipart-ctl-parameter handle 'protocol) + "application/pkcs7-mime_signed-data")) + (gnus-add-wash-type 'signed) + (gnus-mime-display-security handle)) + ((and (equal (car handle) "application/pkcs7-mime") + (equal (mm-handle-multipart-ctl-parameter handle 'protocol) + "application/pkcs7-mime_enveloped-data")) + (gnus-add-wash-type 'encrypted) + (gnus-mime-display-security handle)) + ;; application/x-pkcs7-mime + ((and (equal (car handle) "application/x-pkcs7-mime") + (equal (mm-handle-multipart-ctl-parameter handle 'protocol) + "application/x-pkcs7-mime_signed-data")) + (gnus-add-wash-type 'signed) + (gnus-mime-display-security handle)) + ((and (equal (car handle) "application/x-pkcs7-mime") + (equal (mm-handle-multipart-ctl-parameter handle 'protocol) + "application/x-pkcs7-mime_enveloped-data")) + (gnus-add-wash-type 'encrypted) + (gnus-mime-display-security handle)) ;; Other multiparts are handled like multipart/mixed. (t (gnus-mime-display-mixed (cdr handle))))) @@ -6045,7 +6170,7 @@ If nil, don't show those extra buttons." (defun gnus-mime-display-mixed (handles) (mapcar #'gnus-mime-display-part handles)) -(defun gnus-mime--inline-message (handle charset) +(defun gnus-mime--inline-message-function (handle charset) (let ((handles (let (gnus-article-mime-handles ;; disable prepare hook @@ -6701,9 +6826,9 @@ not have a face in `gnus-article-boring-faces'." "Read article specified by message-id around point." (interactive nil gnus-article-mode) (save-excursion - (re-search-backward "[ \t]\\|^" (point-at-bol) t) - (re-search-forward "<?news:<?\\|<" (point-at-eol) t) - (if (re-search-forward "[^@ ]+@[^ \t>]+" (point-at-eol) t) + (re-search-backward "[ \t]\\|^" (line-beginning-position) t) + (re-search-forward "<?news:<?\\|<" (line-end-position) t) + (if (re-search-forward "[^@ ]+@[^ \t>]+" (line-end-position) t) (let ((msg-id (concat "<" (match-string 0) ">"))) (set-buffer gnus-summary-buffer) (gnus-summary-refer-article msg-id)) @@ -6938,7 +7063,7 @@ then we display only bindings that start with that prefix." (setq sumkeys (append (mapcar #'vector - (nreverse (gnus-uncompress-range def))) + (nreverse (range-uncompress def))) sumkeys)))) ((setq def (key-binding key)) (unless (eq def 'undefined) @@ -7222,50 +7347,42 @@ other groups." (defvar gnus-article-edit-done-function nil) -(defvar gnus-article-edit-mode-map nil) - -;; Should we be using derived.el for this? -(unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (make-keymap)) - (set-keymap-parent gnus-article-edit-mode-map text-mode-map) - - (gnus-define-keys gnus-article-edit-mode-map - "\C-c?" describe-mode - "\C-c\C-c" gnus-article-edit-done - "\C-c\C-k" gnus-article-edit-exit - "\C-c\C-f\C-t" message-goto-to - "\C-c\C-f\C-o" message-goto-from - "\C-c\C-f\C-b" message-goto-bcc - ;;"\C-c\C-f\C-w" message-goto-fcc - "\C-c\C-f\C-c" message-goto-cc - "\C-c\C-f\C-s" message-goto-subject - "\C-c\C-f\C-r" message-goto-reply-to - "\C-c\C-f\C-n" message-goto-newsgroups - "\C-c\C-f\C-d" message-goto-distribution - "\C-c\C-f\C-f" message-goto-followup-to - "\C-c\C-f\C-m" message-goto-mail-followup-to - "\C-c\C-f\C-k" message-goto-keywords - "\C-c\C-f\C-u" message-goto-summary - "\C-c\C-f\C-i" message-insert-or-toggle-importance - "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to - "\C-c\C-b" message-goto-body - "\C-c\C-i" message-goto-signature - - "\C-c\C-t" message-insert-to - "\C-c\C-n" message-insert-newsgroups - "\C-c\C-o" message-sort-headers - "\C-c\C-e" message-elide-region - "\C-c\C-v" message-delete-not-region - "\C-c\C-z" message-kill-to-signature - "\M-\r" message-newline-and-reformat - "\C-c\C-a" mml-attach-file - "\C-a" message-beginning-of-line - "\t" message-tab - "\M-;" comment-region) - - (gnus-define-keys (gnus-article-edit-wash-map - "\C-c\C-w" gnus-article-edit-mode-map) - "f" gnus-article-edit-full-stops)) +(defvar-keymap gnus-article-edit-mode-map + :full t :parent text-mode-map + "C-c ?" #'describe-mode + "C-c C-c" #'gnus-article-edit-done + "C-c C-k" #'gnus-article-edit-exit + "C-c C-f C-t" #'message-goto-to + "C-c C-f C-o" #'message-goto-from + "C-c C-f C-b" #'message-goto-bcc + "C-c C-f C-c" #'message-goto-cc + "C-c C-f C-s" #'message-goto-subject + "C-c C-f C-r" #'message-goto-reply-to + "C-c C-f C-n" #'message-goto-newsgroups + "C-c C-f C-d" #'message-goto-distribution + "C-c C-f C-f" #'message-goto-followup-to + "C-c C-f RET" #'message-goto-mail-followup-to + "C-c C-f C-k" #'message-goto-keywords + "C-c C-f C-u" #'message-goto-summary + "C-c C-f TAB" #'message-insert-or-toggle-importance + "C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to + "C-c C-b" #'message-goto-body + "C-c TAB" #'message-goto-signature + + "C-c C-t" #'message-insert-to + "C-c C-n" #'message-insert-newsgroups + "C-c C-o" #'message-sort-headers + "C-c C-e" #'message-elide-region + "C-c C-v" #'message-delete-not-region + "C-c C-z" #'message-kill-to-signature + "M-RET" #'message-newline-and-reformat + "C-c C-a" #'mml-attach-file + "C-a" #'message-beginning-of-line + "TAB" #'message-tab + "M-;" #'comment-region + + "C-c C-w" (define-keymap :prefix 'gnus-article-edit-wash-map + "f" #'gnus-article-edit-full-stops)) (easy-menu-define gnus-article-edit-mode-field-menu gnus-article-edit-mode-map "" @@ -7864,8 +7981,8 @@ variable is the real callback function." (function :tag "Callback") (repeat :tag "Par" :inline t - (integer :tag "Regexp group"))))) -(put 'gnus-button-alist 'risky-local-variable t) + (integer :tag "Regexp group")))) + :risky t) (defcustom gnus-header-button-alist '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>" @@ -7904,8 +8021,8 @@ HEADER is a regexp to match a header. For a fuller explanation, see (function :tag "Callback") (repeat :tag "Par" :inline t - (integer :tag "Regexp group"))))) -(put 'gnus-header-button-alist 'risky-local-variable t) + (integer :tag "Regexp group")))) + :risky t) ;;; Commands: @@ -8064,7 +8181,7 @@ url is put as the `gnus-button-url' overlay property on the button." (goto-char start) (string-match "\\(?:\"\\|\\(<\\)\\)[\t ]*\\(?:url[\t ]*:[\t ]*\\)?\\'" - (buffer-substring (point-at-bol) start))) + (buffer-substring (line-beginning-position) start))) (progn (setq url (list (buffer-substring start end)) delim (if (match-beginning 1) ">" "\"")) @@ -8354,8 +8471,6 @@ url is put as the `gnus-button-url' overlay property on the button." (when comma (dotimes (_ (with-temp-buffer (insert comma) - ;; Note: the XEmacs version of `how-many' takes - ;; no optional argument. (goto-char (point-min)) (how-many ","))) (Info-index-next 1))) @@ -8790,11 +8905,19 @@ For example: (setq point (point)) (with-current-buffer (mm-handle-multipart-original-buffer handle) (let* ((mm-verify-option 'known) - (mm-decrypt-option 'known) - (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) - (unless (eq nparts (cdr handle)) - (mm-destroy-parts (cdr handle)) - (setcdr handle nparts)))) + (mm-decrypt-option 'known) + (pkcs7-mime-p (or (equal (car handle) "application/pkcs7-mime") + (equal (car handle) "application/x-pkcs7-mime"))) + (nparts (if pkcs7-mime-p + (list (mm-possibly-verify-or-decrypt + (cadr handle) (cadadr handle))) + (mm-possibly-verify-or-decrypt (cdr handle) handle)))) + (unless (eq nparts (cdr handle)) + ;; if pkcs7-mime don't destroy the parts as the buffer in + ;; the cdr still needs to be accessible + (when (not pkcs7-mime-p) + (mm-destroy-parts (cdr handle))) + (setcdr handle nparts)))) (gnus-mime-display-security handle) (when region (delete-region (point) (cdr region)) @@ -8848,14 +8971,35 @@ For example: (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) (gnus-tmp-type (concat - (or (nth 2 (assoc protocol mm-verify-function-alist)) - (nth 2 (assoc protocol mm-decrypt-function-alist)) - "Unknown") - (if (equal (car handle) "multipart/signed") - " Signed" " Encrypted") - " Part")) - (gnus-tmp-info - (or (mm-handle-multipart-ctl-parameter handle 'gnus-info) + (or (nth 2 (assoc protocol mm-verify-function-alist)) + (nth 2 (assoc protocol mm-decrypt-function-alist)) + "Unknown") + (cond ((equal (car handle) "multipart/signed") " Signed") + ((equal (car handle) "multipart/encrypted") " Encrypted") + ((and (equal (car handle) "application/pkcs7-mime") + (equal + (mm-handle-multipart-ctl-parameter handle 'protocol) + "application/pkcs7-mime_signed-data")) + " Signed") + ((and (equal (car handle) "application/pkcs7-mime") + (equal + (mm-handle-multipart-ctl-parameter handle 'protocol) + "application/pkcs7-mime_enveloped-data")) + " Encrypted") + ;; application/x-pkcs7-mime + ((and (equal (car handle) "application/x-pkcs7-mime") + (equal + (mm-handle-multipart-ctl-parameter handle 'protocol) + "application/x-pkcs7-mime_signed-data")) + " Signed") + ((and (equal (car handle) "application/x-pkcs7-mime") + (equal + (mm-handle-multipart-ctl-parameter handle 'protocol) + "application/x-pkcs7-mime_enveloped-data")) + " Encrypted")) + " Part")) + (gnus-tmp-info + (or (mm-handle-multipart-ctl-parameter handle 'gnus-info) "Undecided")) (gnus-tmp-details (mm-handle-multipart-ctl-parameter handle 'gnus-details)) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 98e9bb996bc..18732218c9f 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -418,32 +418,29 @@ That is, all information but the name." (defvar gnus-bookmark-bmenu-bookmark-column nil) (defvar gnus-bookmark-bmenu-hidden-bookmarks ()) -(defvar gnus-bookmark-bmenu-mode-map nil) - -(if gnus-bookmark-bmenu-mode-map - nil - (setq gnus-bookmark-bmenu-mode-map (make-keymap)) - (suppress-keymap gnus-bookmark-bmenu-mode-map t) - (define-key gnus-bookmark-bmenu-mode-map "q" 'quit-window) - (define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select) - (define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select) - (define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete) - (define-key gnus-bookmark-bmenu-mode-map "k" 'gnus-bookmark-bmenu-delete) - (define-key gnus-bookmark-bmenu-mode-map "\C-d" 'gnus-bookmark-bmenu-delete-backwards) - (define-key gnus-bookmark-bmenu-mode-map "x" 'gnus-bookmark-bmenu-execute-deletions) - (define-key gnus-bookmark-bmenu-mode-map " " 'next-line) - (define-key gnus-bookmark-bmenu-mode-map "n" 'next-line) - (define-key gnus-bookmark-bmenu-mode-map "p" 'previous-line) - (define-key gnus-bookmark-bmenu-mode-map "\177" 'gnus-bookmark-bmenu-backup-unmark) - (define-key gnus-bookmark-bmenu-mode-map "?" 'describe-mode) - (define-key gnus-bookmark-bmenu-mode-map "u" 'gnus-bookmark-bmenu-unmark) - (define-key gnus-bookmark-bmenu-mode-map "m" 'gnus-bookmark-bmenu-mark) - (define-key gnus-bookmark-bmenu-mode-map "l" 'gnus-bookmark-bmenu-load) - (define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save) - (define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos) - (define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details) - (define-key gnus-bookmark-bmenu-mode-map [mouse-2] - 'gnus-bookmark-bmenu-select-by-mouse)) + +(defvar-keymap gnus-bookmark-bmenu-mode-map + :full t + :suppress 'nodigits + "q" #'quit-window + "RET" #'gnus-bookmark-bmenu-select + "v" #'gnus-bookmark-bmenu-select + "d" #'gnus-bookmark-bmenu-delete + "k" #'gnus-bookmark-bmenu-delete + "C-d" #'gnus-bookmark-bmenu-delete-backwards + "x" #'gnus-bookmark-bmenu-execute-deletions + "SPC" #'next-line + "n" #'next-line + "p" #'previous-line + "DEL" #'gnus-bookmark-bmenu-backup-unmark + "?" #'describe-mode + "u" #'gnus-bookmark-bmenu-unmark + "m" #'gnus-bookmark-bmenu-mark + "l" #'gnus-bookmark-bmenu-load + "s" #'gnus-bookmark-bmenu-save + "t" #'gnus-bookmark-bmenu-toggle-infos + "a" #'gnus-bookmark-bmenu-show-details + "<mouse-2>" #'gnus-bookmark-bmenu-select-by-mouse) ;; Bookmark Buffer Menu mode is suitable only for specially formatted ;; data. @@ -512,7 +509,7 @@ Optional argument SHOW means show them unconditionally." (let ((bmrk (gnus-bookmark-bmenu-bookmark))) (setq gnus-bookmark-bmenu-hidden-bookmarks (cons bmrk gnus-bookmark-bmenu-hidden-bookmarks)) - (let ((start (point-at-eol))) + (let ((start (line-end-position))) (move-to-column gnus-bookmark-bmenu-file-column t) ;; Strip off `mouse-face' from the white spaces region. (if (display-mouse-p) @@ -546,7 +543,7 @@ Optional argument SHOW means show them unconditionally." "Kill from point to end of line. If optional arg NEWLINE-TOO is non-nil, delete the newline too. Does not affect the kill ring." - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) (if (and newline-too (looking-at "\n")) (delete-char 1))) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index ee20ba3c7f0..449b73163f4 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -552,7 +552,7 @@ Returns the list of articles removed." (set-buffer cache-buf) (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") nil t) - (setq beg (point-at-bol) + (setq beg (line-beginning-position) end (progn (end-of-line) (point))) (setq beg nil)) (set-buffer nntp-server-buffer) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 3ba2bbd6fea..b4d7661d742 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -371,7 +371,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (goto-char (point-min)) (forward-line (1- number)) (when (re-search-forward gnus-cite-attribution-suffix - (point-at-eol) + (line-end-position) t) (gnus-article-add-button (match-beginning 1) (match-end 1) 'gnus-cite-toggle prefix)) @@ -756,7 +756,7 @@ See also the documentation for `gnus-article-highlight-citation'." ;; Each line. (setq begin (point) guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) - end (point-at-bol 2) + end (line-beginning-position 2) start end) (goto-char begin) ;; Ignore standard Supercite attribution prefix. @@ -1105,8 +1105,8 @@ Returns nil if there is no such line before LIMIT, t otherwise." "[\t [:alnum:]]+"))) gnus-message-max-citation-depth)) (mlist (make-list (* (1+ gnus-message-max-citation-depth) 2) nil)) - (start (point-at-bol)) - (end (point-at-eol))) + (start (line-beginning-position)) + (end (line-end-position))) (setcar mlist start) (setcar (cdr mlist) end) (setcar (nthcdr (* cdepth 2) mlist) start) diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index 6ed9e32c919..0e38fc0680f 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -30,6 +30,7 @@ (require 'parse-time) (require 'nnimap) +(require 'range) (eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor' (autoload 'epg-make-context "epg") @@ -83,6 +84,7 @@ easy interactive way to set this from the Server buffer." (defun gnus-cloud-make-chunk (elems) (with-temp-buffer + (set-buffer-multibyte nil) (insert (format "Gnus-Cloud-Version %s\n" gnus-cloud-version)) (insert (gnus-cloud-insert-data elems)) (buffer-string))) @@ -404,7 +406,7 @@ When FULL is t, upload everything, not just a difference from the last full." (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)) (active (gnus-active group)) headers head) - (when (gnus-retrieve-headers (gnus-uncompress-range active) group) + (when (gnus-retrieve-headers (range-uncompress active) group) (with-current-buffer nntp-server-buffer (goto-char (point-min)) (while (setq head (nnheader-parse-head)) diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index f8714a95d40..ddd939794dd 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -273,7 +273,7 @@ DOC is a documentation string for the parameter.") gnus-agent-cat-predicate) (agent-score (choice :tag "Score File" :value nil - (const file :tag "Use group's score files") + (const :value file :tag "Use group's score files") (repeat (list (string :format "%v" :tag "File name")))) "Which score files to use when using score to select articles to fetch. diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index d9da8529ebe..f6cfd727f78 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -222,7 +222,7 @@ minutes, the connection is closed." (defun gnus-demon-nntp-close-connection () (save-window-excursion - (when (time-less-p '(0 300) (time-since nntp-last-command-time)) + (when (time-less-p 300 (time-since nntp-last-command-time)) (nntp-close-server)))) (defun gnus-demon-add-scanmail () diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index cd2b53064b9..3c57d7b1124 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -65,8 +65,9 @@ There are currently two built-in format functions: (const :tag "french" gnus-diary-delay-format-french) (symbol :tag "other"))) -(defconst gnus-diary-version nndiary-version +(defconst gnus-diary-version "0.2-b14" "Current Diary back end version.") +(make-obsolete-variable 'gnus-diary-version 'emacs-version "29.1") ;; Compatibility functions ================================================== @@ -326,7 +327,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields." (when (re-search-forward (concat "^" header ":") nil t) (unless (eq (char-after) ? ) (insert " ")) - (setq value (buffer-substring (point) (point-at-eol))) + (setq value (buffer-substring (point) (line-end-position))) (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value) (setq value (match-string 1 value))) (condition-case () @@ -377,8 +378,9 @@ If ARG (or prefix) is non-nil, force prompting for all fields." (defun gnus-diary-version () "Current Diary back end version." + (declare (obsolete emacs-version "29.1")) (interactive) - (message "NNDiary version %s" nndiary-version)) + (message "NNDiary version %s" gnus-diary-version)) (provide 'gnus-diary) diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 2953b61f04e..3d8882b1a55 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -53,12 +53,10 @@ (autoload 'message-buffers "message") (autoload 'gnus-print-buffer "gnus-sum") -(defvar gnus-dired-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-m\C-a" 'gnus-dired-attach) - (define-key map "\C-c\C-m\C-l" 'gnus-dired-find-file-mailcap) - (define-key map "\C-c\C-m\C-p" 'gnus-dired-print) - map)) +(defvar-keymap gnus-dired-mode-map + "C-c C-m C-a" #'gnus-dired-attach + "C-c C-m C-l" #'gnus-dired-find-file-mailcap + "C-c C-m C-p" #'gnus-dired-print) ;; FIXME: Make it customizable, change the default to `mail-user-agent' when ;; this file is renamed (e.g. to `dired-mime.el'). @@ -206,7 +204,8 @@ If ARG is non-nil, open it in a new buffer." (find-file file-name))) (if (file-symlink-p file-name) (error "File is a symlink to a nonexistent target") - (error "File no longer exists; type `g' to update Dired buffer")))) + (error (substitute-command-keys + "File no longer exists; type \\`g' to update Dired buffer"))))) (defun gnus-dired-print (&optional file-name print-to) "In dired, print FILE-NAME according to the mailcap file. @@ -246,9 +245,10 @@ of the file to save in." (error "MIME print only implemented via Gnus"))) (ps-despool print-to)))) ((file-symlink-p file-name) - (error "File is a symlink to a nonexistent target")) - (t - (error "File no longer exists; type `g' to update Dired buffer")))) + (error "File is a symlink to a nonexistent target")) + (t + (error (substitute-command-keys + "File no longer exists; type \\`g' to update Dired buffer"))))) (provide 'gnus-dired) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 1228d74cb51..e38deefe2aa 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -33,15 +33,12 @@ ;;; Draft minor mode -(defvar gnus-draft-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "Dt" gnus-draft-toggle-sending - "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' - "De" gnus-draft-edit-message - "Ds" gnus-draft-send-message - "DS" gnus-draft-send-all-messages) - map)) +(defvar-keymap gnus-draft-mode-map + "D t" #'gnus-draft-toggle-sending + "e" #' gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' + "D e" #'gnus-draft-edit-message + "D s" #'gnus-draft-send-message + "D S" #'gnus-draft-send-all-messages) (defun gnus-draft-make-menu-bar () (unless (boundp 'gnus-draft-menu) @@ -153,7 +150,7 @@ Obeys the standard process/prefix convention." (concat "^" (regexp-quote gnus-agent-target-move-group-header) ":") nil t) (skip-syntax-forward "-") - (setq move-to (buffer-substring (point) (point-at-eol))) + (setq move-to (buffer-substring (point) (line-end-position))) (message-remove-header gnus-agent-target-move-group-header)) (goto-char (point-min)) (when (re-search-forward @@ -203,7 +200,7 @@ Obeys the standard process/prefix convention." (gnus-activate-group "nndraft:queue") (save-excursion (let* ((articles (nndraft-articles)) - (unsendable (gnus-uncompress-range + (unsendable (range-uncompress (cdr (assq 'unsend (gnus-info-marks (gnus-get-info "nndraft:queue")))))) diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index dc10e3cbce0..96f515119dc 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -48,13 +48,10 @@ (defvar gnus-edit-form-buffer "*Gnus edit form*") (defvar gnus-edit-form-done-function nil) -(defvar gnus-edit-form-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map emacs-lisp-mode-map) - (gnus-define-keys map - "\C-c\C-c" gnus-edit-form-done - "\C-c\C-k" gnus-edit-form-exit) - map)) +(defvar-keymap gnus-edit-form-mode-map + :parent emacs-lisp-mode-map + "C-c C-c" #'gnus-edit-form-done + "C-c C-k" #'gnus-edit-form-exit) (defun gnus-edit-form-make-menu-bar () (unless (boundp 'gnus-edit-form-menu) @@ -95,7 +92,7 @@ The optional LAYOUT overrides the `edit-form' window layout." (insert ";;; ") (forward-line 1)) (insert (substitute-command-keys - ";; Type `C-c C-c' after you've finished editing.\n")) + ";; Type \\`C-c C-c' after you've finished editing.\n")) (insert "\n") (let ((p (point))) (gnus-pp form) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 8e12b1cb4bd..fcad601d0c3 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -35,6 +35,7 @@ (require 'gnus-undo) (require 'gmm-utils) (require 'time-date) +(require 'range) (eval-when-compile (require 'mm-url) @@ -62,7 +63,7 @@ (defcustom gnus-keep-same-level nil "Non-nil means that the newsgroup after this one will be on the same level. -When you type, for instance, `n' after reading the last article in the +When you type, for instance, \\`n' after reading the last article in the current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group buffer. @@ -380,8 +381,8 @@ variables in the Lisp expression: `group-age': Time in seconds since the group was last read (see info node `(gnus)Group Timestamp')." :group 'gnus-group-visual - :type '(repeat (cons (sexp :tag "Form") face))) -(put 'gnus-group-highlight 'risky-local-variable t) + :type '(repeat (cons (sexp :tag "Form") face)) + :risky t) (defcustom gnus-new-mail-mark ?% "Mark used for groups with new mail." @@ -409,8 +410,8 @@ requires an understanding of Lisp expressions. Hopefully this will change in a future release. For now, you can use the same variables in the Lisp expression as in `gnus-group-highlight'." :group 'gnus-group-icons - :type '(repeat (cons (sexp :tag "Form") file))) -(put 'gnus-group-icon-list 'risky-local-variable t) + :type '(repeat (cons (sexp :tag "Form") file)) + :risky t) (defcustom gnus-group-name-charset-method-alist nil "Alist of method and the charset for group names. @@ -512,8 +513,8 @@ simple manner." ((numberp number) (int-to-string (+ number - (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) + (range-length (cdr (assq 'dormant gnus-tmp-marked))) + (range-length (cdr (assq 'tick gnus-tmp-marked)))))) (t number)) ?s) (?R gnus-tmp-number-of-read ?s) @@ -523,10 +524,10 @@ simple manner." ?s) (?t gnus-tmp-number-total ?d) (?y gnus-tmp-number-of-unread ?s) - (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) - (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) - (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) + (?I (range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) + (?T (range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) + (?i (+ (range-length (cdr (assq 'dormant gnus-tmp-marked))) + (range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) (?g gnus-tmp-group ?s) (?G gnus-tmp-qualified-group ?s) @@ -573,209 +574,209 @@ simple manner." ;;; Gnus group mode ;;; -(gnus-define-keys gnus-group-mode-map - " " gnus-group-read-group - "=" gnus-group-select-group - "\r" gnus-group-select-group - "\M-\r" gnus-group-quick-select-group - "\M- " gnus-group-visible-select-group - [(meta control return)] gnus-group-select-group-ephemerally - "j" gnus-group-jump-to-group - "n" gnus-group-next-unread-group - "p" gnus-group-prev-unread-group - "\177" gnus-group-prev-unread-group - [delete] gnus-group-prev-unread-group - "N" gnus-group-next-group - "P" gnus-group-prev-group - "\M-n" gnus-group-next-unread-group-same-level - "\M-p" gnus-group-prev-unread-group-same-level - "," gnus-group-best-unread-group - "." gnus-group-first-unread-group - "u" gnus-group-toggle-subscription-at-point - "U" gnus-group-toggle-subscription - "c" gnus-group-catchup-current - "C" gnus-group-catchup-current-all - "\M-c" gnus-group-clear-data - "l" gnus-group-list-groups - "L" gnus-group-list-all-groups - "m" gnus-group-mail - "i" gnus-group-news - "g" gnus-group-get-new-news - "\M-g" gnus-group-get-new-news-this-group - "R" gnus-group-restart - "r" gnus-group-read-init-file - "B" gnus-group-browse-foreign-server - "b" gnus-group-check-bogus-groups - "F" gnus-group-find-new-groups - "\C-c\C-d" gnus-group-describe-group - "\M-d" gnus-group-describe-all-groups - "\C-c\C-a" gnus-group-apropos - "\C-c\M-\C-a" gnus-group-description-apropos - "a" gnus-group-post-news - "\ek" gnus-group-edit-local-kill - "\eK" gnus-group-edit-global-kill - "\C-k" gnus-group-kill-group - "\C-y" gnus-group-yank-group - "\C-w" gnus-group-kill-region - "\C-x\C-t" gnus-group-transpose-groups - "\C-c\C-l" gnus-group-list-killed - "\C-c\C-x" gnus-group-expire-articles - "\C-c\M-\C-x" gnus-group-expire-all-groups - "V" gnus-version - "s" gnus-group-save-newsrc - "z" gnus-group-suspend - "q" gnus-group-exit - "Q" gnus-group-quit - "?" gnus-group-describe-briefly - "\C-c\C-i" gnus-info-find-node - "\M-e" gnus-group-edit-group-method - "^" gnus-group-enter-server-mode - [mouse-2] gnus-mouse-pick-group - [follow-link] mouse-face - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-b" gnus-bug - "\C-c\C-s" gnus-group-sort-groups - "t" gnus-topic-mode - "\C-c\M-g" gnus-activate-all-groups - "\M-&" gnus-group-universal-argument - "#" gnus-group-mark-group - "\M-#" gnus-group-unmark-group) - -(gnus-define-keys (gnus-group-cloud-map "~" gnus-group-mode-map) - "u" gnus-cloud-upload-all-data - "~" gnus-cloud-upload-all-data - "d" gnus-cloud-download-all-data - "\r" gnus-cloud-download-all-data) - -(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) - "m" gnus-group-mark-group - "u" gnus-group-unmark-group - "w" gnus-group-mark-region - "b" gnus-group-mark-buffer - "r" gnus-group-mark-regexp - "U" gnus-group-unmark-all-groups) - -(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map) - "u" gnus-sieve-update - "g" gnus-sieve-generate) - -(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) - "d" gnus-group-make-directory-group - "h" gnus-group-make-help-group - "u" gnus-group-make-useful-group - "l" gnus-group-nnimap-edit-acl - "m" gnus-group-make-group - "E" gnus-group-edit-group - "e" gnus-group-edit-group-method - "p" gnus-group-edit-group-parameters - "v" gnus-group-add-to-virtual - "V" gnus-group-make-empty-virtual - "D" gnus-group-enter-directory - "f" gnus-group-make-doc-group - "w" gnus-group-make-web-group - "G" gnus-group-read-ephemeral-search-group - "g" gnus-group-make-search-group - "M" gnus-group-read-ephemeral-group - "r" gnus-group-rename-group - "R" gnus-group-make-rss-group - "c" gnus-group-customize - "z" gnus-group-compact-group - "x" gnus-group-expunge-group - "\177" gnus-group-delete-group - [delete] gnus-group-delete-group) - -(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) - "s" gnus-group-sort-groups - "a" gnus-group-sort-groups-by-alphabet - "u" gnus-group-sort-groups-by-unread - "l" gnus-group-sort-groups-by-level - "v" gnus-group-sort-groups-by-score - "r" gnus-group-sort-groups-by-rank - "m" gnus-group-sort-groups-by-method - "n" gnus-group-sort-groups-by-real-name) - -(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) - "s" gnus-group-sort-selected-groups - "a" gnus-group-sort-selected-groups-by-alphabet - "u" gnus-group-sort-selected-groups-by-unread - "l" gnus-group-sort-selected-groups-by-level - "v" gnus-group-sort-selected-groups-by-score - "r" gnus-group-sort-selected-groups-by-rank - "m" gnus-group-sort-selected-groups-by-method - "n" gnus-group-sort-selected-groups-by-real-name) - -(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) - "k" gnus-group-list-killed - "z" gnus-group-list-zombies - "s" gnus-group-list-groups - "u" gnus-group-list-all-groups - "A" gnus-group-list-active - "a" gnus-group-apropos - "d" gnus-group-description-apropos - "m" gnus-group-list-matching - "M" gnus-group-list-all-matching - "l" gnus-group-list-level - "c" gnus-group-list-cached - "?" gnus-group-list-dormant - "!" gnus-group-list-ticked) - -(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) - "k" gnus-group-list-limit - "z" gnus-group-list-limit - "s" gnus-group-list-limit - "u" gnus-group-list-limit - "A" gnus-group-list-limit - "m" gnus-group-list-limit - "M" gnus-group-list-limit - "l" gnus-group-list-limit - "c" gnus-group-list-limit - "?" gnus-group-list-limit - "!" gnus-group-list-limit) - -(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map) - "k" gnus-group-list-flush - "z" gnus-group-list-flush - "s" gnus-group-list-flush - "u" gnus-group-list-flush - "A" gnus-group-list-flush - "m" gnus-group-list-flush - "M" gnus-group-list-flush - "l" gnus-group-list-flush - "c" gnus-group-list-flush - "?" gnus-group-list-flush - "!" gnus-group-list-flush) - -(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map) - "k" gnus-group-list-plus - "z" gnus-group-list-plus - "s" gnus-group-list-plus - "u" gnus-group-list-plus - "A" gnus-group-list-plus - "m" gnus-group-list-plus - "M" gnus-group-list-plus - "l" gnus-group-list-plus - "c" gnus-group-list-plus - "?" gnus-group-list-plus - "!" gnus-group-list-plus) - -(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) - "f" gnus-score-flush-cache - "e" gnus-score-edit-all-score) - -(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "d" gnus-group-describe-group - "v" gnus-version) - -(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) - "l" gnus-group-set-current-level - "t" gnus-group-toggle-subscription-at-point - "s" gnus-group-toggle-subscription - "k" gnus-group-kill-group - "y" gnus-group-yank-group - "w" gnus-group-kill-region - "\C-k" gnus-group-kill-level - "z" gnus-group-kill-all-zombies) +(define-keymap :keymap gnus-group-mode-map + "SPC" #'gnus-group-read-group + "=" #'gnus-group-select-group + "RET" #'gnus-group-select-group + "M-RET" #'gnus-group-quick-select-group + "M-SPC" #'gnus-group-visible-select-group + "C-M-<return>" #'gnus-group-select-group-ephemerally + "j" #'gnus-group-jump-to-group + "n" #'gnus-group-next-unread-group + "p" #'gnus-group-prev-unread-group + "DEL" #'gnus-group-prev-unread-group + "<delete>" #'gnus-group-prev-unread-group + "N" #'gnus-group-next-group + "P" #'gnus-group-prev-group + "M-n" #'gnus-group-next-unread-group-same-level + "M-p" #'gnus-group-prev-unread-group-same-level + "," #'gnus-group-best-unread-group + "." #'gnus-group-first-unread-group + "u" #'gnus-group-toggle-subscription-at-point + "U" #'gnus-group-toggle-subscription + "c" #'gnus-group-catchup-current + "C" #'gnus-group-catchup-current-all + "M-c" #'gnus-group-clear-data + "l" #'gnus-group-list-groups + "L" #'gnus-group-list-all-groups + "m" #'gnus-group-mail + "i" #'gnus-group-news + "g" #'gnus-group-get-new-news + "M-g" #'gnus-group-get-new-news-this-group + "R" #'gnus-group-restart + "r" #'gnus-group-read-init-file + "B" #'gnus-group-browse-foreign-server + "b" #'gnus-group-check-bogus-groups + "F" #'gnus-group-find-new-groups + "C-c C-d" #'gnus-group-describe-group + "M-d" #'gnus-group-describe-all-groups + "C-c C-a" #'gnus-group-apropos + "C-c C-M-a" #'gnus-group-description-apropos + "a" #'gnus-group-post-news + "ESC k" #'gnus-group-edit-local-kill + "ESC K" #'gnus-group-edit-global-kill + "C-k" #'gnus-group-kill-group + "C-y" #'gnus-group-yank-group + "C-w" #'gnus-group-kill-region + "C-x C-t" #'gnus-group-transpose-groups + "C-c C-l" #'gnus-group-list-killed + "C-c C-x" #'gnus-group-expire-articles + "C-c C-M-x" #'gnus-group-expire-all-groups + "V" #'gnus-version + "s" #'gnus-group-save-newsrc + "z" #'gnus-group-suspend + "q" #'gnus-group-exit + "Q" #'gnus-group-quit + "?" #'gnus-group-describe-briefly + "C-c C-i" #'gnus-info-find-node + "M-e" #'gnus-group-edit-group-method + "^" #'gnus-group-enter-server-mode + "<mouse-2>" #'gnus-mouse-pick-group + "<follow-link>" 'mouse-face + "<" #'beginning-of-buffer + ">" #'end-of-buffer + "C-c C-b" #'gnus-bug + "C-c C-s" #'gnus-group-sort-groups + "t" #'gnus-topic-mode + "C-c M-g" #'gnus-activate-all-groups + "M-&" #'gnus-group-universal-argument + "#" #'gnus-group-mark-group + "M-#" #'gnus-group-unmark-group + + "~" (define-keymap :prefix 'gnus-group-cloud-map + "u" #'gnus-cloud-upload-all-data + "~" #'gnus-cloud-upload-all-data + "d" #'gnus-cloud-download-all-data + "RET" #'gnus-cloud-download-all-data) + + "M" (define-keymap :prefix 'gnus-group-mark-map + "m" #'gnus-group-mark-group + "u" #'gnus-group-unmark-group + "w" #'gnus-group-mark-region + "b" #'gnus-group-mark-buffer + "r" #'gnus-group-mark-regexp + "U" #'gnus-group-unmark-all-groups) + + "D" (define-keymap :prefix 'gnus-group-sieve-map + "u" #'gnus-sieve-update + "g" #'gnus-sieve-generate) + + "G" (define-keymap :prefix 'gnus-group-group-map + "d" #'gnus-group-make-directory-group + "h" #'gnus-group-make-help-group + "u" #'gnus-group-make-useful-group + "l" #'gnus-group-nnimap-edit-acl + "m" #'gnus-group-make-group + "E" #'gnus-group-edit-group + "e" #'gnus-group-edit-group-method + "p" #'gnus-group-edit-group-parameters + "v" #'gnus-group-add-to-virtual + "V" #'gnus-group-make-empty-virtual + "D" #'gnus-group-enter-directory + "f" #'gnus-group-make-doc-group + "w" #'gnus-group-make-web-group + "G" #'gnus-group-read-ephemeral-search-group + "g" #'gnus-group-make-search-group + "M" #'gnus-group-read-ephemeral-group + "r" #'gnus-group-rename-group + "R" #'gnus-group-make-rss-group + "c" #'gnus-group-customize + "z" #'gnus-group-compact-group + "x" #'gnus-group-expunge-group + "DEL" #'gnus-group-delete-group + "<delete>" #'gnus-group-delete-group + + "S" (define-keymap :prefix 'gnus-group-sort-map + "s" #'gnus-group-sort-groups + "a" #'gnus-group-sort-groups-by-alphabet + "u" #'gnus-group-sort-groups-by-unread + "l" #'gnus-group-sort-groups-by-level + "v" #'gnus-group-sort-groups-by-score + "r" #'gnus-group-sort-groups-by-rank + "m" #'gnus-group-sort-groups-by-method + "n" #'gnus-group-sort-groups-by-real-name) + + "P" (define-keymap :prefix 'gnus-group-sort-selected-map + "s" #'gnus-group-sort-selected-groups + "a" #'gnus-group-sort-selected-groups-by-alphabet + "u" #'gnus-group-sort-selected-groups-by-unread + "l" #'gnus-group-sort-selected-groups-by-level + "v" #'gnus-group-sort-selected-groups-by-score + "r" #'gnus-group-sort-selected-groups-by-rank + "m" #'gnus-group-sort-selected-groups-by-method + "n" #'gnus-group-sort-selected-groups-by-real-name)) + + "A" (define-keymap :prefix 'gnus-group-list-map + "k" #'gnus-group-list-killed + "z" #'gnus-group-list-zombies + "s" #'gnus-group-list-groups + "u" #'gnus-group-list-all-groups + "A" #'gnus-group-list-active + "a" #'gnus-group-apropos + "d" #'gnus-group-description-apropos + "m" #'gnus-group-list-matching + "M" #'gnus-group-list-all-matching + "l" #'gnus-group-list-level + "c" #'gnus-group-list-cached + "?" #'gnus-group-list-dormant + "!" #'gnus-group-list-ticked + + "/" (define-keymap :prefix 'gnus-group-list-limit-map + "k" #'gnus-group-list-limit + "z" #'gnus-group-list-limit + "s" #'gnus-group-list-limit + "u" #'gnus-group-list-limit + "A" #'gnus-group-list-limit + "m" #'gnus-group-list-limit + "M" #'gnus-group-list-limit + "l" #'gnus-group-list-limit + "c" #'gnus-group-list-limit + "?" #'gnus-group-list-limit + "!" #'gnus-group-list-limit) + + "f" (define-keymap :prefix 'gnus-group-list-flush-map + "k" #'gnus-group-list-flush + "z" #'gnus-group-list-flush + "s" #'gnus-group-list-flush + "u" #'gnus-group-list-flush + "A" #'gnus-group-list-flush + "m" #'gnus-group-list-flush + "M" #'gnus-group-list-flush + "l" #'gnus-group-list-flush + "c" #'gnus-group-list-flush + "?" #'gnus-group-list-flush + "!" #'gnus-group-list-flush) + + "p" (define-keymap :prefix 'gnus-group-list-plus-map + "k" #'gnus-group-list-plus + "z" #'gnus-group-list-plus + "s" #'gnus-group-list-plus + "u" #'gnus-group-list-plus + "A" #'gnus-group-list-plus + "m" #'gnus-group-list-plus + "M" #'gnus-group-list-plus + "l" #'gnus-group-list-plus + "c" #'gnus-group-list-plus + "?" #'gnus-group-list-plus + "!" #'gnus-group-list-plus)) + + "W" (define-keymap :prefix 'gnus-group-score-map + "f" #'gnus-score-flush-cache + "e" #'gnus-score-edit-all-score) + + "H" (define-keymap :prefix 'gnus-group-help-map + "d" #'gnus-group-describe-group + "v" #'gnus-version) + + "S" (define-keymap :prefix 'gnus-group-sub-map + "l" #'gnus-group-set-current-level + "t" #'gnus-group-toggle-subscription-at-point + "s" #'gnus-group-toggle-subscription + "k" #'gnus-group-kill-group + "y" #'gnus-group-yank-group + "w" #'gnus-group-kill-region + "C-k" #'gnus-group-kill-level + "z" #'gnus-group-kill-all-zombies)) (defun gnus-topic-mode-p () "Return non-nil in `gnus-topic-mode'." @@ -982,66 +983,36 @@ simple manner." (gnus-run-hooks 'gnus-group-menu-hook))) - (defvar gnus-group-tool-bar-map nil) -(defun gnus-group-tool-bar-update (&optional symbol value) - "Update group buffer toolbar. -Setter function for custom variables." - (when symbol - (set-default symbol value)) - ;; (setq-default gnus-group-tool-bar-map nil) - ;; (use-local-map gnus-group-mode-map) - (when (gnus-alive-p) - (with-current-buffer gnus-group-buffer - (gnus-group-make-tool-bar t)))) - -(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome) - 'gnus-group-tool-bar-gnome - 'gnus-group-tool-bar-retro) - "Specifies the Gnus group tool bar. - -It can be either a list or a symbol referring to a list. See -`gmm-tool-bar-from-list' for the format of the list. The -default key map is `gnus-group-mode-map'. - -Pre-defined symbols include `gnus-group-tool-bar-gnome' and -`gnus-group-tool-bar-retro'." - :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome) - (const :tag "Retro look" gnus-group-tool-bar-retro) - (repeat :tag "User defined list" gmm-tool-bar-item) - (symbol)) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) - -(defcustom gnus-group-tool-bar-gnome +(defcustom gnus-group-tool-bar '((gnus-group-post-news "mail/compose") ;; Some useful agent icons? I don't use the agent so agent users should ;; suggest useful commands: - (gnus-agent-toggle-plugged "unplugged" t - :help "Gnus is currently unplugged. Click to work online." - :visible (and gnus-agent (not gnus-plugged))) - (gnus-agent-toggle-plugged "plugged" t - :help "Gnus is currently plugged. Click to work offline." - :visible (and gnus-agent gnus-plugged)) - ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar) - ;; should have a better help text. - (gnus-group-send-queue "mail/outbox" t - :visible (and gnus-agent gnus-plugged) - :help "Send articles from the queue group") - (gnus-group-get-new-news "mail/inbox" nil - :visible (or (not gnus-agent) - gnus-plugged)) - ;; FIXME: gnus-*-read-group should have a better help text. - (gnus-topic-read-group "open" nil - :visible (and (boundp 'gnus-topic-mode) - gnus-topic-mode)) - (gnus-group-read-group "open" nil - :visible (not (and (boundp 'gnus-topic-mode) - gnus-topic-mode))) - ;; (gnus-group-find-new-groups "???" nil) + (gnus-agent-toggle-plugged + "unplugged" t + :help "Gnus is currently unplugged. Click to work online." + :visible (and gnus-agent (not gnus-plugged))) + (gnus-agent-toggle-plugged + "plugged" t + :help "Gnus is currently plugged. Click to work offline." + :visible (and gnus-agent gnus-plugged)) + (gnus-group-send-queue + "mail/outbox" t + :visible (and gnus-agent gnus-plugged) + :help "Send articles from the queue group") + (gnus-group-get-new-news + "mail/inbox" nil + :visible (or (not gnus-agent) + gnus-plugged)) + (gnus-topic-read-group + "open" nil + :visible (and (boundp 'gnus-topic-mode) + gnus-topic-mode)) + (gnus-group-read-group + "open" nil + :visible (not (and (boundp 'gnus-topic-mode) + gnus-topic-mode))) (gnus-group-save-newsrc "save") (gnus-group-describe-group "describe") (gnus-group-toggle-subscription-at-point "gnus/toggle-subscription") @@ -1050,44 +1021,22 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and (gnus-group-exit "exit") (gmm-customize-mode "preferences" t :help "Edit mode preferences") (gnus-info-find-node "help")) - "List of functions for the group tool bar (GNOME style). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) + "Specifies the Gnus group tool bar. -(defcustom gnus-group-tool-bar-retro - '((gnus-group-get-new-news "gnus/get-news") - (gnus-group-get-new-news-this-group "gnus/gnntg") - (gnus-group-catchup-current "gnus/catchup") - (gnus-group-describe-group "gnus/describe-group") - (gnus-group-subscribe "gnus/subscribe" t - :help "Subscribe to the current group") - (gnus-group-unsubscribe "gnus/unsubscribe" t - :help "Unsubscribe from the current group") - (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map)) - "List of functions for the group tool bar (retro look). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update +It can be either a list or a symbol referring to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `gnus-group-mode-map'." + :type '(choice (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "29.1" :group 'gnus-group) -(defcustom gnus-group-tool-bar-zap-list t - "List of icon items from the global tool bar. -These items are not displayed in the Gnus group mode tool bar. - -See `gmm-tool-bar-from-list' for the format of the list." - :type 'gmm-tool-bar-zap-list - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) +(defvar gnus-group-tool-bar-gnome nil) +(make-obsolete-variable 'gnus-group-tool-bar-gnome nil "29.1") +(defvar gnus-group-tool-bar-retro nil) +(make-obsolete-variable 'gnus-group-tool-bar-retro nil "29.1") +(defvar gnus-group-tool-bar-zap-list t) +(make-obsolete-variable 'gnus-group-tool-bar-zap-list nil "29.1") (defvar image-load-path) (defvar tool-bar-map) @@ -1255,7 +1204,7 @@ case interactively), the level will be updated by this command." (gnus-group-setup-buffer) (gnus-update-format-specifications nil 'group 'group-mode) (let ((case-fold-search nil) - (props (text-properties-at (point-at-bol))) + (props (text-properties-at (line-beginning-position))) (empty (= (point-min) (point-max))) (group (gnus-group-group-name)) number) @@ -1482,9 +1431,9 @@ if it is a string, only list groups matching REGEXP." (active (gnus-active group))) (if (not active) 0 - (length (gnus-uncompress-range - (gnus-range-difference - (gnus-range-difference (list active) (gnus-info-read info)) + (length (range-uncompress + (range-difference + (range-difference (list active) (gnus-info-read info)) seen)))))) ;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't @@ -1642,7 +1591,7 @@ Some value are bound so the form can use them." '(mail post-mail)))) (cons 'level (or (gnus-info-level info) gnus-level-killed)) (cons 'score (or (gnus-info-score info) 0)) - (cons 'ticked (gnus-range-length (cdr (assq 'tick marked)))) + (cons 'ticked (range-length (cdr (assq 'tick marked)))) (cons 'group-age (gnus-group-timestamp-delta group))))) (while (and list (not (eval (caar list) env))) @@ -1775,24 +1724,24 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." (defun gnus-group-group-name () "Get the name of the newsgroup on the current line." - (let ((group (get-text-property (point-at-bol) 'gnus-group))) + (let ((group (get-text-property (line-beginning-position) 'gnus-group))) (cond ((stringp group) group) (group (symbol-name group))))) (defun gnus-group-group-level () "Get the level of the newsgroup on the current line." - (get-text-property (point-at-bol) 'gnus-level)) + (get-text-property (line-beginning-position) 'gnus-level)) (defun gnus-group-group-indentation () "Get the indentation of the newsgroup on the current line." - (or (get-text-property (point-at-bol) 'gnus-indentation) + (or (get-text-property (line-beginning-position) 'gnus-indentation) (and gnus-group-indentation-function (funcall gnus-group-indentation-function)) "")) (defun gnus-group-group-unread () "Get the number of unread articles of the newsgroup on the current line." - (get-text-property (point-at-bol) 'gnus-unread)) + (get-text-property (line-beginning-position) 'gnus-unread)) (defun gnus-group-new-mail (group) (if (nnmail-new-mail-p group) @@ -2065,9 +2014,9 @@ that group." (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) - (zerop (+ number (gnus-range-length + (zerop (+ number (range-length (cdr (assq 'tick marked))) - (gnus-range-length + (range-length (cdr (assq 'dormant marked))))))) no-article nil no-display nil select-articles))) @@ -2146,14 +2095,14 @@ be permanent." (looking-at "[][\C-@-*,/;-@\\^`{-\C-?]"))) (prog1 t (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" - (point-at-bol)))) + (line-beginning-position)))) (and (looking-at "[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*$") (prog1 t (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?") (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" - (point-at-bol)))) + (line-beginning-position)))) (string-match "\\`[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*\\'" - (buffer-substring (point-at-bol) (point)))) + (buffer-substring (line-beginning-position) (point)))) (when (looking-at regexp) (match-string 1)) (let (group distance) @@ -2162,7 +2111,7 @@ be permanent." distance (- (match-beginning 1) (match-beginning 0)))) (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?") (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" - (point-at-bol)) + (line-beginning-position)) (if (looking-at regexp) (if (and group (<= distance (- start (match-end 0)))) group @@ -2832,7 +2781,7 @@ according to the expiry settings. Note that this will delete old not-expirable articles, too." (interactive (list (gnus-group-group-name) current-prefix-arg) gnus-group-mode) - (let ((articles (gnus-uncompress-range (gnus-active group)))) + (let ((articles (range-uncompress (gnus-active group)))) (when (gnus-yes-or-no-p (format "Do you really want to delete these %d articles forever? " (length articles))) @@ -3134,9 +3083,9 @@ If SOLID (the prefix), create a solid group." (if (derived-mode-p 'gnus-summary-mode) 'summary 'group)))))) (defvar nnrss-group-alist) -(eval-when-compile - (defun nnrss-discover-feed (_arg)) - (defun nnrss-save-server-data (_arg))) +(declare-function nnrss-discover-feed "nnrss" (url)) +(declare-function nnrss-save-server-data "nnrss" (server)) + (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" @@ -3225,7 +3174,11 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (if (gnus-server-server-name) (list (list (gnus-server-server-name))) (seq-group-by - (lambda (elt) (gnus-group-server elt)) + (lambda (elt) + (if (gnus-group-native-p elt) + (gnus-group-server elt) + (gnus-method-to-server + (gnus-find-method-for-group elt)))) (or gnus-group-marked (if (gnus-group-group-name) (list (gnus-group-group-name)) @@ -3276,7 +3229,11 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (if (gnus-server-server-name) (list (list (gnus-server-server-name))) (seq-group-by - (lambda (elt) (gnus-group-server elt)) + (lambda (elt) + (if (gnus-group-native-p elt) + (gnus-group-server elt) + (gnus-method-to-server + (gnus-find-method-for-group elt)))) (or gnus-group-marked (if (gnus-group-group-name) (list (gnus-group-group-name)) @@ -3755,15 +3712,15 @@ or nil if no action could be taken." 'del '(tick)) (list (cdr (assq 'dormant marks)) 'del '(dormant)))) - (setq unread (gnus-range-add (gnus-range-add - unread (cdr (assq 'dormant marks))) - (cdr (assq 'tick marks)))) + (setq unread (range-concat (range-concat + unread (cdr (assq 'dormant marks))) + (cdr (assq 'tick marks)))) (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) ;; Do auto-expirable marks if that's required. (when (and (gnus-group-auto-expirable-p group) (not (gnus-group-read-only-p group))) - (gnus-range-map + (range-map (lambda (article) (gnus-add-marked-articles group 'expire (list article)) (gnus-request-set-mark group (list (list (list article) @@ -3795,7 +3752,7 @@ Uses the process/prefix convention." (cons nil (gnus-list-of-read-articles group)) (assq 'expire (gnus-info-marks info)))) (articles-to-expire - (gnus-list-range-difference + (range-list-difference (gnus-uncompress-sequence (cdr expirable)) (cdr (assq 'unexist (gnus-info-marks info))))) (expiry-wait (gnus-group-find-parameter group 'expiry-wait)) @@ -3991,10 +3948,10 @@ The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." (count-lines (progn (goto-char begin) - (point-at-bol)) + (line-beginning-position)) (progn (goto-char end) - (point-at-bol)))))) + (line-beginning-position)))))) (goto-char begin) (beginning-of-line) ;Important when LINES < 1 (gnus-group-kill-group lines))) @@ -4575,9 +4532,11 @@ and the second element is the address." ;; FIXME? gnus-secondary-servers is obsolete, ;; and it is not obvious that there is anything ;; sensible to use instead in this particular case. - (if (boundp 'gnus-secondary-servers) - gnus-secondary-servers - (cdr gnus-select-method)))) + ;; (if (boundp 'gnus-secondary-servers) + ;; gnus-secondary-servers + ;; (cdr gnus-select-method)) + nil + )) ;; We got a server name. how))) gnus-group-mode) @@ -4671,23 +4630,22 @@ and the second element is the address." (and (not (setq marked (nthcdr 3 info))) (or (null articles) (setcdr (nthcdr 2 info) - (list (list (cons type (gnus-compress-sequence - articles t))))))) + (list (list (cons type (range-compress-list + articles))))))) (and (not (setq m (assq type (car marked)))) (or (null articles) (setcar marked - (cons (cons type (gnus-compress-sequence articles t) ) + (cons (cons type (range-compress-list articles)) (car marked))))) (if force (if (null articles) (setcar (nthcdr 3 info) (assq-delete-all type (car marked))) - (setcdr m (gnus-compress-sequence articles t))) - (setcdr m (gnus-compress-sequence - (sort (nconc (gnus-uncompress-range (cdr m)) + (setcdr m (range-compress-list articles))) + (setcdr m (range-compress-list + (sort (nconc (range-uncompress (cdr m)) (copy-sequence articles)) - #'<) - t)))))) + #'<))))))) (declare-function gnus-summary-add-mark "gnus-sum" (article type)) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index e259d9ae18b..87f3ee63623 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -40,14 +40,11 @@ (require 'help-fns) (require 'url-queue) -(defcustom gnus-html-image-cache-ttl (days-to-time 7) - "Time used to determine if we should use images from the cache." - :version "24.1" +(defcustom gnus-html-image-cache-ttl (time-convert (days-to-time 7) 'integer) + "Number of seconds used to determine if we should use images from the cache." + :version "29.1" :group 'gnus-art - ;; FIXME hardly the friendliest type. The allowed value is actually - ;; any time value, but we are assuming no-one cares about USEC and - ;; PSEC here. It would be better to eg make it a number of minutes. - :type '(list integer integer)) + :type 'number) (defcustom gnus-html-image-automatic-caching t "Whether automatically cache retrieve images." @@ -71,21 +68,17 @@ fit these criteria." :group 'gnus-art :type 'float) -(defvar gnus-html-image-map - (let ((map (make-sparse-keymap))) - (define-key map "u" 'gnus-article-copy-string) - (define-key map "i" 'gnus-html-insert-image) - (define-key map "v" 'gnus-html-browse-url) - map)) - -(defvar gnus-html-displayed-image-map - (let ((map (make-sparse-keymap))) - (define-key map "a" 'gnus-html-show-alt-text) - (define-key map "i" 'gnus-html-browse-image) - (define-key map "\r" 'gnus-html-browse-url) - (define-key map "u" 'gnus-article-copy-string) - (define-key map [tab] 'button-forward) - map)) +(defvar-keymap gnus-html-image-map + "u" #'gnus-article-copy-string + "i" #'gnus-html-insert-image + "v" #'gnus-html-browse-url) + +(defvar-keymap gnus-html-displayed-image-map + "a" #'gnus-html-show-alt-text + "i" #'gnus-html-browse-image + "RET" #'gnus-html-browse-url + "u" #'gnus-article-copy-string + "<tab>" #'forward-button) (defun gnus-html-encode-url (url) "Encode URL." diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index d35b0ebb1d9..1bffdf3513a 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -194,7 +194,11 @@ (caddr event)))) (cl-labels - ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) + ((attendee-role (prop) + ;; RFC5546: default ROLE is REQ-PARTICIPANT + (and prop + (or (plist-get (cadr prop) 'ROLE) + "REQ-PARTICIPANT"))) (attendee-name (prop) (or (plist-get (cadr prop) 'CN) @@ -225,7 +229,10 @@ (gnus-icalendar-event--find-attendee ical attendee-name-or-email))) (attendee-names (gnus-icalendar-event--get-attendee-names ical)) - (role (plist-get (cadr attendee) 'ROLE)) + ;; RFC5546: default ROLE is REQ-PARTICIPANT + (role (and attendee + (or (plist-get (cadr attendee) 'ROLE) + "REQ-PARTICIPANT"))) (participation-type (pcase role ("REQ-PARTICIPANT" 'required) ("OPT-PARTICIPANT" 'optional) @@ -345,10 +352,16 @@ status will be retrieved from the first matching attendee record." (mapc #'process-event-line (split-string ical-request "\n")) + ;; RFC5546 refers to uninvited attendees as "party crashers". + ;; This situation is common if the invitation is sent to a group + ;; of people via a mailing list. (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) reply-event-lines) (lwarn 'gnus-icalendar :warning - "Could not find an event attendee matching given identity")) + "Could not find an event attendee matching given identity") + (push (format "ATTENDEE;RSVP=TRUE;PARTSTAT=%s;CN=%s:MAILTO:%s" + attendee-status user-full-name user-mail-address) + reply-event-lines)) (mapconcat #'identity `("BEGIN:VEVENT" ,@(nreverse reply-event-lines) @@ -817,11 +830,12 @@ These will be used to retrieve the RSVP information from ical events." (defmacro gnus-icalendar-with-decoded-handle (handle &rest body) "Execute BODY in buffer containing the decoded contents of HANDLE." (let ((charset (make-symbol "charset"))) - `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle))))) + `(let ((,charset (downcase + (or (cdr (assoc 'charset (mm-handle-type ,handle))) + "utf-8")))) (with-temp-buffer (mm-insert-part ,handle) - (when (and ,charset (string= (downcase ,charset) "utf-8")) - (decode-coding-region (point-min) (point-max) 'utf-8)) + (decode-coding-region (point-min) (point-max) (intern ,charset)) ,@body)))) @@ -847,10 +861,14 @@ These will be used to retrieve the RSVP information from ical events." button t gnus-data ,data)))) -(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject) +(defun gnus-icalendar-send-buffer-by-mail (buffer-name subject organizer) (let ((message-signature nil)) (with-current-buffer gnus-summary-buffer (gnus-summary-reply) + ;; Reply to the organizer, not to whoever sent the invitation. person + ;; Some calendar systems use specific email address as organizer to + ;; receive these responses. + (message-replace-header "To" organizer) (message-goto-body) (mml-insert-multipart "alternative") (mml-insert-empty-tag 'part 'type "text/plain") @@ -866,7 +884,8 @@ These will be used to retrieve the RSVP information from ical events." (event (caddr data)) (reply (gnus-icalendar-with-decoded-handle handle (gnus-icalendar-event-reply-from-buffer - (current-buffer) status (gnus-icalendar-identities))))) + (current-buffer) status (gnus-icalendar-identities)))) + (organizer (gnus-icalendar-event:organizer event))) (when reply (cl-labels @@ -883,7 +902,7 @@ These will be used to retrieve the RSVP information from ical events." (delete-region (point-min) (point-max)) (insert reply) (fold-icalendar-buffer) - (gnus-icalendar-send-buffer-by-mail (buffer-name) subject)) + (gnus-icalendar-send-buffer-by-mail (buffer-name) subject organizer)) ;; Back in article buffer (setq-local gnus-icalendar-reply-status status) @@ -897,10 +916,16 @@ These will be used to retrieve the RSVP information from ical events." (gnus-icalendar-event:sync-to-org event gnus-icalendar-reply-status)) (cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event) handle) - (when (gnus-icalendar-event:rsvp event) - `(("Accept" gnus-icalendar-reply (,handle accepted ,event)) - ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) - ("Decline" gnus-icalendar-reply (,handle declined ,event))))) + (let ((accept-btn "Accept") + (tentative-btn "Tentative") + (decline-btn "Decline")) + (unless (gnus-icalendar-event:rsvp event) + (setq accept-btn "Uninvited Accept" + tentative-btn "Uninvited Tentative" + decline-btn "Uninvited Decline")) + `((,accept-btn gnus-icalendar-reply (,handle accepted ,event)) + (,tentative-btn gnus-icalendar-reply (,handle tentative ,event)) + (,decline-btn gnus-icalendar-reply (,handle declined ,event))))) (cl-defmethod gnus-icalendar-event:inline-reply-buttons ((_event gnus-icalendar-event-reply) _handle) "No buttons for REPLY events." @@ -1038,13 +1063,14 @@ These will be used to retrieve the RSVP information from ical events." (add-to-list 'mm-automatic-display "text/calendar") (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity)) - (gnus-define-keys (gnus-summary-calendar-map "i" gnus-summary-mode-map) - "a" gnus-icalendar-reply-accept - "t" gnus-icalendar-reply-tentative - "d" gnus-icalendar-reply-decline - "c" gnus-icalendar-event-check-agenda - "e" gnus-icalendar-event-export - "s" gnus-icalendar-event-show) + (define-key gnus-summary-mode-map "i" + (define-keymap :prefix 'gnus-summary-calendar-map + "a" #'gnus-icalendar-reply-accept + "t" #'gnus-icalendar-reply-tentative + "d" #'gnus-icalendar-reply-decline + "c" #'gnus-icalendar-event-check-agenda + "e" #'gnus-icalendar-event-export + "s" #'gnus-icalendar-event-show)) (require 'gnus-art) (add-to-list 'gnus-mime-action-alist diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 5a619e8f07b..a85510ba91e 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -114,10 +114,7 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." ;; Read server name with completion. (setq gnus-nntp-server (gnus-completing-read "NNTP server" - (cons gnus-nntp-server - (if (boundp 'gnus-secondary-servers) - gnus-secondary-servers)) - nil gnus-nntp-server))) + nil nil gnus-nntp-server))) (when (and gnus-nntp-server (stringp gnus-nntp-server) @@ -802,7 +799,7 @@ If GROUP is nil, all groups on COMMAND-METHOD are scanned." (when (> min 1) (let* ((range (if (= min 2) 1 (cons 1 (1- min)))) (read (gnus-info-read info)) - (new-read (gnus-range-add read (list range)))) + (new-read (range-concat read (list range)))) (setf (gnus-info-read info) new-read))) info)))))) diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index 57b4444d577..bc49f8385ea 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -66,18 +66,15 @@ of time." ;;; Gnus Kill File Mode ;;; -(defvar gnus-kill-file-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map emacs-lisp-mode-map) - (gnus-define-keymap map - "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject - "\C-c\C-k\C-a" gnus-kill-file-kill-by-author - "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread - "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref - "\C-c\C-a" gnus-kill-file-apply-buffer - "\C-c\C-e" gnus-kill-file-apply-last-sexp - "\C-c\C-c" gnus-kill-file-exit) - map)) +(defvar-keymap gnus-kill-file-mode-map + :parent emacs-lisp-mode-map + "C-c C-k C-s" #'gnus-kill-file-kill-by-subject + "C-c C-k C-a" #'gnus-kill-file-kill-by-author + "C-c C-k C-t" #'gnus-kill-file-kill-by-thread + "C-c C-k C-x" #'gnus-kill-file-kill-by-xref + "C-c C-a" #'gnus-kill-file-apply-buffer + "C-c C-e" #'gnus-kill-file-apply-last-sexp + "C-c C-c" #'gnus-kill-file-exit) (define-derived-mode gnus-kill-file-mode emacs-lisp-mode "Kill" "Major mode for editing kill files. @@ -352,7 +349,7 @@ Returns the number of articles marked as read." (setq gnus-newsgroup-kill-headers (mapcar #'mail-header-number headers)) (while headers - (unless (gnus-member-of-range + (unless (range-member-p (mail-header-number (car headers)) gnus-newsgroup-killed) (push (mail-header-number (car headers)) diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index 3fb2ed3c626..c1b559ba6f4 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -224,8 +224,8 @@ (goto-char (point-min)) (prog1 (funcall search-func match nil t) - (widen))) - (when handles (mm-destroy-parts handles)))))) + (widen) + (when handles (mm-destroy-parts handles)))))))) (provide 'gnus-logic) diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index 077ea3b6b8c..211980aa9e3 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -31,16 +31,13 @@ ;;; Mailing list minor mode -(defvar gnus-mailing-list-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "\C-c\C-nh" gnus-mailing-list-help - "\C-c\C-ns" gnus-mailing-list-subscribe - "\C-c\C-nu" gnus-mailing-list-unsubscribe - "\C-c\C-np" gnus-mailing-list-post - "\C-c\C-no" gnus-mailing-list-owner - "\C-c\C-na" gnus-mailing-list-archive) - map)) +(defvar-keymap gnus-mailing-list-mode-map + "C-c C-n h" #'gnus-mailing-list-help + "C-c C-n s" #'gnus-mailing-list-subscribe + "C-c C-n u" #'gnus-mailing-list-unsubscribe + "C-c C-n p" #'gnus-mailing-list-post + "C-c C-n o" #'gnus-mailing-list-owner + "C-c C-n a" #'gnus-mailing-list-archive) (defvar gnus-mailing-list-menu) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index f7eecece26b..3fc5ce2408a 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -52,24 +52,6 @@ method to use when posting." (const current) (sexp :tag "Methods" ,gnus-select-method))) -(defcustom gnus-outgoing-message-group nil - "All outgoing messages will be put in this group. -If you want to store all your outgoing mail and articles in the group -\"nnml:archive\", you set this variable to that value. This variable -can also be a list of group names. - -If you want to have greater control over what group to put each -message in, you can set this variable to a function that checks the -current newsgroup name and then returns a suitable group name (or list -of names)." - :group 'gnus-message - :type '(choice (const nil) - (function) - (string :tag "Group") - (repeat :tag "List of groups" (string :tag "Group")))) - -(make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1") - (defcustom gnus-mailing-list-groups nil "If non-nil a regexp matching groups that are really mailing lists. This is useful when you're reading a mailing list that has been @@ -215,30 +197,6 @@ use this option with care." :parameter-document "\ List of charsets that are permitted to be unencoded.") -(defcustom gnus-debug-files - '("gnus.el" "gnus-sum.el" "gnus-group.el" - "gnus-art.el" "gnus-start.el" "gnus-async.el" - "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el" - "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el" - "mm-util.el" "mm-decode.el" "nnmail.el" "message.el") - "Files whose variables will be reported in `gnus-bug'." - :version "22.1" - :group 'gnus-message - :type '(repeat file)) - -(make-obsolete-variable 'gnus-debug-files "it is no longer used." "24.1") - -(defcustom gnus-debug-exclude-variables - '(mm-mime-mule-charset-alist - nnmail-split-fancy message-minibuffer-local-map) - "Variables that should not be reported in `gnus-bug'." - :version "22.1" - :group 'gnus-message - :type '(repeat variable)) - -(make-obsolete-variable - 'gnus-debug-exclude-variables "it is no longer used." "24.1") - (defcustom gnus-discouraged-post-methods '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir) "A list of back ends that are not used in \"real\" newsgroups. @@ -349,39 +307,39 @@ only affect the Gcc copy, but not the original message." ;;; Gnus Posting Functions ;;; -(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map) - "p" gnus-summary-post-news - "i" gnus-summary-news-other-window - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "c" gnus-summary-cancel-article - "s" gnus-summary-supersede-article - "r" gnus-summary-reply - "y" gnus-summary-yank-message - "R" gnus-summary-reply-with-original - "L" gnus-summary-reply-to-list-with-original - "w" gnus-summary-wide-reply - "W" gnus-summary-wide-reply-with-original - "v" gnus-summary-very-wide-reply - "V" gnus-summary-very-wide-reply-with-original - "n" gnus-summary-followup-to-mail - "N" gnus-summary-followup-to-mail-with-original - "m" gnus-summary-mail-other-window - "u" gnus-uu-post-news - "A" gnus-summary-attach-article - "\M-c" gnus-summary-mail-crosspost-complaint - "Br" gnus-summary-reply-broken-reply-to - "BR" gnus-summary-reply-broken-reply-to-with-original - "om" gnus-summary-mail-forward - "op" gnus-summary-post-forward - "Om" gnus-uu-digest-mail-forward - "Op" gnus-uu-digest-post-forward) - -(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) - "b" gnus-summary-resend-bounced-mail - ;; "c" gnus-summary-send-draft - "r" gnus-summary-resend-message - "e" gnus-summary-resend-message-edit) +(define-keymap :prefix 'gnus-summary-send-map + "p" #'gnus-summary-post-news + "i" #'gnus-summary-news-other-window + "f" #'gnus-summary-followup + "F" #'gnus-summary-followup-with-original + "c" #'gnus-summary-cancel-article + "s" #'gnus-summary-supersede-article + "r" #'gnus-summary-reply + "y" #'gnus-summary-yank-message + "R" #'gnus-summary-reply-with-original + "L" #'gnus-summary-reply-to-list-with-original + "w" #'gnus-summary-wide-reply + "W" #'gnus-summary-wide-reply-with-original + "v" #'gnus-summary-very-wide-reply + "V" #'gnus-summary-very-wide-reply-with-original + "n" #'gnus-summary-followup-to-mail + "N" #'gnus-summary-followup-to-mail-with-original + "m" #'gnus-summary-mail-other-window + "u" #'gnus-uu-post-news + "A" #'gnus-summary-attach-article + "M-c" #'gnus-summary-mail-crosspost-complaint + "B r" #'gnus-summary-reply-broken-reply-to + "B R" #'gnus-summary-reply-broken-reply-to-with-original + "o m" #'gnus-summary-mail-forward + "o p" #'gnus-summary-post-forward + "O m" #'gnus-uu-digest-mail-forward + "O p" #'gnus-uu-digest-post-forward + + "D" (define-keymap :prefix 'gnus-send-bounce-map + "b" #'gnus-summary-resend-bounced-mail + ;; "c" gnus-summary-send-draft + "r" #'gnus-summary-resend-message + "e" #'gnus-summary-resend-message-edit)) ;;; Internal functions. @@ -1305,7 +1263,7 @@ For the \"inline\" alternatives, also see the variable (gnus-inews-insert-gcc) (let ((gcc (message-unquote-tokens (message-tokenize-header (mail-fetch-field "gcc" nil t) - " ,"))) + ","))) (self (with-current-buffer gnus-summary-buffer gnus-gcc-self-resent-messages))) (message-remove-header "gcc") @@ -1571,8 +1529,9 @@ this is a reply." (when gcc (message-remove-header "gcc") (widen) - (setq groups (message-unquote-tokens - (message-tokenize-header gcc " ,\n\t"))) + (setq groups (mapcar #'string-trim + (message-unquote-tokens + (message-tokenize-header gcc)))) ;; Copy the article over to some group(s). (while (setq group (pop groups)) (setq method (gnus-inews-group-method group)) @@ -1593,9 +1552,10 @@ this is a reply." (nnheader-set-temp-buffer " *acc*") (setq message-options (with-current-buffer cur message-options)) (insert-buffer-substring cur) + (restore-buffer-modified-p nil) (run-hooks 'gnus-gcc-pre-body-encode-hook) ;; Avoid re-doing things like GPG-encoding secret parts. - (if (not encoded-cache) + (if (or (buffer-modified-p) (not encoded-cache)) (message-encode-message-body) (erase-buffer) (insert encoded-cache)) @@ -1663,7 +1623,7 @@ this is a reply." (defun gnus-inews-insert-gcc (&optional group) "Insert the Gcc to say where the article is to be archived." (let* ((group (or group gnus-newsgroup-name)) - (var (or gnus-outgoing-message-group gnus-message-archive-group)) + (var gnus-message-archive-group) (gcc-self-val (and group (not (gnus-virtual-group-p group)) (gnus-group-find-parameter group 'gcc-self t))) @@ -1748,7 +1708,7 @@ this is a reply." (concat "\"" str "\"") str))) (when groups - (insert " "))) + (insert ","))) (insert "\n"))))))) (defun gnus-mailing-list-followup-to () diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index d0edf2cba85..012ac9d556f 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -220,13 +220,13 @@ replacement is added." (error 0))) spec))) (when (> len 0) - (goto-char (point-at-eol)) + (goto-char (line-end-position)) (insert (propertize " " 'display (cons 'space (list :align-to (- (window-width) 1 len)))))) - (goto-char (point-at-eol)) - (setq point (point-at-eol)) + (goto-char (line-end-position)) + (setq point (line-end-position)) (dolist (image spec) (unless (stringp image) (goto-char point) diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index da3ff473725..2b9d7fac1db 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -26,10 +26,8 @@ ;;; List and range functions -(defsubst gnus-range-normalize (range) - "Normalize RANGE. -If RANGE is a single range, return (RANGE). Otherwise, return RANGE." - (if (listp (cdr-safe range)) range (list range))) +(require 'range) +(define-obsolete-function-alias 'gnus-range-normalize #'range-normalize "29.1") (defun gnus-last-element (list) "Return last element of LIST." @@ -38,10 +36,10 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE." (car list)) (make-obsolete 'gnus-last-element "use `car' of `last' instead." "27.1") -(define-obsolete-function-alias 'gnus-copy-sequence 'copy-tree "27.1") +(define-obsolete-function-alias 'gnus-copy-sequence #'copy-tree "27.1") -;;; We could be using `seq-difference' here, but it's much slower -;;; on these data sets. See bug#50877. +;; We could be using `seq-difference' here, but it's much slower +;; on these data sets. See bug#50877. (defun gnus-set-difference (list1 list2) "Return a list of elements of LIST1 that do not appear in LIST2." (let ((hash2 (make-hash-table :test 'eq)) @@ -56,10 +54,10 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE." "Return a range comprising all the RANGES, which are pre-sorted. RANGES will be destructively altered." (setq ranges (delete nil ranges)) - (let* ((result (gnus-range-normalize (pop ranges))) + (let* ((result (range-normalize (pop ranges))) (last (last result))) (dolist (range ranges) - (setq range (gnus-range-normalize range)) + (setq range (range-normalize range)) ;; Normalize the single-number case, so that we don't need to ;; special-case that so much. (when (numberp (car last)) @@ -82,47 +80,8 @@ RANGES will be destructively altered." (car result) result))) -(defun gnus-range-difference (range1 range2) - "Return the range of elements in RANGE1 that do not appear in RANGE2. -Both ranges must be in ascending order." - (setq range1 (gnus-range-normalize range1)) - (setq range2 (gnus-range-normalize range2)) - (let* ((new-range (cons nil (copy-sequence range1))) - (r new-range) - ) ;; (safe t) - (while (cdr r) - (let* ((r1 (cadr r)) - (r2 (car range2)) - (min1 (if (numberp r1) r1 (car r1))) - (max1 (if (numberp r1) r1 (cdr r1))) - (min2 (if (numberp r2) r2 (car r2))) - (max2 (if (numberp r2) r2 (cdr r2)))) - - (cond ((> min1 max1) - ;; Invalid range: may result from overlap condition (below) - ;; remove Invalid range - (setcdr r (cddr r))) - ((and (= min1 max1) - (listp r1)) - ;; Inefficient representation: may result from overlap condition (below) - (setcar (cdr r) min1)) - ((not min2) - ;; All done with range2 - (setq r nil)) - ((< max1 min2) - ;; No overlap: range1 precedes range2 - (pop r)) - ((< max2 min1) - ;; No overlap: range2 precedes range1 - (pop range2)) - ((and (<= min2 min1) (<= max1 max2)) - ;; Complete overlap: range1 removed - (setcdr r (cddr r))) - (t - (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r))))))) - (cdr new-range))) - - +(define-obsolete-function-alias 'gnus-range-difference + #'range-difference "29.1") ;;;###autoload (defun gnus-sorted-difference (list1 list2) @@ -200,60 +159,11 @@ LIST1 and LIST2 have to be sorted over <." (setq list2 (cdr list2))))) (nreverse out))) -;;;###autoload -(defun gnus-sorted-range-intersection (range1 range2) - "Return intersection of RANGE1 and RANGE2. -RANGE1 and RANGE2 have to be sorted over <." - (let* (out - (min1 (car range1)) - (max1 (if (numberp min1) - (if (numberp (cdr range1)) - (prog1 (cdr range1) - (setq range1 nil)) min1) - (prog1 (cdr min1) - (setq min1 (car min1))))) - (min2 (car range2)) - (max2 (if (numberp min2) - (if (numberp (cdr range2)) - (prog1 (cdr range2) - (setq range2 nil)) min2) - (prog1 (cdr min2) - (setq min2 (car min2)))))) - (setq range1 (cdr range1) - range2 (cdr range2)) - (while (and min1 min2) - (cond ((< max1 min2) ; range1 precedes range2 - (setq range1 (cdr range1) - min1 nil)) - ((< max2 min1) ; range2 precedes range1 - (setq range2 (cdr range2) - min2 nil)) - (t ; some sort of overlap is occurring - (let ((min (max min1 min2)) - (max (min max1 max2))) - (setq out (if (= min max) - (cons min out) - (cons (cons min max) out)))) - (if (< max1 max2) ; range1 ends before range2 - (setq min1 nil) ; incr range1 - (setq min2 nil)))) ; incr range2 - (unless min1 - (setq min1 (car range1) - max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1)))) - range1 (cdr range1))) - (unless min2 - (setq min2 (car range2) - max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2)))) - range2 (cdr range2)))) - (cond ((cdr out) - (nreverse out)) - ((numberp (car out)) - out) - (t - (car out))))) +(define-obsolete-function-alias 'gnus-sorted-range-intersection + #'range-intersection "29.1") ;;;###autoload -(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection) +(defalias 'gnus-set-sorted-intersection #'gnus-sorted-nintersection) ;;;###autoload (defun gnus-sorted-nintersection (list1 list2) @@ -327,315 +237,33 @@ LIST1 and LIST2 have to be sorted over <." "Convert sorted list of numbers to a list of ranges or a single range. If ALWAYS-LIST is non-nil, this function will always release a list of ranges." - (let* ((first (car numbers)) - (last (car numbers)) - result) - (if (null numbers) - nil - (if (not (listp (cdr numbers))) - numbers - (while numbers - (cond ((= last (car numbers)) nil) ;Omit duplicated number - ((= (1+ last) (car numbers)) ;Still in sequence - (setq last (car numbers))) - (t ;End of one sequence - (setq result - (cons (if (= first last) first - (cons first last)) - result)) - (setq first (car numbers)) - (setq last (car numbers)))) - (setq numbers (cdr numbers))) - (if (and (not always-list) (null result)) - (if (= first last) (list first) (cons first last)) - (nreverse (cons (if (= first last) first (cons first last)) - result))))))) - -(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) -(defun gnus-uncompress-range (ranges) - "Expand a list of ranges into a list of numbers. -RANGES is either a single range on the form `(num . num)' or a list of -these ranges." - (let (first last result) - (cond - ((null ranges) - nil) - ((not (listp (cdr ranges))) - (setq first (car ranges)) - (setq last (cdr ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first))) - (nreverse result)) - (t - (while ranges - (if (atom (car ranges)) - (when (numberp (car ranges)) - (setq result (cons (car ranges) result))) - (setq first (caar ranges)) - (setq last (cdar ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first)))) - (setq ranges (cdr ranges))) - (nreverse result))))) - -(defun gnus-add-to-range (ranges list) - "Return a list of ranges that has all articles from both RANGES and LIST. -Note: LIST has to be sorted over `<'." - (if (not ranges) - (gnus-compress-sequence list t) - (setq list (copy-sequence list)) - (unless (listp (cdr ranges)) - (setq ranges (list ranges))) - (let ((out ranges) - ilist lowest highest temp) - (while (and ranges list) - (setq ilist list) - (setq lowest (or (and (atom (car ranges)) (car ranges)) - (caar ranges))) - (while (and list (cdr list) (< (cadr list) lowest)) - (setq list (cdr list))) - (when (< (car ilist) lowest) - (setq temp list) - (setq list (cdr list)) - (setcdr temp nil) - (setq out (nconc (gnus-compress-sequence ilist t) out))) - (setq highest (or (and (atom (car ranges)) (car ranges)) - (cdar ranges))) - (while (and list (<= (car list) highest)) - (setq list (cdr list))) - (setq ranges (cdr ranges))) - (when list - (setq out (nconc (gnus-compress-sequence list t) out))) - (setq out (sort out (lambda (r1 r2) - (< (or (and (atom r1) r1) (car r1)) - (or (and (atom r2) r2) (car r2)))))) - (setq ranges out) - (while ranges - (if (atom (car ranges)) - (when (cdr ranges) - (if (atom (cadr ranges)) - (when (= (1+ (car ranges)) (cadr ranges)) - (setcar ranges (cons (car ranges) - (cadr ranges))) - (setcdr ranges (cddr ranges))) - (when (= (1+ (car ranges)) (caadr ranges)) - (setcar (cadr ranges) (car ranges)) - (setcar ranges (cadr ranges)) - (setcdr ranges (cddr ranges))))) - (when (cdr ranges) - (if (atom (cadr ranges)) - (when (= (1+ (cdar ranges)) (cadr ranges)) - (setcdr (car ranges) (cadr ranges)) - (setcdr ranges (cddr ranges))) - (when (= (1+ (cdar ranges)) (caadr ranges)) - (setcdr (car ranges) (cdadr ranges)) - (setcdr ranges (cddr ranges)))))) - (setq ranges (cdr ranges))) - out))) - -(defun gnus-remove-from-range (range1 range2) - "Return a range that has all articles from RANGE2 removed from RANGE1. -The returned range is always a list. RANGE2 can also be a unsorted -list of articles. RANGE1 is modified by side effects, RANGE2 is not -modified." - (if (or (null range1) (null range2)) - range1 - (let (out r1 r2 r1_min r1_max r2_min r2_max - (range2 (copy-tree range2))) - (setq range1 (if (listp (cdr range1)) range1 (list range1)) - range2 (sort (if (listp (cdr range2)) range2 (list range2)) - (lambda (e1 e2) - (< (if (consp e1) (car e1) e1) - (if (consp e2) (car e2) e2)))) - r1 (car range1) - r2 (car range2) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1) - r2_min (if (consp r2) (car r2) r2) - r2_max (if (consp r2) (cdr r2) r2)) - (while (and range1 range2) - (cond ((< r2_max r1_min) ; r2 < r1 - (pop range2) - (setq r2 (car range2) - r2_min (if (consp r2) (car r2) r2) - r2_max (if (consp r2) (cdr r2) r2))) - ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1 - (pop range1) - (setq r1 (car range1) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1))) - ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1 - (pop range2) - (setq r1_min (1+ r2_max) - r2 (car range2) - r2_min (if (consp r2) (car r2) r2) - r2_max (if (consp r2) (cdr r2) r2))) - ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1 - (if (eq r1_min (1- r2_min)) - (push r1_min out) - (push (cons r1_min (1- r2_min)) out)) - (pop range2) - (if (< r2_max r1_max) ; finished with r1? - (setq r1_min (1+ r2_max)) - (pop range1) - (setq r1 (car range1) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1))) - (setq r2 (car range2) - r2_min (if (consp r2) (car r2) r2) - r2_max (if (consp r2) (cdr r2) r2))) - ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1 - (if (eq r1_min (1- r2_min)) - (push r1_min out) - (push (cons r1_min (1- r2_min)) out)) - (pop range1) - (setq r1 (car range1) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1))) - ((< r1_max r2_min) ; r2 > r1 - (pop range1) - (if (eq r1_min r1_max) - (push r1_min out) - (push (cons r1_min r1_max) out)) - (setq r1 (car range1) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1))))) - (when r1 - (if (eq r1_min r1_max) - (push r1_min out) - (push (cons r1_min r1_max) out)) - (pop range1)) - (while range1 - (push (pop range1) out)) - (nreverse out)))) - -(defun gnus-member-of-range (number ranges) - (if (not (listp (cdr ranges))) - (and (>= number (car ranges)) - (<= number (cdr ranges))) - (let ((not-stop t)) - (while (and ranges - (if (numberp (car ranges)) - (>= number (car ranges)) - (>= number (caar ranges))) - not-stop) - (when (if (numberp (car ranges)) - (= number (car ranges)) - (and (>= number (caar ranges)) - (<= number (cdar ranges)))) - (setq not-stop nil)) - (setq ranges (cdr ranges))) - (not not-stop)))) - -(defun gnus-list-range-intersection (list ranges) - "Return a list of numbers in LIST that are members of RANGES. -LIST is a sorted list." - (setq ranges (gnus-range-normalize ranges)) - (let (number result) - (while (setq number (pop list)) - (while (and ranges - (if (numberp (car ranges)) - (< (car ranges) number) - (< (cdar ranges) number))) - (setq ranges (cdr ranges))) - (when (and ranges - (if (numberp (car ranges)) - (= (car ranges) number) - ;; (caar ranges) <= number <= (cdar ranges) - (>= number (caar ranges)))) - (push number result))) - (nreverse result))) + (if always-list + (range-compress-list numbers) + (range-denormalize (range-compress-list numbers)))) -(defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference) - -(defun gnus-list-range-difference (list ranges) - "Return a list of numbers in LIST that are not members of RANGES. -LIST is a sorted list." - (setq ranges (gnus-range-normalize ranges)) - (let (number result) - (while (setq number (pop list)) - (while (and ranges - (if (numberp (car ranges)) - (< (car ranges) number) - (< (cdar ranges) number))) - (setq ranges (cdr ranges))) - (when (or (not ranges) - (if (numberp (car ranges)) - (not (= (car ranges) number)) - ;; not ((caar ranges) <= number <= (cdar ranges)) - (< number (caar ranges)))) - (push number result))) - (nreverse result))) +(defalias 'gnus-uncompress-sequence #'gnus-uncompress-range) +(define-obsolete-function-alias 'gnus-uncompress-range + #'range-uncompress "29.1") + +(define-obsolete-function-alias 'gnus-add-to-range + #'range-add-list "29.1") + +(define-obsolete-function-alias 'gnus-remove-from-range + #'range-remove "29.1") + +(define-obsolete-function-alias 'gnus-member-of-range #'range-member-p "29.1") + +(define-obsolete-function-alias 'gnus-list-range-intersection + #'range-list-intersection "29.1") + +(defalias 'gnus-inverse-list-range-intersection #'range-list-difference) + +(define-obsolete-function-alias 'gnus-list-range-difference + #'range-list-difference "29.1") + +(define-obsolete-function-alias 'gnus-range-length #'range-length "29.1") -(defun gnus-range-length (range) - "Return the length RANGE would have if uncompressed." - (cond - ((null range) - 0) - ((not (listp (cdr range))) - (- (cdr range) (car range) -1)) - (t - (let ((sum 0)) - (dolist (x range sum) - (setq sum - (+ sum (if (consp x) (- (cdr x) (car x) -1) 1)))))))) - -(defun gnus-range-add (range1 range2) - "Add RANGE2 to RANGE1 (nondestructively)." - (unless (listp (cdr range1)) - (setq range1 (list range1))) - (unless (listp (cdr range2)) - (setq range2 (list range2))) - (let ((item1 (pop range1)) - (item2 (pop range2)) - range item selector) - (while (or item1 item2) - (setq selector - (cond - ((null item1) nil) - ((null item2) t) - ((and (numberp item1) (numberp item2)) (< item1 item2)) - ((numberp item1) (< item1 (car item2))) - ((numberp item2) (< (car item1) item2)) - (t (< (car item1) (car item2))))) - (setq item - (or - (let ((tmp1 item) (tmp2 (if selector item1 item2))) - (cond - ((null tmp1) tmp2) - ((null tmp2) tmp1) - ((and (numberp tmp1) (numberp tmp2)) - (cond - ((eq tmp1 tmp2) tmp1) - ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2)) - ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1)) - (t nil))) - ((numberp tmp1) - (cond - ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2) - ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2))) - ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1)) - (t nil))) - ((numberp tmp2) - (cond - ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1) - ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1))) - ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2)) - (t nil))) - ((< (1+ (cdr tmp1)) (car tmp2)) nil) - ((< (1+ (cdr tmp2)) (car tmp1)) nil) - (t (cons (min (car tmp1) (car tmp2)) - (max (cdr tmp1) (cdr tmp2)))))) - (progn - (if item (push item range)) - (if selector item1 item2)))) - (if selector - (setq item1 (pop range1)) - (setq item2 (pop range2)))) - (if item (push item range)) - (reverse range))) +(define-obsolete-function-alias 'gnus-range-add #'range-concat "29.1") ;;;###autoload (defun gnus-add-to-sorted-list (list num) @@ -649,18 +277,7 @@ LIST is a sorted list." (setcdr prev (cons num list))) (cdr top))) -(defun gnus-range-map (func range) - "Apply FUNC to each value contained by RANGE." - (setq range (gnus-range-normalize range)) - (while range - (let ((span (pop range))) - (if (numberp span) - (funcall func span) - (let ((first (car span)) - (last (cdr span))) - (while (<= first last) - (funcall func first) - (setq first (1+ first)))))))) +(define-obsolete-function-alias 'gnus-range-map #'range-map "29.1") (provide 'gnus-range) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index e41b74fbd92..ceeb1848542 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -163,7 +163,9 @@ nnmairix groups are specifically excluded because they are ephemeral." :type 'boolean :version "28.1") -(defvar gnus-registry-enabled nil) +(make-obsolete-variable + 'gnus-registry-enabled + "Check for non-nil value of `gnus-registry-db'" "29.1") (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. @@ -355,8 +357,12 @@ This is not required after changing `gnus-registry-cache-file'." "Load the registry from the cache file." (interactive) (let ((file gnus-registry-cache-file)) + (gnus-message 5 "Initializing the registry") (condition-case nil - (gnus-registry-read file) + (progn + (gnus-registry-read file) + (gnus-registry-install-hooks) + (gnus-registry-install-shortcuts)) (file-error ;; Fix previous mis-naming of the registry file. (let ((old-file-name @@ -846,8 +852,9 @@ Overrides existing keywords with FORCE set non-nil." (defun gnus-registry-register-message-ids () "Register the Message-ID of every article in the group." - (unless (or (gnus-parameter-registry-ignore gnus-newsgroup-name) - (null gnus-registry-register-all)) + (unless (or (null gnus-registry-db) + (null gnus-registry-register-all) + (gnus-parameter-registry-ignore gnus-newsgroup-name)) (dolist (article gnus-newsgroup-articles) (let* ((id (gnus-registry-fetch-message-id-fast article)) (groups (gnus-registry-get-id-key id 'group))) @@ -948,13 +955,12 @@ FUNCTION should take two parameters, a mark symbol and the cell value." (defun gnus-registry-install-shortcuts () "Install the keyboard shortcuts and menus for the registry. Uses `gnus-registry-marks' to find what shortcuts to install." - (let (keys-plist) - (setq gnus-registry-misc-menus nil) - (gnus-registry-do-marks - :char - (lambda (mark data) - (let ((function-format - (format "gnus-registry-%%s-article-%s-mark" mark))) + (setq gnus-registry-misc-menus nil) + (gnus-registry-do-marks + :char + (lambda (mark data) + (let ((function-format + (format "gnus-registry-%%s-article-%s-mark" mark))) ;;; The following generates these functions: ;;; (defun gnus-registry-set-article-Important-mark (&rest articles) @@ -966,48 +972,43 @@ Uses `gnus-registry-marks' to find what shortcuts to install." ;;; (interactive (gnus-summary-work-articles current-prefix-arg)) ;;; (gnus-registry-set-article-mark-internal 'Important articles t t)) - (dolist (remove '(t nil)) - (let* ((variant-name (if remove "remove" "set")) - (function-name - (intern (format function-format variant-name))) - (shortcut (format "%c" (if remove (upcase data) data)))) - (defalias function-name - (lambda (&rest articles) - (:documentation - (format - "%s the %s mark over process-marked ARTICLES." - (upcase-initials variant-name) - mark)) - (interactive - (gnus-summary-work-articles current-prefix-arg)) - (gnus-registry--set/remove-mark mark remove articles))) - (push function-name keys-plist) - (push shortcut keys-plist) - (push (vector (format "%s %s" - (upcase-initials variant-name) - (symbol-name mark)) - function-name t) - gnus-registry-misc-menus) - (gnus-message 9 "Defined mark handling function %s" - function-name)))))) - (gnus-define-keys-1 - '(gnus-registry-mark-map "M" gnus-summary-mark-map) - keys-plist) - (add-hook 'gnus-summary-menu-hook - (lambda () - (easy-menu-add-item - gnus-summary-misc-menu - nil - (cons "Registry Marks" gnus-registry-misc-menus)))))) - -(define-obsolete-function-alias 'gnus-registry-user-format-function-M - #'gnus-registry-article-marks-to-chars "24.1") + (dolist (remove '(t nil)) + (let* ((variant-name (if remove "remove" "set")) + (function-name + (intern (format function-format variant-name))) + (shortcut (format "%c" (if remove (upcase data) data)))) + (defalias function-name + (lambda (&rest articles) + (:documentation + (format + "%s the %s mark over process-marked ARTICLES." + (upcase-initials variant-name) + mark)) + (interactive + (gnus-summary-work-articles current-prefix-arg)) + (gnus-registry--set/remove-mark mark remove articles))) + (keymap-set gnus-summary-mark-map + (concat "M " shortcut) + function-name) + (push (vector (format "%s %s" + (upcase-initials variant-name) + (symbol-name mark)) + function-name t) + gnus-registry-misc-menus) + (gnus-message 9 "Defined mark handling function %s" + function-name)))))) + (add-hook 'gnus-summary-menu-hook + (lambda () + (easy-menu-add-item + gnus-summary-misc-menu + nil + (cons "Registry Marks" gnus-registry-misc-menus))))) ;; use like this: ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars) (defun gnus-registry-article-marks-to-chars (headers) "Show the marks for an article by the :char property." - (if gnus-registry-enabled + (if gnus-registry-db (let* ((id (mail-header-message-id headers)) (marks (when id (gnus-registry-get-id-key id 'mark)))) (concat (delq nil @@ -1023,7 +1024,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install." ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names) (defun gnus-registry-article-marks-to-names (headers) "Show the marks for an article by name." - (if gnus-registry-enabled + (if gnus-registry-db (let* ((id (mail-header-message-id headers)) (marks (when id (gnus-registry-get-id-key id 'mark)))) (mapconcat #'symbol-name marks ",")) @@ -1142,7 +1143,7 @@ non-nil." entry) (while (car-safe old) (cl-incf count) - ;; don't use progress reporters for backwards compatibility + ;; todo: use progress reporters. (when (and (< 0 expected) (= 0 (mod count 100))) (message "importing: %d of %d (%.2f%%)" @@ -1182,16 +1183,12 @@ non-nil." (defun gnus-registry-initialize () "Initialize the Gnus registry." (interactive) - (gnus-message 5 "Initializing the registry") - (gnus-registry-install-hooks) - (gnus-registry-install-shortcuts) (if (gnus-alive-p) (gnus-registry-load) (add-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load))) (defun gnus-registry-install-hooks () "Install the registry hooks." - (setq gnus-registry-enabled t) (add-hook 'gnus-summary-article-move-hook #'gnus-registry-action) (add-hook 'gnus-summary-article-delete-hook #'gnus-registry-action) (add-hook 'gnus-summary-article-expire-hook #'gnus-registry-action) @@ -1211,17 +1208,16 @@ non-nil." (remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save) (remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load) - (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids) - (setq gnus-registry-enabled nil)) + (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)) -(add-hook 'gnus-registry-unload-hook #'gnus-registry-unload-hook) +(add-hook 'gnus-registry-unload-hook #'gnus-registry-clear) (defun gnus-registry-install-p () "Return non-nil if the registry is enabled (and maybe enable it first). If the registry is not already enabled, then if `gnus-registry-install' is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it." (interactive) - (unless gnus-registry-enabled + (unless gnus-registry-db (when (if (eq gnus-registry-install 'ask) (gnus-y-or-n-p (concat "Enable the Gnus registry? " @@ -1229,7 +1225,7 @@ is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it." "to get rid of this query permanently. ")) gnus-registry-install) (gnus-registry-initialize))) - gnus-registry-enabled) + (null (null gnus-registry-db))) ;; largely based on nnselect-warp-to-article (defun gnus-try-warping-via-registry () diff --git a/lisp/gnus/gnus-rmail.el b/lisp/gnus/gnus-rmail.el new file mode 100644 index 00000000000..15ead1add41 --- /dev/null +++ b/lisp/gnus/gnus-rmail.el @@ -0,0 +1,142 @@ +;;; gnus-rmail.el --- Saving to rmail/babyl files -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2022 Free Software Foundation, Inc. + +;; 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. + +;; 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +;;; Functions for saving to babyl/mail files. + +(require 'rmail) +(require 'rmailsum) +(require 'nnmail) + +(defun gnus-output-to-rmail (filename &optional ask) + "Append the current article to an Rmail file named FILENAME. +In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless +FILENAME exists and is Babyl format." + ;; Some of this codes is borrowed from rmailout.el. + (setq filename (expand-file-name filename)) + ;; FIXME should we really be messing with this defcustom? + ;; It is not needed for the operation of this function. + (if (boundp 'rmail-default-rmail-file) + (setq rmail-default-rmail-file filename) ; 22 + (setq rmail-default-file filename)) ; 23 + (let ((artbuf (current-buffer)) + (tmpbuf (gnus-get-buffer-create " *Gnus-output*")) + ;; Babyl rmail.el defines this, mbox does not. + (babyl (fboundp 'rmail-insert-rmail-file-header))) + (save-excursion + ;; Note that we ignore the possibility of visiting a Babyl + ;; format buffer in Emacs 23, since Rmail no longer supports that. + (or (get-file-buffer filename) + (progn + ;; In case someone wants to write to a Babyl file from Emacs 23. + (when (file-exists-p filename) + (setq babyl (mail-file-babyl-p filename)) + t)) + (if (or (not ask) + (gnus-yes-or-no-p + (concat "\"" filename "\" does not exist, create it? "))) + (let ((file-buffer (create-file-buffer filename))) + (with-current-buffer file-buffer + (if (fboundp 'rmail-insert-rmail-file-header) + (rmail-insert-rmail-file-header)) + (let ((require-final-newline nil) + (coding-system-for-write mm-text-coding-system)) + (gnus-write-buffer filename))) + (kill-buffer file-buffer)) + (error "Output file does not exist"))) + (set-buffer tmpbuf) + (erase-buffer) + (insert-buffer-substring artbuf) + (if babyl + (gnus-convert-article-to-rmail) + ;; Non-Babyl case copied from gnus-output-to-mail. + (goto-char (point-min)) + (if (looking-at "From ") + (forward-line 1) + (insert "From nobody " (current-time-string) "\n")) + (let (case-fold-search) + (while (re-search-forward "^From " nil t) + (beginning-of-line) + (insert ">")))) + ;; Decide whether to append to a file or to an Emacs buffer. + (let ((outbuf (get-file-buffer filename))) + (if (not outbuf) + (progn + (unless babyl ; from gnus-output-to-mail + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (forward-char -2) + (unless (looking-at "\n\n") + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert "\n")))) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (mm-append-to-file (point-min) (point-max) filename))) + ;; File has been visited, in buffer OUTBUF. + (set-buffer outbuf) + (let ((buffer-read-only nil) + (msg (and (boundp 'rmail-current-message) + (symbol-value 'rmail-current-message)))) + ;; If MSG is non-nil, buffer is in RMAIL mode. + ;; Compare this with rmail-output-to-rmail-buffer in Emacs 23. + (when msg + (unless babyl + (rmail-swap-buffers-maybe) + (rmail-maybe-set-message-counters)) + (widen) + (unless babyl + (goto-char (point-max)) + ;; Ensure we have a blank line before the next message. + (unless (bolp) + (insert "\n")) + (insert "\n")) + (narrow-to-region (point-max) (point-max))) + (insert-buffer-substring tmpbuf) + (when msg + (when babyl + (goto-char (point-min)) + (widen) + (search-backward "\n\^_") + (narrow-to-region (point) (point-max))) + (rmail-count-new-messages t) + (when (rmail-summary-exists) + (rmail-select-summary + (rmail-update-summary))) + (rmail-show-message msg)) + (save-buffer))))) + (kill-buffer tmpbuf))) + +(defun gnus-convert-article-to-rmail () + "Convert article in current buffer to Rmail message format." + (let ((buffer-read-only nil)) + ;; Convert article directly into Babyl format. + (goto-char (point-min)) + (insert "\^L\n0, unseen,,\n*** EOOH ***\n") + (while (search-forward "\n\^_" nil t) ;single char + (replace-match "\n^_" t t)) ;2 chars: "^" and "_" + (goto-char (point-max)) + (insert "\^_"))) + +;;; gnus-rmail.el ends here diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index b39ee32f118..6b7958dcb91 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -64,15 +64,12 @@ It accepts the same format specs that `gnus-summary-line-format' does." ;;; Internal variables. -(defvar gnus-pick-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - " " gnus-pick-next-page - "u" gnus-pick-unmark-article-or-thread - "." gnus-pick-article-or-thread - [down-mouse-2] gnus-pick-mouse-pick-region - "\r" gnus-pick-start-reading) - map)) +(defvar-keymap gnus-pick-mode-map + "SPC" #'gnus-pick-next-page + "u" #'gnus-pick-unmark-article-or-thread + "." #'gnus-pick-article-or-thread + "<down-mouse-2>" #'gnus-pick-mouse-pick-region + "RET" #'gnus-pick-start-reading) (defun gnus-pick-make-menu-bar () (unless (boundp 'gnus-pick-menu) @@ -136,9 +133,7 @@ It accepts the same format specs that `gnus-summary-line-format' does." (defun gnus-pick-start-reading (&optional catch-up) "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)))) + (interactive "P" gnus-pick-mode) (if gnus-newsgroup-processable (progn (gnus-summary-limit-to-articles nil) @@ -315,11 +310,8 @@ This must be bound to a button-down mouse event." (defvar gnus-binary-mode-hook nil "Hook run in summary binary mode buffers.") -(defvar gnus-binary-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "g" gnus-binary-show-article) - map)) +(defvar-keymap gnus-binary-mode-map + "g" #'gnus-binary-show-article) (defun gnus-binary-make-menu-bar () (unless (boundp 'gnus-binary-menu) @@ -424,21 +416,17 @@ Two predefined functions are available: (defvar gnus-tree-displayed-thread nil) (defvar gnus-tree-inhibit nil) -(defvar gnus-tree-mode-map - (let ((map (make-keymap))) - (suppress-keymap map) - (gnus-define-keys - map - "\r" gnus-tree-select-article - [mouse-2] gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - "h" gnus-tree-show-summary +(defvar-keymap gnus-tree-mode-map + :full t :suppress t + "RET" #'gnus-tree-select-article + "<mouse-2>" #'gnus-tree-pick-article + "DEL" #'gnus-tree-read-summary-keys + "h" #'gnus-tree-show-summary - "\C-c\C-i" gnus-info-find-node) + "C-c C-i" #'gnus-info-find-node) - (substitute-key-definition - 'undefined 'gnus-tree-read-summary-keys map) - map)) +(substitute-key-definition 'undefined #'gnus-tree-read-summary-keys + gnus-tree-mode-map) (defun gnus-tree-make-menu-bar () (unless (boundp 'gnus-tree-menu) @@ -698,7 +686,7 @@ it in the environment specified by BINDINGS." (unless (zerop level) (gnus-tree-indent level) (insert (cadr gnus-tree-parent-child-edges)) - (setq col (- (setq beg (point)) (point-at-bol) 1)) + (setq col (- (setq beg (point)) (line-beginning-position) 1)) ;; Draw "|" lines upwards. (while (progn (forward-line -1) @@ -722,7 +710,7 @@ it in the environment specified by BINDINGS." (defsubst gnus-tree-indent-vertical () (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) - (- (point) (point-at-bol))))) + (- (point) (line-beginning-position))))) (when (> len 0) (insert (make-string len ? ))))) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 3b78a405fdb..5f49c280072 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -502,19 +502,20 @@ of the last successful match.") ;;; Summary mode score maps. -(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map) - "s" gnus-summary-set-score - "S" gnus-summary-current-score - "c" gnus-score-change-score-file - "C" gnus-score-customize - "m" gnus-score-set-mark-below - "x" gnus-score-set-expunge-below - "R" gnus-summary-rescore - "e" gnus-score-edit-current-scores - "f" gnus-score-edit-file - "F" gnus-score-flush-cache - "t" gnus-score-find-trace - "w" gnus-score-find-favorite-words) +(define-key gnus-summary-mode-map "V" + (define-keymap :prefix 'gnus-summary-score-map + "s" #'gnus-summary-set-score + "S" #'gnus-summary-current-score + "c" #'gnus-score-change-score-file + "C" #'gnus-score-customize + "m" #'gnus-score-set-mark-below + "x" #'gnus-score-set-expunge-below + "R" #'gnus-summary-rescore + "e" #'gnus-score-edit-current-scores + "f" #'gnus-score-edit-file + "F" #'gnus-score-flush-cache + "t" #'gnus-score-find-trace + "w" #'gnus-score-find-favorite-words)) ;; Summary score file commands @@ -1167,9 +1168,9 @@ If FORMAT, also format the current score file." (reg " -> +") (file (save-excursion (end-of-line) - (if (and (re-search-backward reg (point-at-bol) t) - (re-search-forward reg (point-at-eol) t)) - (buffer-substring (point) (point-at-eol)) + (if (and (re-search-backward reg (line-beginning-position) t) + (re-search-forward reg (line-end-position) t)) + (buffer-substring (point) (line-end-position)) nil)))) (if (or (not file) (string-match "\\<\\(non-file rule\\|A file\\)\\>" file) @@ -1748,7 +1749,7 @@ score in `gnus-newsgroup-scored' by SCORE." (setq type 'after match-func 'string< match (gnus-time-iso8601 - (time-subtract (current-time) + (time-subtract nil (* 86400 (nth 0 kill)))))) ((eq type 'before) (setq match-func 'gnus-string> @@ -1757,7 +1758,7 @@ score in `gnus-newsgroup-scored' by SCORE." (setq type 'before match-func 'gnus-string> match (gnus-time-iso8601 - (time-subtract (current-time) + (time-subtract nil (* 86400 (nth 0 kill)))))) ((eq type 'at) (setq match-func 'string= @@ -1998,7 +1999,7 @@ score in `gnus-newsgroup-scored' by SCORE." (goto-char (point-min)) (if (= dmt ?e) (while (funcall search-func match nil t) - (and (= (point-at-bol) + (and (= (line-beginning-position) (match-beginning 0)) (= (progn (end-of-line) (point)) (match-end 0)) @@ -2169,7 +2170,7 @@ score in `gnus-newsgroup-scored' by SCORE." (funcall search-func match nil t)) ;; Is it really exact? (and (eolp) - (= (point-at-bol) (match-beginning 0)) + (= (line-beginning-position) (match-beginning 0)) ;; Yup. (progn (setq found (setq arts (get-text-property @@ -2259,7 +2260,7 @@ score in `gnus-newsgroup-scored' by SCORE." (goto-char (point-min)) (while (and (not (eobp)) (search-forward match nil t)) - (when (and (= (point-at-bol) (match-beginning 0)) + (when (and (= (line-beginning-position) (match-beginning 0)) (eolp)) (setq found (setq arts (get-text-property (point) 'articles))) (if trace @@ -2343,7 +2344,7 @@ score in `gnus-newsgroup-scored' by SCORE." hashtb)) (puthash word - (append (get-text-property (point-at-eol) 'articles) val) + (append (get-text-property (line-end-position) 'articles) val) hashtb))) ;; Make all the ignorable words ignored. (let ((ignored (append gnus-ignored-adaptive-words @@ -2561,16 +2562,17 @@ score in `gnus-newsgroup-scored' by SCORE." (or (caddr s) gnus-score-interactive-default-score)) trace)))) - (insert - "\n\nQuick help: + (insert + (substitute-command-keys + "\n\nQuick help: -Type `e' to edit score file corresponding to the score rule on current line, -`f' to format (pretty print) the score file and edit it, -`t' toggle to truncate long lines in this buffer, -`q' to quit, `k' to kill score trace buffer. +Type \\`e' to edit score file corresponding to the score rule on current line, +\\`f' to format (pretty print) the score file and edit it, +\\`t' toggle to truncate long lines in this buffer, +\\`q' to quit, \\`k' to kill score trace buffer. The first sexp on each line is the score rule, followed by the file name of -the score file and its full name, including the directory.") +the score file and its full name, including the directory.")) (goto-char (point-min)) (gnus-configure-windows 'score-trace))) (set-buffer gnus-summary-buffer) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 424f11a6b96..327dba95c07 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -105,9 +105,13 @@ (gnus-add-shutdown #'gnus-search-shutdown 'gnus) -(define-error 'gnus-search-parse-error "Gnus search parsing error") +(define-error 'gnus-search-error "Gnus search error") -(define-error 'gnus-search-config-error "Gnus search configuration error") +(define-error 'gnus-search-parse-error "Gnus search parsing error" + 'gnus-search-error) + +(define-error 'gnus-search-config-error "Gnus search configuration error" + 'gnus-search-error) ;;; User Customizable Variables: @@ -163,10 +167,9 @@ Instead, use this: This variable can also be set per-server." :type '(repeat string)) -(defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-swish++-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by swish++ -in order to get a group name (albeit with / instead of .). This is a -regular expression. +in order to get a group name (albeit with / instead of .). This variable can also be set per-server." :type 'regexp) @@ -200,10 +203,9 @@ This variable can also be set per-server." :type '(repeat string) :version "28.1") -(defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-swish-e-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by swish-e -in order to get a group name (albeit with / instead of .). This is a -regular expression. +in order to get a group name (albeit with / instead of .). This variable can also be set per-server." :type 'regexp @@ -248,7 +250,7 @@ This variable can also be set per-server." :type '(repeat string) :version "28.1") -(defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-namazu-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by Namazu in order to get a group name (albeit with / instead of .). @@ -292,10 +294,9 @@ This variable can also be set per-server." :type '(repeat string) :version "28.1") -(defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-notmuch-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by notmuch -in order to get a group name (albeit with / instead of .). This is a -regular expression. +in order to get a group name (albeit with / instead of .). This variable can also be set per-server." :type 'regexp @@ -335,10 +336,9 @@ This variable can also be set per-server." :version "28.1" :type '(repeat string)) -(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-mairix-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by mairix -in order to get a group name (albeit with / instead of .). This is a -regular expression. +in order to get a group name (albeit with / instead of .). This variable can also be set per-server." :version "28.1" @@ -349,6 +349,41 @@ This variable can also be set per-server." :version "28.1" :type 'boolean) +(defcustom gnus-search-mu-program "mu" + "Name of the mu search executable. +This can also be set per-server." + :version "29.1" + :type 'string) + +(defcustom gnus-search-mu-switches nil + "A list of strings, to be given as additional arguments to mu. +Note that this should be a list. I.e., do NOT use the following: + (setq gnus-search-mu-switches \"-u -r\") +Instead, use this: + (setq gnus-search-mu-switches \\='(\"-u\" \"-r\")) +This can also be set per-server." + :version "29.1" + :type '(repeat string)) + +(defcustom gnus-search-mu-remove-prefix (expand-file-name "~/Mail/") + "A prefix to remove from the mu results to get a group name. +Usually this will be set to the path to your mail directory. This +can also be set per-server." + :version "29.1" + :type 'directory) + +(defcustom gnus-search-mu-config-directory (expand-file-name "~/.cache/mu") + "Configuration directory for mu. +This can also be set per-server." + :version "29.1" + :type 'file) + +(defcustom gnus-search-mu-raw-queries-p nil + "If t, all mu engines will only accept raw search query strings. +This can also be set per-server." + :version "29.1" + :type 'boolean) + ;; Options for search language parsing. (defcustom gnus-search-expandable-keys @@ -530,7 +565,7 @@ returning the one at the supplied position." (buffer-substring (point) (progn - (re-search-forward ":" (point-at-eol) t) + (re-search-forward ":" (line-end-position) t) (1- (point)))))) (value (gnus-search-query-return-string (when (looking-at-p "[\"/]") t)))) @@ -568,15 +603,13 @@ REL-DATE, or (current-time) if REL-DATE is nil." ;; Time parsing doesn't seem to work with slashes. (let ((value (string-replace "/" "-" value)) (now (append '(0 0 0) - (seq-subseq (decode-time (or rel-date - (current-time))) - 3)))) + (seq-subseq (decode-time rel-date) 3)))) ;; Check for relative time parsing. (if (string-match "\\([[:digit:]]+\\)\\([dwmy]\\)" value) (seq-subseq (decode-time (time-subtract - (apply #'encode-time now) + (encode-time now) (days-to-time (* (string-to-number (match-string 1 value)) (cdr (assoc (match-string 2 value) @@ -595,7 +628,7 @@ REL-DATE, or (current-time) if REL-DATE is nil." ;; If DOW is given, handle that specially. (if (and (seq-elt d-time 6) (null (seq-elt d-time 3))) (decode-time - (time-subtract (apply #'encode-time now) + (time-subtract (encode-time now) (days-to-time (+ (if (> (seq-elt d-time 6) (seq-elt now 6)) @@ -760,6 +793,9 @@ the files in ARTLIST by that search key.") (generate-new-buffer " *gnus-search-"))) (cl-call-next-method engine slots)) +(defclass gnus-search-nnselect (gnus-search-engine) + nil) + (defclass gnus-search-imap (gnus-search-engine) ((literal-plus :initarg :literal-plus @@ -821,7 +857,7 @@ quirks.") :documentation "Location of the config file, if any.") (remove-prefix :initarg :remove-prefix - :initform (concat (getenv "HOME") "/Mail/") + :initform (expand-file-name "Mail/" "~") :type string :documentation "The path to the directory where the indexed mails are @@ -902,16 +938,30 @@ quirks.") (raw-queries-p :initform (symbol-value 'gnus-search-notmuch-raw-queries-p)))) +(defclass gnus-search-mu (gnus-search-indexed) + ((program + :initform (symbol-value 'gnus-search-mu-program)) + (remove-prefix + :initform (symbol-value 'gnus-search-mu-remove-prefix)) + (switches + :initform (symbol-value 'gnus-search-mu-switches)) + (config-directory + :initform (symbol-value 'gnus-search-mu-config-directory)) + (raw-queries-p + :initform (symbol-value 'gnus-search-mu-raw-queries-p)))) + (define-obsolete-variable-alias 'nnir-method-default-engines 'gnus-search-default-engines "28.1") -(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap)) +(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap) + (nnselect . gnus-search-nnselect)) "Alist of default search engines keyed by server method." :version "26.1" :type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool) (const nneething) (const nndir) (const nnmbox) (const nnml) (const nnmh) (const nndraft) - (const nnfolder) (const nnmaildir)) + (const nnfolder) (const nnmaildir) + (const nnselect)) (choice ,@(mapcar (lambda (el) (list 'const (intern (car el)))) @@ -1008,6 +1058,33 @@ Responsible for handling and, or, and parenthetical expressions.") unseen all old new or not) "Known IMAP search keys.") +(autoload 'nnselect-categorize "nnselect") +(autoload 'nnselect-get-artlist "nnselect" nil nil 'macro) +(autoload 'ids-by-group "nnselect") +;; nnselect interface +(cl-defmethod gnus-search-run-search ((_engine gnus-search-nnselect) + _srv query-spec groups) + (let ((artlist [])) + (dolist (group groups) + (let* ((gnus-newsgroup-selection (nnselect-get-artlist group)) + (group-spec + (nnselect-categorize + (mapcar 'car + (ids-by-group + (number-sequence 1 + (length gnus-newsgroup-selection)))) + (lambda (x) + (gnus-group-server x))))) + (setq artlist + (vconcat artlist + (seq-intersection + gnus-newsgroup-selection + (gnus-search-run-query + (list (cons 'search-query-spec query-spec) + (cons 'search-group-spec group-spec)))))))) + artlist)) + + ;; imap interface (cl-defmethod gnus-search-run-search ((engine gnus-search-imap) srv query groups) @@ -1018,7 +1095,7 @@ Responsible for handling and, or, and parenthetical expressions.") (single-search (gnus-search-single-p query)) (grouplist (or groups (gnus-search-get-active srv))) q-string artlist group) - (message "Opening server %s" server) + (gnus-message 7 "Opening server %s" server) (gnus-open-server srv) ;; We should only be doing this once, in ;; `nnimap-open-connection', but it's too frustrating to try to @@ -1058,11 +1135,11 @@ Responsible for handling and, or, and parenthetical expressions.") q-string))) (while (and (setq group (pop grouplist)) - (or (null single-search) (null artlist))) + (or (null single-search) (= 0 (length artlist)))) (when (nnimap-change-group (gnus-group-short-name group) server) (with-current-buffer (nnimap-buffer) - (message "Searching %s..." group) + (gnus-message 7 "Searching %s..." group) (let ((result (gnus-search-imap-search-command engine q-string))) (when (car result) @@ -1075,7 +1152,7 @@ Responsible for handling and, or, and parenthetical expressions.") (vector group artn 100)))) (cdr (assoc "SEARCH" (cdr result)))) artlist)))) - (message "Searching %s...done" group)))) + (gnus-message 7 "Searching %s...done" group)))) (nreverse artlist)))) (cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap) @@ -1084,7 +1161,8 @@ Responsible for handling and, or, and parenthetical expressions.") Currently takes into account support for the LITERAL+ capability. Other capabilities could be tested here." (with-slots (literal-plus) engine - (when literal-plus + (when (and literal-plus + (string-match-p "\n" query)) (setq query (split-string query "\n"))) (cond ((consp query) @@ -1234,8 +1312,7 @@ nil (except that (dd nil yyyy) is not allowed). Massage those numbers into the most recent past occurrence of whichever date elements are present." (pcase-let ((`(,nday ,nmonth ,nyear) - (seq-subseq (decode-time (current-time)) - 3 6)) + (seq-subseq (decode-time) 3 6)) (`(,dday ,dmonth ,dyear) date)) (unless (and dday dmonth dyear) (unless dday (setq dday 1)) @@ -1255,14 +1332,16 @@ elements are present." (setq dmonth 1)))) (format-time-string "%e-%b-%Y" - (apply #'encode-time - (append '(0 0 0) - (list dday dmonth dyear)))))) + (encode-time 0 0 0 dday dmonth dyear)))) (cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap) (str string)) (with-slots (literal-plus) engine - (if (multibyte-string-p str) + ;; TODO: Figure out how Exchange IMAP servers actually work. They + ;; do not accept any CHARSET but US-ASCII, but they do report + ;; Literal+ capability. So what do we do? Will quoted strings + ;; always work? + (if (string-match-p "[^[:ascii:]]" str) ;; If LITERAL+ is available, use it and encode string as ;; UTF-8. (if literal-plus @@ -1318,19 +1397,17 @@ This method is common to all indexed search engines. Returns a list of [group article score] vectors." - (save-excursion - (let* ((qstring (gnus-search-make-query-string engine query)) - (program (slot-value engine 'program)) - (buffer (slot-value engine 'proc-buffer)) - (cp-list (gnus-search-indexed-search-command - engine qstring query groups)) - proc exitstatus) - (set-buffer buffer) + (let* ((qstring (gnus-search-make-query-string engine query)) + (program (slot-value engine 'program)) + (buffer (slot-value engine 'proc-buffer)) + (cp-list (gnus-search-indexed-search-command + engine qstring query groups)) + proc exitstatus) + (with-current-buffer buffer (erase-buffer) - (if groups - (message "Doing %s query on %s..." program groups) - (message "Doing %s query..." program)) + (gnus-message 7 "Doing %s query on %s..." program groups) + (gnus-message 7 "Doing %s query..." program)) (setq proc (apply #'start-process (format "search-%s" server) buffer program cp-list)) (while (process-live-p proc) @@ -1346,7 +1423,7 @@ Returns a list of [group article score] vectors." ;; wants it. (when (> gnus-verbose 6) (display-buffer buffer)) - nil)))) + nil)))) (cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed) server query &optional groups) @@ -1367,18 +1444,27 @@ Returns a list of [group article score] vectors." (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\\)?/\\'" "" + ;; `expand-file-name' canoncalizes the file name, + ;; specifically collapsing multiple consecutive directory + ;; separators. + (setq f-name (expand-file-name f-name) + group + (delete + "" ; forward slash at root leaves an empty string + (file-name-split (replace-regexp-in-string - "\\`\\." "" - (string-remove-prefix + "\\`\\." "" ; why do we do this? + (string-remove-prefix prefix (file-name-directory f-name)) - nil t) - nil t) - nil t)) + nil t))) + ;; Turn file name segments into a Gnus group name. + group (mapconcat + #'identity + (if (member (car (last group)) + '("new" "tmp" "cur")) + (nbutlast group) + group) + ".")) (setq article (file-name-nondirectory f-name) article ;; TODO: Provide a cleaner way of producing final @@ -1586,36 +1672,6 @@ Namazu provides a little more information, for instance a score." (format "date:%s.." (notmuch-date (cdr expr)))) (t (ignore-errors (cl-call-next-method)))))) -(cl-defmethod gnus-search-run-search :around ((engine gnus-search-notmuch) - server query groups) - "Handle notmuch's thread-search routine." - ;; Notmuch allows for searching threads, but only using its own - ;; thread ids. That means a thread search is a \"double-bounce\": - ;; once to find the relevant thread ids, and again to find the - ;; actual messages. This method performs the first \"bounce\". - (if (alist-get 'thread query) - (with-slots (program proc-buffer) engine - (let* ((qstring - (gnus-search-make-query-string engine query)) - (cp-list (gnus-search-indexed-search-command - engine qstring query groups)) - thread-ids proc) - (set-buffer proc-buffer) - (erase-buffer) - (setq proc (apply #'start-process (format "search-%s" server) - proc-buffer program cp-list)) - (while (process-live-p proc) - (accept-process-output proc)) - (while (re-search-forward "^thread:\\([^ ]+\\)" (point-max) t) - (push (match-string 1) thread-ids)) - (cl-call-next-method - engine server - ;; Completely replace the query with our new thread-based one. - (mapconcat (lambda (thrd) (concat "thread:" thrd)) - thread-ids " or ") - nil))) - (cl-call-next-method engine server query groups))) - (cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-notmuch) (qstring string) query &optional _groups) @@ -1625,16 +1681,17 @@ Namazu provides a little more information, for instance a score." (let ((limit (alist-get 'limit query)) (thread (alist-get 'thread query))) (with-slots (switches config-file) engine - `(,(format "--config=%s" config-file) - "search" - ,(if thread - "--output=threads" - "--output=files") - "--duplicate=1" ; I have found this necessary, I don't know why. - ,@switches - ,(if limit (format "--limit=%d" limit) "") - ,qstring - )))) + (append + (list (format "--config=%s" config-file) + "search" + "--output=files") + (unless thread '("--duplicate=1")) + (when limit (list (format "--limit=%d" limit))) + switches + (list (if thread + (format "thread:\"{%s}\"" + (string-replace "\"" "\"\"" qstring)) + qstring)))))) ;;; Mairix interface @@ -1807,6 +1864,101 @@ Assume \"size\" key is equal to \"larger\"." (when (alist-get 'thread query) (list "-t")) (list qstring)))) +;;; Mu interface + +(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mu) + (expr list)) + (cl-case (car expr) + (recipient (setf (car expr) 'recip)) + (address (setf (car expr) 'contact)) + (id (setf (car expr) 'msgid)) + (attachment (setf (car expr) 'file))) + (cl-flet () + (cond + ((consp (car expr)) + (format "(%s)" (gnus-search-transform engine expr))) + ;; Explicitly leave out 'date as gnus-search will encode it + ;; first; it is handled later + ((memq (car expr) '(cc c bcc h from f to t subject s body b + maildir m msgid i prio p flag g d + size z embed e file j mime y tag x + list v)) + (format "%s:%s" (car expr) + (if (string-match "\\`\\*" (cdr expr)) + (replace-match "" nil nil (cdr expr)) + (cdr expr)))) + ((eq (car expr) 'mark) + (format "flag:%s" (gnus-search-mu-handle-flag (cdr expr)))) + ((eq (car expr) 'date) + (format "date:%s" (gnus-search-mu-handle-date (cdr expr)))) + ((eq (car expr) 'before) + (format "date:..%s" (gnus-search-mu-handle-date (cdr expr)))) + ((eq (car expr) 'since) + (format "date:%s.." (gnus-search-mu-handle-date (cdr expr)))) + (t (ignore-errors (cl-call-next-method)))))) + +(defun gnus-search-mu-handle-date (date) + (if (stringp date) + date + (pcase date + (`(nil ,m nil) + (nth (1- m) gnus-english-month-names)) + (`(nil nil ,y) + (number-to-string y)) + ;; mu prefers ISO date YYYY-MM-DD HH:MM:SS + (`(,d ,m nil) + (let* ((ct (decode-time)) + (cm (decoded-time-month ct)) + (cy (decoded-time-year ct)) + (y (if (> cm m) + cy + (1- cy)))) + (format "%d-%02d-%02d" y m d))) + (`(nil ,m ,y) + (format "%d-%02d" y m)) + (`(,d ,m ,y) + (format "%d-%02d-%02d" y m d))))) + +(defun gnus-search-mu-handle-flag (flag) + ;; Only change what doesn't match + (cond ((string= flag "flag") + "flagged") + ((string= flag "read") + "seen") + (t + flag))) + +(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-mu)) + (prog1 + (let ((bol (line-beginning-position)) + (eol (line-end-position))) + (list (buffer-substring-no-properties bol eol) + 100)) + (move-beginning-of-line 2))) + +(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mu) + (qstring string) + query &optional groups) + (let ((limit (alist-get 'limit query)) + (thread (alist-get 'thread query))) + (with-slots (switches config-directory) engine + `("find" ; command must come first + "--nocolor" ; mu will always give coloured output otherwise + ,(format "--muhome=%s" config-directory) + ,@switches + ,(if thread "-r" "") + ,(if limit (format "--maxnum=%d" limit) "") + ,qstring + ,@(if groups + `("and" "(" + ,@(nbutlast (mapcan (lambda (x) + (list (concat "maildir:/" x) "or")) + groups)) + ")") + "") + "--format=plain" + "--fields=l")))) + ;;; Find-grep interface (cl-defmethod gnus-search-transform-expression ((_engine gnus-search-find-grep) @@ -1836,8 +1988,8 @@ Assume \"size\" key is equal to \"larger\"." (mapcar (lambda (x) (let ((group x) artlist) - (message "Searching %s using find-grep..." - (or group server)) + (gnus-message 7 "Searching %s using find-grep..." + (or group server)) (save-window-excursion (set-buffer buffer) (if (> gnus-verbose 6) @@ -1892,8 +2044,8 @@ Assume \"size\" key is equal to \"larger\"." (vector (gnus-group-full-name group server) art 0) artlist)) (forward-line 1))) - (message "Searching %s using find-grep...done" - (or group server)) + (gnus-message 7 "Searching %s using find-grep...done" + (or group server)) artlist))) grouplist)))) @@ -1926,7 +2078,7 @@ Assume \"size\" key is equal to \"larger\"." (apply #'nnheader-message 4 "Search engine for %s improperly configured: %s" server (cdr err)) - (signal 'gnus-search-config-error err))))) + (signal (car err) (cdr err)))))) (alist-get 'search-group-spec specs)) ;; Some search engines do their own limiting, but some don't, so ;; do it again here. This is bad because, if the user is @@ -1941,9 +2093,9 @@ Assume \"size\" key is equal to \"larger\"." (defun gnus-search-prepare-query (query-spec) "Accept a search query in raw format, and prepare it. QUERY-SPEC is an alist produced by functions such as -`gnus-group-make-search-group', and contains at least a 'query +`gnus-group-make-search-group', and contains at least a `query' key, and possibly some meta keys. This function extracts any -additional meta keys from the 'query string, and parses the +additional meta keys from the `query' string, and parses the remaining string, then adds all that to the top-level spec." (let ((query (alist-get 'query query-spec)) val) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 9c17b7e8133..e659a648e10 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -103,7 +103,43 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar gnus-server-mode-line-format-spec nil) (defvar gnus-server-killed-servers nil) -(defvar gnus-server-mode-map nil) +(defvar-keymap gnus-server-mode-map + :full t :suppress t + "SPC" #'gnus-server-read-server-in-server-buffer + "RET" #'gnus-server-read-server + "<mouse-2>" #'gnus-server-pick-server + "q" #'gnus-server-exit + "l" #'gnus-server-list-servers + "k" #'gnus-server-kill-server + "y" #'gnus-server-yank-server + "c" #'gnus-server-copy-server + "a" #'gnus-server-add-server + "e" #'gnus-server-edit-server + "S" #'gnus-server-show-server + "s" #'gnus-server-scan-server + + "O" #'gnus-server-open-server + "M-o" #'gnus-server-open-all-servers + "C" #'gnus-server-close-server + "M-c" #'gnus-server-close-all-servers + "D" #'gnus-server-deny-server + "L" #'gnus-server-offline-server + "R" #'gnus-server-remove-denials + + "n" #'next-line + "p" #'previous-line + + "g" #'gnus-server-regenerate-server + + "G" #'gnus-group-read-ephemeral-search-group + + "z" #'gnus-server-compact-server + + "i" #'gnus-server-toggle-cloud-server + "I" #'gnus-server-set-cloud-method-server + + "C-c C-i" #'gnus-info-find-node + "C-c C-b" #'gnus-bug) (defcustom gnus-server-menu-hook nil "Hook run after the creation of the server mode menu." @@ -145,47 +181,6 @@ If nil, a faster, but more primitive, buffer is used instead." (gnus-run-hooks 'gnus-server-menu-hook))) -(unless gnus-server-mode-map - (setq gnus-server-mode-map (make-keymap)) - (suppress-keymap gnus-server-mode-map) - - (gnus-define-keys gnus-server-mode-map - " " gnus-server-read-server-in-server-buffer - "\r" gnus-server-read-server - [mouse-2] gnus-server-pick-server - "q" gnus-server-exit - "l" gnus-server-list-servers - "k" gnus-server-kill-server - "y" gnus-server-yank-server - "c" gnus-server-copy-server - "a" gnus-server-add-server - "e" gnus-server-edit-server - "S" gnus-server-show-server - "s" gnus-server-scan-server - - "O" gnus-server-open-server - "\M-o" gnus-server-open-all-servers - "C" gnus-server-close-server - "\M-c" gnus-server-close-all-servers - "D" gnus-server-deny-server - "L" gnus-server-offline-server - "R" gnus-server-remove-denials - - "n" next-line - "p" previous-line - - "g" gnus-server-regenerate-server - - "G" gnus-group-read-ephemeral-search-group - - "z" gnus-server-compact-server - - "i" gnus-server-toggle-cloud-server - "I" gnus-server-set-cloud-method-server - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - (defface gnus-server-agent '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t)) (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) @@ -344,13 +339,13 @@ The following commands are available: (gnus-server-position-point)) (defun gnus-server-server-name () - (let ((server (get-text-property (point-at-bol) 'gnus-server))) + (let ((server (get-text-property (line-beginning-position) 'gnus-server))) (and server (symbol-name server)))) (defun gnus-server-named-server () "Return a server name that matches one of the names returned by `gnus-method-to-server'." - (let ((server (get-text-property (point-at-bol) 'gnus-named-server))) + (let ((server (get-text-property (line-beginning-position) 'gnus-named-server))) (and server (symbol-name server)))) (defalias 'gnus-server-position-point 'gnus-goto-colon) @@ -697,37 +692,30 @@ claim them." function (repeat function))) -(defvar gnus-browse-mode-map nil) - -(unless gnus-browse-mode-map - (setq gnus-browse-mode-map (make-keymap)) - (suppress-keymap gnus-browse-mode-map) - - (gnus-define-keys - gnus-browse-mode-map - " " gnus-browse-read-group - "=" gnus-browse-select-group - "n" gnus-browse-next-group - "p" gnus-browse-prev-group - "\177" gnus-browse-prev-group - [delete] gnus-browse-prev-group - "N" gnus-browse-next-group - "P" gnus-browse-prev-group - "\M-n" gnus-browse-next-group - "\M-p" gnus-browse-prev-group - "\r" gnus-browse-select-group - "u" gnus-browse-toggle-subscription-at-point - "l" gnus-browse-exit - "L" gnus-browse-exit - "q" gnus-browse-exit - "Q" gnus-browse-exit - "d" gnus-browse-describe-group - [delete] gnus-browse-delete-group - "\C-c\C-c" gnus-browse-exit - "?" gnus-browse-describe-briefly - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) +(defvar-keymap gnus-browse-mode-map + :full t :suppress t + "SPC" #'gnus-browse-read-group + "=" #'gnus-browse-select-group + "n" #'gnus-browse-next-group + "p" #'gnus-browse-prev-group + "DEL" #'gnus-browse-prev-group + "N" #'gnus-browse-next-group + "P" #'gnus-browse-prev-group + "M-n" #'gnus-browse-next-group + "M-p" #'gnus-browse-prev-group + "RET" #'gnus-browse-select-group + "u" #'gnus-browse-toggle-subscription-at-point + "l" #'gnus-browse-exit + "L" #'gnus-browse-exit + "q" #'gnus-browse-exit + "Q" #'gnus-browse-exit + "d" #'gnus-browse-describe-group + "<delete>" #'gnus-browse-delete-group + "C-c C-c" #'gnus-browse-exit + "?" #'gnus-browse-describe-briefly + + "C-c C-i" #'gnus-info-find-node + "C-c C-b" #'gnus-bug) (defun gnus-browse-make-menu-bar () (gnus-turn-off-edit-menu 'browse) @@ -961,7 +949,7 @@ how new groups will be entered into the group buffer." (save-excursion (beginning-of-line) (let ((name (get-text-property (point) 'gnus-group))) - (when (re-search-forward ": \\(.*\\)$" (point-at-eol) t) + (when (re-search-forward ": \\(.*\\)$" (line-end-position) t) (concat (gnus-method-to-server-name gnus-browse-current-method) ":" (or name (match-string-no-properties 1))))))) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 301120e4ee5..8d9e50059fd 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -294,8 +294,6 @@ claim them." function (repeat function))) -(define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks - 'gnus-subscribe-newsgroup-functions "24.3") (defcustom gnus-subscribe-newsgroup-functions nil "Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." @@ -329,10 +327,10 @@ with the subscription method in this variable." "If non-nil, Gnus will offer to subscribe hierarchically. When a new hierarchy appears, Gnus will ask the user: -'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): +Descend hierarchy alt.binaries? ([y]nsq): -If the user pressed `d', Gnus will descend the hierarchy, `y' will -subscribe to all newsgroups in the hierarchy and `s' will skip this +If the user pressed `y', Gnus will descend the hierarchy, `s' will +subscribe to all newsgroups in the hierarchy and `n' will skip this hierarchy in its entirety." :group 'gnus-group-new :type 'boolean) @@ -663,6 +661,7 @@ the first newsgroup." (defvar mail-sources) (defvar nnmail-scan-directory-mail-source-once) (defvar nnmail-split-history) +(defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-close-all-servers () "Close all servers." @@ -707,6 +706,7 @@ the first newsgroup." gnus-current-select-method nil nnmail-split-history nil gnus-extended-servers nil + gnus-save-newsrc-file-last-timestamp nil gnus-ephemeral-servers nil) (gnus-shutdown 'gnus) ;; Kill the startup file. @@ -853,7 +853,7 @@ If REGEXP is given, lines that match it will be deleted." (unless (bolp) (forward-line 1)) (setq end (point)) (goto-char (match-beginning 0)) - (delete-region (point-at-bol) end)))) + (delete-region (line-beginning-position) end)))) (goto-char (point-max)) ;; Make sure that each dribble entry is a single line, so that ;; the "remove" code above works. @@ -1882,13 +1882,12 @@ The info element is shared with the same element of (ranges (gnus-info-read info)) news article) (while articles - (when (gnus-member-of-range - (setq article (pop articles)) ranges) + (when (range-member-p (setq article (pop articles)) ranges) (push article news))) (when news ;; Enter this list into the group info. (setf (gnus-info-read info) - (gnus-remove-from-range (gnus-info-read info) (nreverse news))) + (range-remove (gnus-info-read info) (nreverse news))) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) @@ -2172,7 +2171,7 @@ The info element is shared with the same element of (unless ignore-errors (gnus-message 3 "Warning - invalid active: %s" (buffer-substring - (point-at-bol) (point-at-eol)))))) + (line-beginning-position) (line-end-position)))))) (forward-line 1))))) (defun gnus-groups-to-gnus-format (method &optional hashtb real-active) @@ -2360,10 +2359,10 @@ The form should return either t or nil." ticked (cdr (assq 'tick marks))) (when (or dormant ticked) (setf (gnus-info-read info) - (gnus-add-to-range + (range-add-list (gnus-info-read info) - (nconc (gnus-uncompress-range dormant) - (gnus-uncompress-range ticked))))))))) + (nconc (range-uncompress dormant) + (range-uncompress ticked))))))))) (defun gnus-load (file) "Load FILE, but in such a way that read errors can be reported." @@ -2455,8 +2454,7 @@ The form should return either t or nil." (unless (nthcdr 3 info) (nconc info (list nil))) (setf (gnus-info-marks info) - (list (cons 'tick (gnus-compress-sequence - (sort (cdr m) #'<) t)))))) + (list (cons 'tick (range-compress-list (sort (cdr m) #'<))))))) (setq newsrc killed) (while newsrc (setcar newsrc (caar newsrc)) @@ -2527,10 +2525,10 @@ The form should return either t or nil." ;; don't give a damn, frankly, my dear. (concat gnus-newsrc-options (buffer-substring - (point-at-bol) + (line-beginning-position) ;; Options may continue on the next line. (or (and (re-search-forward "^[^ \t]" nil 'move) - (point-at-bol)) + (line-beginning-position)) (point))))) (forward-line -1)) (group @@ -2592,8 +2590,8 @@ The form should return either t or nil." ;; The line was buggy. (setq group nil) (gnus-error 3.1 "Mangled line: %s" - (buffer-substring (point-at-bol) - (point-at-eol)))) + (buffer-substring (line-beginning-position) + (line-end-position)))) nil)) ;; Skip past ", ". Spaces are invalid in these ranges, but ;; we allow them, because it's a common mistake to put a @@ -2702,9 +2700,9 @@ The form should return either t or nil." (while (re-search-forward "[ \t]-n" nil t) (setq eol (or (save-excursion - (and (re-search-forward "[ \t]-n" (point-at-eol) t) + (and (re-search-forward "[ \t]-n" (line-end-position) t) (- (point) 2))) - (point-at-eol))) + (line-end-position))) ;; Search for all "words"... (while (re-search-forward "[^ \t,\n]+" eol t) (if (eq (char-after (match-beginning 0)) ?!) @@ -2731,7 +2729,6 @@ The form should return either t or nil." 'msdos-long-file-names (lambda () t)))) -(defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-save-newsrc-file (&optional force) "Save .newsrc file. Use the group string names in `gnus-group-list' to pull info diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 3f350bffb31..dde60caee7e 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -97,7 +97,7 @@ See `gnus-group-goto-unread'." :type 'boolean) (defcustom gnus-summary-stop-at-end-of-message nil - "If non-nil, don't select the next message when using `SPC'." + "If non-nil, don't select the next message when using \\`SPC'." :link '(custom-manual "(gnus)Group Maneuvering") :group 'gnus-summary-maneuvering :version "24.1" @@ -264,8 +264,8 @@ This variable will only be used if the value of (defcustom gnus-summary-goto-unread nil "If t, many commands will go to the next unread article. This applies to marking commands as well as other commands that -\"naturally\" select the next article, like, for instance, `SPC' at -the end of an article. +\"naturally\" select the next article, like, for instance, \\`SPC' +at the end of an article. If nil, the marking commands do NOT go to the next unread article \(they go to the next article instead). If `never', commands that @@ -1182,8 +1182,8 @@ mark: The article's mark. uncached: Non-nil if the article is uncached." :group 'gnus-summary-visual :type '(repeat (cons (sexp :tag "Form" nil) - face))) -(put 'gnus-summary-highlight 'risky-local-variable t) + face)) + :risky t) (defcustom gnus-alter-header-function nil "Function called to allow alteration of article header structures. @@ -1907,485 +1907,481 @@ increase the score of each group you read." ;; Non-orthogonal keys -(gnus-define-keys gnus-summary-mode-map - " " gnus-summary-next-page - [?\S-\ ] gnus-summary-prev-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\M-\C-n" gnus-summary-next-same-subject - "\M-\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "." gnus-summary-first-unread-article - "," gnus-summary-best-unread-article - "[" gnus-summary-prev-unseen-article - "]" gnus-summary-next-unseen-article - "\M-s\M-s" gnus-summary-search-article-forward - "\M-s\M-r" gnus-summary-search-article-backward - "\M-r" gnus-summary-search-article-backward - "\M-S" gnus-summary-repeat-search-article-forward - "\M-R" gnus-summary-repeat-search-article-backward - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "j" gnus-summary-goto-article - "^" gnus-summary-refer-parent-article - "\M-^" gnus-summary-refer-article - "u" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "U" gnus-summary-tick-article-backward - "d" gnus-summary-mark-as-read-forward - "D" gnus-summary-mark-as-read-backward - "E" gnus-summary-mark-as-expirable - "\M-u" gnus-summary-clear-mark-forward - "\M-U" gnus-summary-clear-mark-backward - "k" gnus-summary-kill-same-subject-and-select - "\C-k" gnus-summary-kill-same-subject - "\M-\C-k" gnus-summary-kill-thread - "\M-\C-l" gnus-summary-lower-thread - "e" gnus-summary-edit-article - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "\M-\C-t" gnus-summary-toggle-threads - "\M-\C-s" gnus-summary-show-thread - "\M-\C-h" gnus-summary-hide-thread - "\M-\C-f" gnus-summary-next-thread - "\M-\C-b" gnus-summary-prev-thread - [(meta down)] gnus-summary-next-thread - [(meta up)] gnus-summary-prev-thread - "\M-\C-u" gnus-summary-up-thread - "\M-\C-d" gnus-summary-down-thread - "&" gnus-summary-execute-command - "c" gnus-summary-catchup-and-exit - "\C-w" gnus-summary-mark-region-as-read - "\C-t" toggle-truncate-lines - "?" gnus-summary-mark-as-dormant - "\C-c\M-\C-s" gnus-summary-limit-include-expunged - "\C-c\C-s\C-n" gnus-summary-sort-by-number - "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number - "\C-c\C-s\C-l" gnus-summary-sort-by-lines - "\C-c\C-s\C-c" gnus-summary-sort-by-chars - "\C-c\C-s\C-m\C-m" gnus-summary-sort-by-marks - "\C-c\C-s\C-a" gnus-summary-sort-by-author - "\C-c\C-s\C-t" gnus-summary-sort-by-recipient - "\C-c\C-s\C-s" gnus-summary-sort-by-subject - "\C-c\C-s\C-d" gnus-summary-sort-by-date - "\C-c\C-s\C-m\C-d" gnus-summary-sort-by-most-recent-date - "\C-c\C-s\C-i" gnus-summary-sort-by-score - "\C-c\C-s\C-o" gnus-summary-sort-by-original - "\C-c\C-s\C-r" gnus-summary-sort-by-random - "\C-c\C-s\C-u" gnus-summary-sort-by-newsgroups - "\C-c\C-s\C-x" gnus-summary-sort-by-extra - "=" gnus-summary-expand-window - "\C-x\C-s" gnus-summary-reselect-current-group - "\M-g" gnus-summary-rescan-group - "\C-c\C-r" gnus-summary-caesar-message - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "C" gnus-summary-cancel-article - "r" gnus-summary-reply - "R" gnus-summary-reply-with-original - "\C-c\C-f" gnus-summary-mail-forward - "o" gnus-summary-save-article - "\C-o" gnus-summary-save-article-mail - "|" gnus-summary-pipe-output - "\M-k" gnus-summary-edit-local-kill - "\M-K" gnus-summary-edit-global-kill +(define-keymap :keymap gnus-summary-mode-map + "SPC" #'gnus-summary-next-page + "S-SPC" #'gnus-summary-prev-page + "DEL" #'gnus-summary-prev-page + "<delete>" #'gnus-summary-prev-page + "RET" #'gnus-summary-scroll-up + "M-RET" #'gnus-summary-scroll-down + "n" #'gnus-summary-next-unread-article + "p" #'gnus-summary-prev-unread-article + "N" #'gnus-summary-next-article + "P" #'gnus-summary-prev-article + "C-M-n" #'gnus-summary-next-same-subject + "C-M-p" #'gnus-summary-prev-same-subject + "M-n" #'gnus-summary-next-unread-subject + "M-p" #'gnus-summary-prev-unread-subject + "." #'gnus-summary-first-unread-article + "," #'gnus-summary-best-unread-article + "[" #'gnus-summary-prev-unseen-article + "]" #'gnus-summary-next-unseen-article + "M-s M-s" #'gnus-summary-search-article-forward + "M-s M-r" #'gnus-summary-search-article-backward + "M-r" #'gnus-summary-search-article-backward + "M-S" #'gnus-summary-repeat-search-article-forward + "M-R" #'gnus-summary-repeat-search-article-backward + "<" #'gnus-summary-beginning-of-article + ">" #'gnus-summary-end-of-article + "j" #'gnus-summary-goto-article + "^" #'gnus-summary-refer-parent-article + "M-^" #'gnus-summary-refer-article + "u" #'gnus-summary-tick-article-forward + "!" #'gnus-summary-tick-article-forward + "U" #'gnus-summary-tick-article-backward + "d" #'gnus-summary-mark-as-read-forward + "D" #'gnus-summary-mark-as-read-backward + "E" #'gnus-summary-mark-as-expirable + "M-u" #'gnus-summary-clear-mark-forward + "M-U" #'gnus-summary-clear-mark-backward + "k" #'gnus-summary-kill-same-subject-and-select + "C-k" #'gnus-summary-kill-same-subject + "C-M-k" #'gnus-summary-kill-thread + "C-M-l" #'gnus-summary-lower-thread + "e" #'gnus-summary-edit-article + "#" #'gnus-summary-mark-as-processable + "M-#" #'gnus-summary-unmark-as-processable + "C-M-t" #'gnus-summary-toggle-threads + "C-M-s" #'gnus-summary-show-thread + "C-M-h" #'gnus-summary-hide-thread + "C-M-f" #'gnus-summary-next-thread + "C-M-b" #'gnus-summary-prev-thread + "M-<down>" #'gnus-summary-next-thread + "M-<up>" #'gnus-summary-prev-thread + "&" #'gnus-summary-execute-command + "c" #'gnus-summary-catchup-and-exit + "C-w" #'gnus-summary-mark-region-as-read + "C-t" #'toggle-truncate-lines + "?" #'gnus-summary-mark-as-dormant + "C-c C-M-s" #'gnus-summary-limit-include-expunged + "C-c C-s C-n" #'gnus-summary-sort-by-number + "C-c C-s C-m C-n" #'gnus-summary-sort-by-most-recent-number + "C-c C-s C-l" #'gnus-summary-sort-by-lines + "C-c C-s C-c" #'gnus-summary-sort-by-chars + "C-c C-s C-m C-m" #'gnus-summary-sort-by-marks + "C-c C-s C-a" #'gnus-summary-sort-by-author + "C-c C-s C-t" #'gnus-summary-sort-by-recipient + "C-c C-s C-s" #'gnus-summary-sort-by-subject + "C-c C-s C-d" #'gnus-summary-sort-by-date + "C-c C-s C-m C-d" #'gnus-summary-sort-by-most-recent-date + "C-c C-s C-i" #'gnus-summary-sort-by-score + "C-c C-s C-o" #'gnus-summary-sort-by-original + "C-c C-s C-r" #'gnus-summary-sort-by-random + "C-c C-s C-u" #'gnus-summary-sort-by-newsgroups + "C-c C-s C-x" #'gnus-summary-sort-by-extra + "=" #'gnus-summary-expand-window + "C-x C-s" #'gnus-summary-reselect-current-group + "M-g" #'gnus-summary-rescan-group + "C-c C-r" #'gnus-summary-caesar-message + "f" #'gnus-summary-followup + "F" #'gnus-summary-followup-with-original + "C" #'gnus-summary-cancel-article + "r" #'gnus-summary-reply + "R" #'gnus-summary-reply-with-original + "C-c C-f" #'gnus-summary-mail-forward + "o" #'gnus-summary-save-article + "C-o" #'gnus-summary-save-article-mail + "|" #'gnus-summary-pipe-output + "M-k" #'gnus-summary-edit-local-kill + "M-K" #'gnus-summary-edit-global-kill ;; "V" gnus-version - "\C-c\C-d" gnus-summary-describe-group - "\C-c\C-p" gnus-summary-make-group-from-search - "q" gnus-summary-exit - "Q" gnus-summary-exit-no-update - "\C-c\C-i" gnus-info-find-node - [mouse-2] gnus-mouse-pick-article - [follow-link] mouse-face - "m" gnus-summary-mail-other-window - "a" gnus-summary-post-news - "x" gnus-summary-limit-to-unread - "s" gnus-summary-isearch-article - "\t" gnus-summary-button-forward - [backtab] gnus-summary-button-backward - "w" gnus-summary-browse-url - "t" gnus-summary-toggle-header - "g" gnus-summary-show-article - "l" gnus-summary-goto-last-article - "\C-c\C-v\C-v" gnus-uu-decode-uu-view - "\C-d" gnus-summary-enter-digest-group - "\M-\C-d" gnus-summary-read-document - "\M-\C-e" gnus-summary-edit-parameters - "\M-\C-a" gnus-summary-customize-parameters - "\C-c\C-b" gnus-bug - "*" gnus-cache-enter-article - "\M-*" gnus-cache-remove-article - "\M-&" gnus-summary-universal-argument - "\C-l" gnus-recenter - "I" gnus-summary-increase-score - "L" gnus-summary-lower-score - "\M-i" gnus-symbolic-argument - "h" gnus-summary-select-article-buffer - - "b" gnus-article-view-part - "\M-t" gnus-summary-toggle-display-buttonized - - "V" gnus-summary-score-map - "X" gnus-uu-extract-map - "S" gnus-summary-send-map) - -;; Sort of orthogonal keymap -(gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) - "t" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "d" gnus-summary-mark-as-read-forward - "r" gnus-summary-mark-as-read-forward - "c" gnus-summary-clear-mark-forward - " " gnus-summary-clear-mark-forward - "e" gnus-summary-mark-as-expirable - "x" gnus-summary-mark-as-expirable - "?" gnus-summary-mark-as-dormant - "b" gnus-summary-set-bookmark - "B" gnus-summary-remove-bookmark - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "S" gnus-summary-limit-include-expunged - "C" gnus-summary-catchup - "H" gnus-summary-catchup-to-here - "h" gnus-summary-catchup-from-here - "\C-c" gnus-summary-catchup-all - "k" gnus-summary-kill-same-subject-and-select - "K" gnus-summary-kill-same-subject - "P" gnus-uu-mark-map) - -(gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map) - "c" gnus-summary-clear-above - "u" gnus-summary-tick-above - "m" gnus-summary-mark-above - "k" gnus-summary-kill-below) - -(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) - "/" gnus-summary-limit-to-subject - "n" gnus-summary-limit-to-articles - "b" gnus-summary-limit-to-bodies - "h" gnus-summary-limit-to-headers - "w" gnus-summary-pop-limit - "s" gnus-summary-limit-to-subject - "a" gnus-summary-limit-to-author - "u" gnus-summary-limit-to-unread - "m" gnus-summary-limit-to-marks - "M" gnus-summary-limit-exclude-marks - "v" gnus-summary-limit-to-score - "*" gnus-summary-limit-include-cached - "D" gnus-summary-limit-include-dormant - "T" gnus-summary-limit-include-thread - "d" gnus-summary-limit-exclude-dormant - "t" gnus-summary-limit-to-age - "." gnus-summary-limit-to-unseen - "x" gnus-summary-limit-to-extra - "p" gnus-summary-limit-to-display-predicate - "E" gnus-summary-limit-include-expunged - "c" gnus-summary-limit-exclude-childless-dormant - "C" gnus-summary-limit-mark-excluded-as-read - "o" gnus-summary-insert-old-articles - "N" gnus-summary-insert-new-articles - "S" gnus-summary-limit-to-singletons - "r" gnus-summary-limit-to-replied - "R" gnus-summary-limit-to-recipient - "A" gnus-summary-limit-to-address) - -(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\C-n" gnus-summary-next-same-subject - "\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "f" gnus-summary-first-unread-article - "b" gnus-summary-best-unread-article - "u" gnus-summary-next-unseen-article - "U" gnus-summary-prev-unseen-article - "j" gnus-summary-goto-article - "g" gnus-summary-goto-subject - "l" gnus-summary-goto-last-article - "o" gnus-summary-pop-article) - -(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) - "k" gnus-summary-kill-thread - "E" gnus-summary-expire-thread - "l" gnus-summary-lower-thread - "i" gnus-summary-raise-thread - "T" gnus-summary-toggle-threads - "t" gnus-summary-rethread-current - "^" gnus-summary-reparent-thread - "\M-^" gnus-summary-reparent-children - "s" gnus-summary-show-thread - "S" gnus-summary-show-all-threads - "h" gnus-summary-hide-thread - "H" gnus-summary-hide-all-threads - "n" gnus-summary-next-thread - "p" gnus-summary-prev-thread - "u" gnus-summary-up-thread - "o" gnus-summary-top-thread - "d" gnus-summary-down-thread - "#" gnus-uu-mark-thread - "\M-#" gnus-uu-unmark-thread) - -(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) - "g" gnus-summary-prepare - "c" gnus-summary-insert-cached-articles - "d" gnus-summary-insert-dormant-articles - "t" gnus-summary-insert-ticked-articles) - -(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) - "c" gnus-summary-catchup-and-exit - "C" gnus-summary-catchup-all-and-exit - "E" gnus-summary-exit-no-update - "Q" gnus-summary-exit - "Z" gnus-summary-exit - "n" gnus-summary-catchup-and-goto-next-group - "p" gnus-summary-catchup-and-goto-prev-group - "R" gnus-summary-reselect-current-group - "G" gnus-summary-rescan-group - "N" gnus-summary-next-group - "s" gnus-summary-save-newsrc - "P" gnus-summary-prev-group) - -(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) - " " gnus-summary-next-page - "n" gnus-summary-next-page - [?\S-\ ] gnus-summary-prev-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "p" gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "b" gnus-summary-beginning-of-article - "e" gnus-summary-end-of-article - "^" gnus-summary-refer-parent-article - "r" gnus-summary-refer-parent-article - "C" gnus-summary-show-complete-article - "D" gnus-summary-enter-digest-group - "R" gnus-summary-refer-references - "T" gnus-summary-refer-thread - "W" gnus-warp-to-article - "g" gnus-summary-show-article - "s" gnus-summary-isearch-article - "\t" gnus-summary-button-forward - [backtab] gnus-summary-button-backward - "w" gnus-summary-browse-url - "P" gnus-summary-print-article - "S" gnus-sticky-article - "M" gnus-mailing-list-insinuate - "t" gnus-article-babel) - -(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) - "b" gnus-article-add-buttons - "B" gnus-article-add-buttons-to-head - "o" gnus-article-treat-overstrike - "e" gnus-article-emphasize - "w" gnus-article-fill-cited-article - "Q" gnus-article-fill-long-lines - "L" gnus-article-toggle-truncate-lines - "C" gnus-article-capitalize-sentences - "c" gnus-article-remove-cr - "q" gnus-article-de-quoted-unreadable - "6" gnus-article-de-base64-unreadable - "Z" gnus-article-decode-HZ - "A" gnus-article-treat-ansi-sequences - "h" gnus-article-wash-html - "u" gnus-article-unsplit-urls - "s" gnus-summary-force-verify-and-decrypt - "f" gnus-article-display-x-face - "l" gnus-summary-stop-page-breaking - "r" gnus-summary-caesar-message - "m" gnus-summary-morse-message - "t" gnus-summary-toggle-header - "g" gnus-treat-smiley - "v" gnus-summary-verbose-headers - "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive - "p" gnus-article-verify-x-pgp-sig - "d" gnus-article-treat-smartquotes - "U" gnus-article-treat-non-ascii - "i" gnus-summary-idna-message) - -(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map) - ;; mnemonic: deuglif*Y* - "u" gnus-article-outlook-unwrap-lines - "a" gnus-article-outlook-repair-attribution - "c" gnus-article-outlook-rearrange-citation - "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify - -(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) - "a" gnus-article-hide - "h" gnus-article-hide-headers - "b" gnus-article-hide-boring-headers - "s" gnus-article-hide-signature - "c" gnus-article-hide-citation - "C" gnus-article-hide-citation-in-followups - "l" gnus-article-hide-list-identifiers - "B" gnus-article-strip-banner - "P" gnus-article-hide-pem - "\C-c" gnus-article-hide-citation-maybe) - -(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) - "a" gnus-article-highlight - "h" gnus-article-highlight-headers - "c" gnus-article-highlight-citation - "s" gnus-article-highlight-signature) - -(gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map) - "f" gnus-article-treat-fold-headers - "u" gnus-article-treat-unfold-headers - "n" gnus-article-treat-fold-newsgroups) - -(gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map) - "x" gnus-article-display-x-face - "d" gnus-article-display-face - "s" gnus-treat-smiley - "D" gnus-article-remove-images - "W" gnus-article-show-images - "F" gnus-article-toggle-fonts - "f" gnus-treat-from-picon - "m" gnus-treat-mail-picon - "n" gnus-treat-newsgroups-picon - "g" gnus-treat-from-gravatar - "h" gnus-treat-mail-gravatar) - -(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) - "w" gnus-article-decode-mime-words - "c" gnus-article-decode-charset - "h" gnus-mime-buttonize-attachments-in-header - "v" gnus-mime-view-all-parts - "b" gnus-article-view-part) - -(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) - "z" gnus-article-date-ut - "u" gnus-article-date-ut - "l" gnus-article-date-local - "p" gnus-article-date-english - "e" gnus-article-date-lapsed - "o" gnus-article-date-original - "i" gnus-article-date-iso8601 - "s" gnus-article-date-user) - -(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) - "t" gnus-article-remove-trailing-blank-lines - "l" gnus-article-strip-leading-blank-lines - "m" gnus-article-strip-multiple-blank-lines - "a" gnus-article-strip-blank-lines - "A" gnus-article-strip-all-blank-lines - "s" gnus-article-strip-leading-space - "e" gnus-article-strip-trailing-space - "w" gnus-article-remove-leading-whitespace) - -(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) - "v" gnus-version - "d" gnus-summary-describe-group - "h" gnus-summary-describe-briefly - "i" gnus-info-find-node) - -(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) - "e" gnus-summary-expire-articles - "\M-\C-e" gnus-summary-expire-articles-now - "\177" gnus-summary-delete-article - [delete] gnus-summary-delete-article - [backspace] gnus-summary-delete-article - "m" gnus-summary-move-article - "r" gnus-summary-respool-article - "w" gnus-summary-edit-article - "c" gnus-summary-copy-article - "B" gnus-summary-crosspost-article - "q" gnus-summary-respool-query - "t" gnus-summary-respool-trace - "i" gnus-summary-import-article - "I" gnus-summary-create-article - "p" gnus-summary-article-posted-p) - -(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) - "o" gnus-summary-save-article - "m" gnus-summary-save-article-mail - "F" gnus-summary-write-article-file - "r" gnus-summary-save-article-rmail - "f" gnus-summary-save-article-file - "b" gnus-summary-save-article-body-file - "B" gnus-summary-write-article-body-file - "h" gnus-summary-save-article-folder - "v" gnus-summary-save-article-vm - "p" gnus-summary-pipe-output - "P" gnus-summary-muttprint) - -(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) - "b" gnus-summary-display-buttonized - "m" gnus-summary-repair-multipart - "v" gnus-article-view-part - "o" gnus-article-save-part - "O" gnus-article-save-part-and-strip - "r" gnus-article-replace-part - "d" gnus-article-delete-part - "t" gnus-article-view-part-as-type - "j" gnus-article-jump-to-part - "c" gnus-article-copy-part - "C" gnus-article-view-part-as-charset - "e" gnus-article-view-part-externally - "H" gnus-article-browse-html-article - "E" gnus-article-encrypt-body - "i" gnus-article-inline-part - "|" gnus-article-pipe-part) - -(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map) - "p" gnus-summary-mark-as-processable - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "s" gnus-uu-mark-series - "r" gnus-uu-mark-region - "g" gnus-uu-unmark-region - "R" gnus-uu-mark-by-regexp - "G" gnus-uu-unmark-by-regexp - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - "a" gnus-uu-mark-all - "b" gnus-uu-mark-buffer - "S" gnus-uu-mark-sparse - "k" gnus-summary-kill-process-mark - "y" gnus-summary-yank-process-mark - "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable) - -(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) - ;;"x" gnus-uu-extract-any - "m" gnus-summary-save-parts - "u" gnus-uu-decode-uu - "U" gnus-uu-decode-uu-and-save - "s" gnus-uu-decode-unshar - "S" gnus-uu-decode-unshar-and-save - "o" gnus-uu-decode-save - "O" gnus-uu-decode-save - "b" gnus-uu-decode-binhex - "B" gnus-uu-decode-binhex - "Y" gnus-uu-decode-yenc - "p" gnus-uu-decode-postscript - "P" gnus-uu-decode-postscript-and-save) - -(gnus-define-keys - (gnus-uu-extract-view-map "v" gnus-uu-extract-map) - "u" gnus-uu-decode-uu-view - "U" gnus-uu-decode-uu-and-save-view - "s" gnus-uu-decode-unshar-view - "S" gnus-uu-decode-unshar-and-save-view - "o" gnus-uu-decode-save-view - "O" gnus-uu-decode-save-view - "b" gnus-uu-decode-binhex-view - "B" gnus-uu-decode-binhex-view - "p" gnus-uu-decode-postscript-view - "P" gnus-uu-decode-postscript-and-save-view) + "C-c C-d" #'gnus-summary-describe-group + "C-c C-p" #'gnus-summary-make-group-from-search + "q" #'gnus-summary-exit + "Q" #'gnus-summary-exit-no-update + "C-c C-i" #'gnus-info-find-node + "<mouse-2>" #'gnus-mouse-pick-article + "<follow-link>" 'mouse-face + "m" #'gnus-summary-mail-other-window + "a" #'gnus-summary-post-news + "x" #'gnus-summary-limit-to-unread + "s" #'gnus-summary-isearch-article + "TAB" #'gnus-summary-button-forward + "<backtab>" #'gnus-summary-button-backward + "w" #'gnus-summary-browse-url + "t" #'gnus-summary-toggle-header + "g" #'gnus-summary-show-article + "l" #'gnus-summary-goto-last-article + "C-c C-v C-v" #'gnus-uu-decode-uu-view + "C-d" #'gnus-summary-enter-digest-group + "C-M-d" #'gnus-summary-read-document + "C-M-e" #'gnus-summary-edit-parameters + "C-M-a" #'gnus-summary-customize-parameters + "C-c C-b" #'gnus-bug + "*" #'gnus-cache-enter-article + "M-*" #'gnus-cache-remove-article + "M-&" #'gnus-summary-universal-argument + "C-l" #'gnus-recenter + "I" #'gnus-summary-increase-score + "L" #'gnus-summary-lower-score + "M-i" #'gnus-symbolic-argument + "h" #'gnus-summary-select-article-buffer + + "b" #'gnus-article-view-part + "M-t" #'gnus-summary-toggle-display-buttonized + + "S" #'gnus-summary-send-map + + ;; Sort of orthogonal keymaps. + "M" (define-keymap :prefix 'gnus-summary-mark-map + "t" #'gnus-summary-tick-article-forward + "!" #'gnus-summary-tick-article-forward + "d" #'gnus-summary-mark-as-read-forward + "r" #'gnus-summary-mark-as-read-forward + "c" #'gnus-summary-clear-mark-forward + "SPC" #'gnus-summary-clear-mark-forward + "e" #'gnus-summary-mark-as-expirable + "x" #'gnus-summary-mark-as-expirable + "?" #'gnus-summary-mark-as-dormant + "b" #'gnus-summary-set-bookmark + "B" #'gnus-summary-remove-bookmark + "#" #'gnus-summary-mark-as-processable + "M-#" #'gnus-summary-unmark-as-processable + "S" #'gnus-summary-limit-include-expunged + "C" #'gnus-summary-catchup + "H" #'gnus-summary-catchup-to-here + "h" #'gnus-summary-catchup-from-here + "C-c" #'gnus-summary-catchup-all + "k" #'gnus-summary-kill-same-subject-and-select + "K" #'gnus-summary-kill-same-subject + + "P" (define-keymap :prefix 'gnus-uu-mark-map + "p" #'gnus-summary-mark-as-processable + "u" #'gnus-summary-unmark-as-processable + "U" #'gnus-summary-unmark-all-processable + "v" #'gnus-uu-mark-over + "s" #'gnus-uu-mark-series + "r" #'gnus-uu-mark-region + "g" #'gnus-uu-unmark-region + "R" #'gnus-uu-mark-by-regexp + "G" #'gnus-uu-unmark-by-regexp + "t" #'gnus-uu-mark-thread + "T" #'gnus-uu-unmark-thread + "a" #'gnus-uu-mark-all + "b" #'gnus-uu-mark-buffer + "S" #'gnus-uu-mark-sparse + "k" #'gnus-summary-kill-process-mark + "y" #'gnus-summary-yank-process-mark + "w" #'gnus-summary-save-process-mark + "i" #'gnus-uu-invert-processable) + + "V" (define-keymap :prefix 'gnus-summary-mscore-map + "c" #'gnus-summary-clear-above + "u" #'gnus-summary-tick-above + "m" #'gnus-summary-mark-above + "k" #'gnus-summary-kill-below)) + + "/" (define-keymap :prefix 'gnus-summary-limit-map + "/" #'gnus-summary-limit-to-subject + "n" #'gnus-summary-limit-to-articles + "b" #'gnus-summary-limit-to-bodies + "h" #'gnus-summary-limit-to-headers + "w" #'gnus-summary-pop-limit + "s" #'gnus-summary-limit-to-subject + "a" #'gnus-summary-limit-to-author + "u" #'gnus-summary-limit-to-unread + "m" #'gnus-summary-limit-to-marks + "M" #'gnus-summary-limit-exclude-marks + "v" #'gnus-summary-limit-to-score + "*" #'gnus-summary-limit-include-cached + "D" #'gnus-summary-limit-include-dormant + "T" #'gnus-summary-limit-include-thread + "d" #'gnus-summary-limit-exclude-dormant + "t" #'gnus-summary-limit-to-age + "." #'gnus-summary-limit-to-unseen + "x" #'gnus-summary-limit-to-extra + "p" #'gnus-summary-limit-to-display-predicate + "E" #'gnus-summary-limit-include-expunged + "c" #'gnus-summary-limit-exclude-childless-dormant + "C" #'gnus-summary-limit-mark-excluded-as-read + "o" #'gnus-summary-insert-old-articles + "N" #'gnus-summary-insert-new-articles + "S" #'gnus-summary-limit-to-singletons + "r" #'gnus-summary-limit-to-replied + "R" #'gnus-summary-limit-to-recipient + "A" #'gnus-summary-limit-to-address) + + "G" (define-keymap :prefix 'gnus-summary-goto-map + "n" #'gnus-summary-next-unread-article + "p" #'gnus-summary-prev-unread-article + "N" #'gnus-summary-next-article + "P" #'gnus-summary-prev-article + "C-n" #'gnus-summary-next-same-subject + "C-p" #'gnus-summary-prev-same-subject + "M-n" #'gnus-summary-next-unread-subject + "M-p" #'gnus-summary-prev-unread-subject + "f" #'gnus-summary-first-unread-article + "b" #'gnus-summary-best-unread-article + "u" #'gnus-summary-next-unseen-article + "U" #'gnus-summary-prev-unseen-article + "j" #'gnus-summary-goto-article + "g" #'gnus-summary-goto-subject + "l" #'gnus-summary-goto-last-article + "o" #'gnus-summary-pop-article) + + "T" (define-keymap :prefix 'gnus-summary-thread-map + "k" #'gnus-summary-kill-thread + "E" #'gnus-summary-expire-thread + "l" #'gnus-summary-lower-thread + "i" #'gnus-summary-raise-thread + "T" #'gnus-summary-toggle-threads + "t" #'gnus-summary-rethread-current + "^" #'gnus-summary-reparent-thread + "M-^" #'gnus-summary-reparent-children + "s" #'gnus-summary-show-thread + "S" #'gnus-summary-show-all-threads + "h" #'gnus-summary-hide-thread + "H" #'gnus-summary-hide-all-threads + "n" #'gnus-summary-next-thread + "p" #'gnus-summary-prev-thread + "u" #'gnus-summary-up-thread + "o" #'gnus-summary-top-thread + "d" #'gnus-summary-down-thread + "#" #'gnus-uu-mark-thread + "M-#" #'gnus-uu-unmark-thread) + + "Y" (define-keymap :prefix 'gnus-summary-buffer-map + "g" #'gnus-summary-prepare + "c" #'gnus-summary-insert-cached-articles + "d" #'gnus-summary-insert-dormant-articles + "t" #'gnus-summary-insert-ticked-articles) + + "Z" (define-keymap :prefix 'gnus-summary-exit-map + "c" #'gnus-summary-catchup-and-exit + "C" #'gnus-summary-catchup-all-and-exit + "E" #'gnus-summary-exit-no-update + "Q" #'gnus-summary-exit + "Z" #'gnus-summary-exit + "n" #'gnus-summary-catchup-and-goto-next-group + "p" #'gnus-summary-catchup-and-goto-prev-group + "R" #'gnus-summary-reselect-current-group + "G" #'gnus-summary-rescan-group + "N" #'gnus-summary-next-group + "s" #'gnus-summary-save-newsrc + "P" #'gnus-summary-prev-group) + + "A" (define-keymap :prefix 'gnus-summary-article-map + "SPC" #'gnus-summary-next-page + "n" #'gnus-summary-next-page + "S-SPC" #'gnus-summary-prev-page + "DEL" #'gnus-summary-prev-page + "<delete>" #'gnus-summary-prev-page + "p" #'gnus-summary-prev-page + "RET" #'gnus-summary-scroll-up + "M-RET" #'gnus-summary-scroll-down + "<" #'gnus-summary-beginning-of-article + ">" #'gnus-summary-end-of-article + "b" #'gnus-summary-beginning-of-article + "e" #'gnus-summary-end-of-article + "^" #'gnus-summary-refer-parent-article + "r" #'gnus-summary-refer-parent-article + "C" #'gnus-summary-show-complete-article + "D" #'gnus-summary-enter-digest-group + "R" #'gnus-summary-refer-references + "T" #'gnus-summary-refer-thread + "W" #'gnus-warp-to-article + "g" #'gnus-summary-show-article + "s" #'gnus-summary-isearch-article + "TAB" #'gnus-summary-button-forward + "<backtab>" #'gnus-summary-button-backward + "w" #'gnus-summary-browse-url + "P" #'gnus-summary-print-article + "S" #'gnus-sticky-article + "M" #'gnus-mailing-list-insinuate + "t" #'gnus-article-babel) + + "W" (define-keymap :prefix 'gnus-summary-wash-map + "b" #'gnus-article-add-buttons + "B" #'gnus-article-add-buttons-to-head + "o" #'gnus-article-treat-overstrike + "e" #'gnus-article-emphasize + "w" #'gnus-article-fill-cited-article + "Q" #'gnus-article-fill-long-lines + "L" #'gnus-article-toggle-truncate-lines + "C" #'gnus-article-capitalize-sentences + "c" #'gnus-article-remove-cr + "q" #'gnus-article-de-quoted-unreadable + "6" #'gnus-article-de-base64-unreadable + "Z" #'gnus-article-decode-HZ + "A" #'gnus-article-treat-ansi-sequences + "h" #'gnus-article-wash-html + "u" #'gnus-article-unsplit-urls + "s" #'gnus-summary-force-verify-and-decrypt + "f" #'gnus-article-display-x-face + "l" #'gnus-summary-stop-page-breaking + "r" #'gnus-summary-caesar-message + "m" #'gnus-summary-morse-message + "t" #'gnus-summary-toggle-header + "g" #'gnus-treat-smiley + "v" #'gnus-summary-verbose-headers + "a" #'gnus-article-strip-headers-in-body ;; mnemonic: wash archive + "p" #'gnus-article-verify-x-pgp-sig + "d" #'gnus-article-treat-smartquotes + "U" #'gnus-article-treat-non-ascii + "i" #'gnus-summary-idna-message + + "Y" (define-keymap :prefix 'gnus-summary-wash-deuglify-map + ;; mnemonic: deuglif*Y* + "u" #'gnus-article-outlook-unwrap-lines + "a" #'gnus-article-outlook-repair-attribution + "c" #'gnus-article-outlook-rearrange-citation + ;; mnemonic: full deuglify + "f" #'gnus-article-outlook-deuglify-article) + + "W" (define-keymap :prefix 'gnus-summary-wash-hide-map + "a" #'gnus-article-hide + "h" #'gnus-article-hide-headers + "b" #'gnus-article-hide-boring-headers + "s" #'gnus-article-hide-signature + "c" #'gnus-article-hide-citation + "C" #'gnus-article-hide-citation-in-followups + "l" #'gnus-article-hide-list-identifiers + "B" #'gnus-article-strip-banner + "P" #'gnus-article-hide-pem + "C-c" #'gnus-article-hide-citation-maybe) + + "H" (define-keymap :prefix 'gnus-summary-wash-highlight-map + "a" #'gnus-article-highlight + "h" #'gnus-article-highlight-headers + "c" #'gnus-article-highlight-citation + "s" #'gnus-article-highlight-signature) + + "G" (define-keymap :prefix 'gnus-summary-wash-header-map + "f" #'gnus-article-treat-fold-headers + "u" #'gnus-article-treat-unfold-headers + "n" #'gnus-article-treat-fold-newsgroups) + + "D" (define-keymap :prefix 'gnus-summary-wash-display-map + "x" #'gnus-article-display-x-face + "d" #'gnus-article-display-face + "s" #'gnus-treat-smiley + "e" #'gnus-article-emojize-symbols + "D" #'gnus-article-remove-images + "W" #'gnus-article-show-images + "F" #'gnus-article-toggle-fonts + "f" #'gnus-treat-from-picon + "m" #'gnus-treat-mail-picon + "n" #'gnus-treat-newsgroups-picon + "g" #'gnus-treat-from-gravatar + "h" #'gnus-treat-mail-gravatar) + + "M" (define-keymap :prefix 'gnus-summary-wash-mime-map + "w" #'gnus-article-decode-mime-words + "c" #'gnus-article-decode-charset + "h" #'gnus-mime-buttonize-attachments-in-header + "v" #'gnus-mime-view-all-parts + "b" #'gnus-article-view-part) + + "T" (define-keymap :prefix 'gnus-summary-wash-time-map + "z" #'gnus-article-date-ut + "u" #'gnus-article-date-ut + "l" #'gnus-article-date-local + "p" #'gnus-article-date-english + "e" #'gnus-article-date-lapsed + "o" #'gnus-article-date-original + "i" #'gnus-article-date-iso8601 + "s" #'gnus-article-date-user) + + "E" (define-keymap :prefix 'gnus-summary-wash-empty-map + "t" #'gnus-article-remove-trailing-blank-lines + "l" #'gnus-article-strip-leading-blank-lines + "m" #'gnus-article-strip-multiple-blank-lines + "a" #'gnus-article-strip-blank-lines + "A" #'gnus-article-strip-all-blank-lines + "s" #'gnus-article-strip-leading-space + "e" #'gnus-article-strip-trailing-space + "w" #'gnus-article-remove-leading-whitespace)) + + "H" (define-keymap :prefix 'gnus-summary-help-map + "v" #'gnus-version + "d" #'gnus-summary-describe-group + "h" #'gnus-summary-describe-briefly + "i" #'gnus-info-find-node) + + "B" (define-keymap :prefix 'gnus-summary-backend-map + "e" #'gnus-summary-expire-articles + "C-M-e" #'gnus-summary-expire-articles-now + "DEL" #'gnus-summary-delete-article + "<delete>" #'gnus-summary-delete-article + "<backspace>" #'gnus-summary-delete-article + "m" #'gnus-summary-move-article + "r" #'gnus-summary-respool-article + "w" #'gnus-summary-edit-article + "c" #'gnus-summary-copy-article + "B" #'gnus-summary-crosspost-article + "q" #'gnus-summary-respool-query + "t" #'gnus-summary-respool-trace + "i" #'gnus-summary-import-article + "I" #'gnus-summary-create-article + "p" #'gnus-summary-article-posted-p) + + "O" (define-keymap :prefix 'gnus-summary-save-map + "o" #'gnus-summary-save-article + "m" #'gnus-summary-save-article-mail + "F" #'gnus-summary-write-article-file + "r" #'gnus-summary-save-article-rmail + "f" #'gnus-summary-save-article-file + "b" #'gnus-summary-save-article-body-file + "B" #'gnus-summary-write-article-body-file + "h" #'gnus-summary-save-article-folder + "v" #'gnus-summary-save-article-vm + "p" #'gnus-summary-pipe-output + "P" #'gnus-summary-muttprint) + + "K" (define-keymap :prefix 'gnus-summary-mime-map + "b" #'gnus-summary-display-buttonized + "m" #'gnus-summary-repair-multipart + "v" #'gnus-article-view-part + "o" #'gnus-article-save-part + "O" #'gnus-article-save-part-and-strip + "r" #'gnus-article-replace-part + "d" #'gnus-article-delete-part + "t" #'gnus-article-view-part-as-type + "j" #'gnus-article-jump-to-part + "c" #'gnus-article-copy-part + "C" #'gnus-article-view-part-as-charset + "e" #'gnus-article-view-part-externally + "H" #'gnus-article-browse-html-article + "E" #'gnus-article-encrypt-body + "i" #'gnus-article-inline-part + "|" #'gnus-article-pipe-part) + + "X" (define-keymap :prefix 'gnus-uu-extract-map + ;;"x" gnus-uu-extract-any + "m" #'gnus-summary-save-parts + "u" #'gnus-uu-decode-uu + "U" #'gnus-uu-decode-uu-and-save + "s" #'gnus-uu-decode-unshar + "S" #'gnus-uu-decode-unshar-and-save + "o" #'gnus-uu-decode-save + "O" #'gnus-uu-decode-save + "b" #'gnus-uu-decode-binhex + "B" #'gnus-uu-decode-binhex + "Y" #'gnus-uu-decode-yenc + "p" #'gnus-uu-decode-postscript + "P" #'gnus-uu-decode-postscript-and-save + + "v" (define-keymap :prefix 'gnus-uu-extract-view-map + "u" #'gnus-uu-decode-uu-view + "U" #'gnus-uu-decode-uu-and-save-view + "s" #'gnus-uu-decode-unshar-view + "S" #'gnus-uu-decode-unshar-and-save-view + "o" #'gnus-uu-decode-save-view + "O" #'gnus-uu-decode-save-view + "b" #'gnus-uu-decode-binhex-view + "B" #'gnus-uu-decode-binhex-view + "p" #'gnus-uu-decode-postscript-view + "P" #'gnus-uu-decode-postscript-and-save-view))) (defvar gnus-article-post-menu nil) @@ -2889,45 +2885,11 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (defvar gnus-summary-tool-bar-map nil) -;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only -;; affect _new_ message buffers. We might add a function that walks thru all -;; summary-mode buffers and force the update. -(defun gnus-summary-tool-bar-update (&optional symbol value) - "Update summary mode toolbar. -Setter function for custom variables." - (setq-default gnus-summary-tool-bar-map nil) - (when symbol - ;; When used as ":set" function: - (set-default symbol value)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - (gnus-summary-make-tool-bar)))) - -(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome) - 'gnus-summary-tool-bar-gnome - 'gnus-summary-tool-bar-retro) - "Specifies the Gnus summary tool bar. - -It can be either a list or a symbol referring to a list. See -`gmm-tool-bar-from-list' for the format of the list. The -default key map is `gnus-summary-mode-map'. - -Pre-defined symbols include `gnus-summary-tool-bar-gnome' and -`gnus-summary-tool-bar-retro'." - :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome) - (const :tag "Retro look" gnus-summary-tool-bar-retro) - (repeat :tag "User defined list" gmm-tool-bar-item) - (symbol)) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) - -(defcustom gnus-summary-tool-bar-gnome +(defcustom gnus-summary-tool-bar '((gnus-summary-post-news "mail/compose" nil) - (gnus-summary-insert-new-articles "mail/inbox" nil - :visible (or (not gnus-agent) - gnus-plugged)) + (gnus-summary-insert-new-articles + "mail/inbox" nil + :visible (or (not gnus-agent) gnus-plugged)) (gnus-summary-reply-with-original "mail/reply") (gnus-summary-reply "mail/reply" nil :visible nil) (gnus-summary-followup-with-original "mail/reply-all") @@ -2937,17 +2899,10 @@ Pre-defined symbols include `gnus-summary-tool-bar-gnome' and (gnus-summary-search-article-forward "search" nil :visible nil) (gnus-summary-print-article "print") (gnus-summary-tick-article-forward "flag-followup" nil :visible nil) - ;; Some new commands that may need more suitable icons: (gnus-summary-save-newsrc "save" nil :visible nil) - ;; (gnus-summary-show-article "stock_message-display" nil :visible nil) (gnus-summary-prev-article "left-arrow") (gnus-summary-next-article "right-arrow") (gnus-summary-next-page "next-page") - ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil) - ;; - ;; Maybe some sort-by-... could be added: - ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil) - ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil) (gnus-summary-mark-as-expirable "delete" nil :visible (gnus-check-backend-function 'request-expire-articles @@ -2961,64 +2916,25 @@ Pre-defined symbols include `gnus-summary-tool-bar-gnome' and "mail/not-spam" nil :visible (and (fboundp 'spam-group-spam-contents-p) (spam-group-spam-contents-p gnus-newsgroup-name))) - ;; (gnus-summary-exit "exit") (gmm-customize-mode "preferences" t :help "Edit mode preferences") (gnus-info-find-node "help")) - "List of functions for the summary tool bar (GNOME style). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) + "Specifies the Gnus summary tool bar. -(defcustom gnus-summary-tool-bar-retro - '((gnus-summary-prev-unread-article "gnus/prev-ur") - (gnus-summary-next-unread-article "gnus/next-ur") - (gnus-summary-post-news "gnus/post") - (gnus-summary-followup-with-original "gnus/fuwo") - (gnus-summary-followup "gnus/followup") - (gnus-summary-reply-with-original "gnus/reply-wo") - (gnus-summary-reply "gnus/reply") - (gnus-summary-caesar-message "gnus/rot13") - (gnus-uu-decode-uu "gnus/uu-decode") - (gnus-summary-save-article-file "gnus/save-aif") - (gnus-summary-save-article "gnus/save-art") - (gnus-uu-post-news "gnus/uu-post") - (gnus-summary-catchup "gnus/catchup") - (gnus-summary-catchup-and-exit "gnus/cu-exit") - (gnus-summary-exit "gnus/exit-summ") - ;; Some new command that may need more suitable icons: - (gnus-summary-print-article "gnus/print" nil :visible nil) - (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil) - (gnus-summary-save-newsrc "gnus/save" nil :visible nil) - ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil) - (gnus-summary-search-article-forward "gnus/search" nil :visible nil) - ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil) - ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil) - ;; - (gnus-info-find-node "gnus/help" nil :visible nil)) - "List of functions for the summary tool bar (retro look). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update +It can be either a list or a symbol referring to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `gnus-summary-mode-map'." + :type '(choice (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "29.1" :group 'gnus-summary) -(defcustom gnus-summary-tool-bar-zap-list t - "List of icon items from the global tool bar. -These items are not displayed in the Gnus summary mode tool bar. - -See `gmm-tool-bar-from-list' for the format of the list." - :type 'gmm-tool-bar-zap-list - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) +(defvar gnus-summary-tool-bar-gnome nil) +(make-obsolete-variable 'gnus-summary-tool-bar-gnome nil "29.1") +(defvar gnus-summary-tool-bar-retro nil) +(make-obsolete-variable 'gnus-summary-tool-bar-retro nil "29.1") +(defvar gnus-summary-tool-bar-zap-list t) +(make-obsolete-variable 'gnus-summary-tool-bar-zap-list nil "29.1") (defvar image-load-path) (defvar tool-bar-map) @@ -3467,7 +3383,7 @@ marks of articles." (let (config) (goto-char (point-min)) (while (not (eobp)) - (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum) + (when (eq (get-char-property (line-end-position) 'invisible) 'gnus-sum) (push (save-excursion (forward-line 0) (point)) config)) (forward-line 1)) config))) @@ -3970,10 +3886,9 @@ Returns \" ? \" if there's bad input or if another error occurs. Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (condition-case () (let* ((messy-date (gnus-date-get-time messy-date)) - (now (current-time)) ;;If we don't find something suitable we'll use this one (my-format "%b %d '%y")) - (let* ((difference (time-subtract now messy-date)) + (let* ((difference (time-subtract nil messy-date)) (templist gnus-user-date-format-alist) (top (eval (caar templist) t))) (while (if (numberp top) (time-less-p top difference) (not top)) @@ -4590,7 +4505,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let (header) ;; overview: [num subject from date id refs chars lines misc] (unwind-protect - (narrow-to-region (point) (point-at-eol)) + (narrow-to-region (point) (line-end-position)) (unless (eobp) (forward-char)) (setq header (nnheader-parse-nov number)) @@ -4746,7 +4661,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (setq thread (list (car (gnus-id-to-thread id)))) ;; Get the thread this article is part of. (setq thread (gnus-remove-thread id))) - (setq old-pos (point-at-bol)) + (setq old-pos (line-beginning-position)) (setq current (save-excursion (and (re-search-backward "[\r\n]" nil t) (gnus-summary-article-number)))) @@ -4930,9 +4845,9 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-summary-show-thread) (gnus-data-remove number - (- (point-at-bol) + (- (line-beginning-position) (prog1 - (1+ (point-at-eol)) + (1+ (line-end-position)) (gnus-delete-line))))))) (defun gnus-sort-threads-recursive (threads func) @@ -5004,23 +4919,13 @@ If LINE, insert the rebuilt thread starting on line LINE." gnus-article-sort-functions))) (gnus-message 7 "Sorting articles...done")))) -;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. -(defmacro gnus-thread-header (thread) - "Return header of first article in THREAD. -Note that THREAD must never, ever be anything else than a variable - -using some other form will lead to serious barfage." - (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) - ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (cond - ((and (boundp 'lexical-binding) lexical-binding) - ;; FIXME: This version could be a "defsubst" rather than a macro. - `(#[257 "\211:\203\16\0\211@;\203\15\0A@@\207" - [] 2] - ,thread)) - (t - ;; Not sure how XEmacs handles these things, so let's keep the old code. - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" - (vector thread) 2)))) +(defsubst gnus-thread-header (thread) + "Return header of first article in THREAD." + (if (consp thread) + (car (if (stringp (car thread)) + (cadr thread) + thread)) + thread)) (defsubst gnus-article-sort-by-number (h1 h2) "Sort articles by article number." @@ -5768,7 +5673,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; (let ((n (cdr (gnus-active group)))) ;; (lambda () (> number (- n display)))) (setq select-articles - (gnus-uncompress-range + (range-uncompress (cons (let ((tmp (- (cdr (gnus-active group)) display))) (if (> tmp 0) tmp @@ -5941,7 +5846,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." "Find out what articles the user wants to read." (let* ((only-read-p t) (articles - (gnus-list-range-difference + (range-list-difference ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. (if (or read-all @@ -5956,13 +5861,13 @@ If SELECT-ARTICLES, only select those articles from GROUP." (or (if gnus-newsgroup-maximum-articles (let ((active (gnus-active group))) - (gnus-uncompress-range + (range-uncompress (cons (max (car active) (- (cdr active) gnus-newsgroup-maximum-articles -1)) (cdr active)))) - (gnus-uncompress-range (gnus-active group))) + (range-uncompress (gnus-active group))) (gnus-cache-articles-in-group group)) ;; Select only the "normal" subset of articles. (setq only-read-p nil) @@ -6053,7 +5958,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (defun gnus-killed-articles (killed articles) (let (out) (while articles - (when (inline (gnus-member-of-range (car articles) killed)) + (when (inline (range-member-p (car articles) killed)) (push (car articles) out)) (setq articles (cdr articles))) out)) @@ -6091,7 +5996,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Adjust "simple" lists - compressed yet unsorted ((eq mark-type 'list) ;; Simultaneously uncompress and clip to active range - ;; See gnus-uncompress-range for a description of possible marks + ;; See range-uncompress for a description of possible marks (let (l lh) (if (not (cadr marks)) (set var nil) @@ -6190,10 +6095,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; When exiting the group, everything that's previously been ;; unseen is now seen. (when (eq (cdr type) 'seen) - (setq list (gnus-range-add list gnus-newsgroup-unseen))) + (setq list (range-concat list gnus-newsgroup-unseen))) (when (eq (gnus-article-mark-to-type (cdr type)) 'list) - (setq list (gnus-compress-sequence (set symbol (sort list #'<)) t))) + (setq list (range-compress-list (set symbol (sort list #'<))))) (when (and (gnus-check-backend-function 'request-set-mark gnus-newsgroup-name) @@ -6202,20 +6107,19 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Don't do anything about marks for articles we ;; didn't actually get any headers for. (del - (gnus-list-range-intersection + (range-list-intersection gnus-newsgroup-articles - (gnus-remove-from-range (copy-tree old) list))) + (range-remove (copy-tree old) list))) (add - (gnus-list-range-intersection + (range-list-intersection gnus-newsgroup-articles - (gnus-remove-from-range - (copy-tree list) old)))) + (range-remove (copy-tree list) old)))) (when add (push (list add 'add (list (cdr type))) delta-marks)) (when del ;; Don't delete marks from outside the active range. ;; This shouldn't happen, but is a sanity check. - (setq del (gnus-sorted-range-intersection + (setq del (range-intersection (gnus-active gnus-newsgroup-name) del)) (push (list del 'del (list (cdr type))) delta-marks)))) @@ -6399,7 +6303,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq ninfo (cons 1 (1- (car active)))) (setq ninfo (gnus-info-read info))) ;; Then we add the read articles to the range. - (gnus-add-to-range + (range-add-list ninfo (setq articles (sort articles #'<)))))) (defun gnus-group-make-articles-read (group articles) @@ -6564,7 +6468,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) (point-at-eol))) + (setq xref (buffer-substring (point) (line-end-position))) (setf (mail-header-xref headers) xref))))))) (defun gnus-summary-insert-subject (id &optional old-header use-old-header) @@ -6595,9 +6499,9 @@ too, instead of trying to fetch new headers." (goto-char (gnus-data-pos d)) (gnus-data-remove number - (- (point-at-bol) + (- (line-beginning-position) (prog1 - (1+ (point-at-eol)) + (1+ (line-end-position)) (gnus-delete-line)))))) ;; Remove list identifiers from subject. (let ((gnus-newsgroup-headers (list header))) @@ -6980,10 +6884,10 @@ displayed, no centering will be performed." (marked (gnus-info-marks info)) (active (gnus-active group))) (and info active - (gnus-list-range-difference - (gnus-list-range-difference + (range-list-difference + (range-list-difference (gnus-sorted-complement - (gnus-uncompress-range + (range-uncompress (if gnus-newsgroup-maximum-articles (cons (max (car active) (- (cdr active) @@ -7142,12 +7046,11 @@ The prefix argument ALL means to select all articles." (when group (when gnus-newsgroup-kill-headers (setq gnus-newsgroup-killed - (gnus-compress-sequence + (range-compress-list (gnus-sorted-union - (gnus-list-range-intersection + (range-list-intersection gnus-newsgroup-unselected gnus-newsgroup-killed) - gnus-newsgroup-unreads) - t))) + gnus-newsgroup-unreads)))) (unless (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) (let ((headers gnus-newsgroup-headers) @@ -7208,7 +7111,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-dribble-save))) (declare-function gnus-cache-write-active "gnus-cache" (&optional force)) -(declare-function gnus-article-stop-animations "gnus-art" ()) (defun gnus-summary-exit (&optional temporary leave-hidden) "Exit reading current newsgroup, and then return to group selection mode. @@ -7272,7 +7174,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (not (string= group (gnus-group-group-name)))) (gnus-group-next-unread-group 1)) (setq group-point (point)) - (gnus-article-stop-animations) (unless leave-hidden (gnus-configure-windows 'group 'force)) (if temporary @@ -7332,7 +7233,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (run-hooks 'gnus-summary-prepare-exit-hook) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer - (gnus-article-stop-animations) (gnus-stop-downloads) (mm-destroy-parts gnus-article-mime-handles) ;; Set it to nil for safety reason. @@ -7364,7 +7264,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-group-update-group group nil t)) (when (gnus-group-goto-group group) (gnus-group-next-unread-group 1)) - (gnus-article-stop-animations) (when quit-config (gnus-handle-ephemeral-exit quit-config))))) @@ -8067,9 +7966,7 @@ Return nil if there are no unread articles." Return nil if there are no unread articles." (interactive nil gnus-summary-mode) (prog1 - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t)) + (gnus-summary--goto-and-possibly-unhide t) (gnus-summary-position-point))) (defun gnus-summary-next-unseen-article (&optional backward) @@ -8103,23 +8000,27 @@ Return nil if there are no unread articles." Return nil if there are no unseen articles." (interactive nil gnus-summary-mode) (prog1 - (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) + (gnus-summary--goto-and-possibly-unhide) (gnus-summary-position-point))) +(defun gnus-summary--goto-and-possibly-unhide (&optional unread undownloaded + unseen) + (let ((first (gnus-summary-first-subject unread undownloaded unseen))) + (if (and first + (not (= first (gnus-summary-article-number)))) + (progn + (gnus-summary-show-thread) + (gnus-summary-first-subject unread undownloaded unseen)) + first))) + (defun gnus-summary-first-unseen-or-unread-subject () "Place the point on the subject line of the first unseen and unread article. If all articles have been seen, on the subject line of the first unread article." (interactive nil gnus-summary-mode) (prog1 - (unless (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t))) + (unless (gnus-summary--goto-and-possibly-unhide nil nil t) + (gnus-summary-first-subject t)) (gnus-summary-position-point))) (defun gnus-summary-first-article () @@ -8673,20 +8574,20 @@ these articles." (gnus-fetch-old-headers nil) (gnus-build-sparse-threads nil)) (prog1 - (gnus-summary-limit (if thread-only articles - (nconc articles gnus-newsgroup-limit))) - (gnus-summary-limit-include-matching-articles - "subject" - (regexp-quote (gnus-general-simplify-subject - (mail-header-subject (gnus-id-to-header id))))) - ;; the previous two calls each push a limit onto the limit - ;; stack. the first pop remove the articles that match the - ;; subject, while the second pop gets us back to the state - ;; before we started to deal with the thread. presumably we want - ;; to think of the thread and its associated subject matches as - ;; a single thing so that we need to pop only once to get back - ;; to the original view. - (pop gnus-newsgroup-limits) + (gnus-summary-limit (if thread-only articles + (nconc articles gnus-newsgroup-limit))) + (let ((matching-subject (gnus-general-simplify-subject + (mail-header-subject (gnus-id-to-header id))))) + (when matching-subject + (gnus-summary-limit-include-matching-articles + "subject" + (regexp-quote matching-subject)) + ;; Each of the previous two limit calls push a limit onto + ;; the limit stack. Presumably we want to think of the + ;; thread and its associated subject matches as a single + ;; thing so we probably want a single pop to restore the + ;; original view. Hence we pop this last limit off. + (pop gnus-newsgroup-limits))) (gnus-summary-position-point)))) (defun gnus-summary-limit-include-matching-articles (header regexp) @@ -9462,6 +9363,16 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'." (push primary urls)) (delete-dups urls))) +(defun gnus-collect-urls-from-article () + "Select the article and return the list of URLs in it. +See `gnus-collect-urls'." + (gnus-summary-select-article) + (gnus-with-article-buffer + (article-goto-body) + ;; Back up a char, in case body starts with a button. + (backward-char) + (gnus-collect-urls))) + (defun gnus-shorten-url (url max) "Return an excerpt from URL not exceeding MAX characters." (if (<= (length url) max) @@ -9477,33 +9388,27 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'." "Scan the current article body for links, and offer to browse them. Links are opened using `browse-url' unless a prefix argument is -given: Then `browse-url-secondary-browser-function' is used instead. +given: then `browse-url-secondary-browser-function' is used instead. 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" gnus-summary-mode) - (let (urls target) - (gnus-summary-select-article) - (gnus-with-article-buffer - (article-goto-body) - ;; Back up a char, in case body starts with a button. - (backward-char) - (setq urls (gnus-collect-urls)) - (setq target - (cond ((= (length urls) 1) - (car urls)) - ((> (length urls) 1) - (completing-read - (format-prompt "URL to browse" - (gnus-shorten-url (car urls) 40)) - urls nil t nil nil (car urls))))) - (if target - (if external - (funcall browse-url-secondary-browser-function target) - (browse-url target)) - (message "No URLs found."))))) + (let* ((urls (gnus-collect-urls-from-article)) + (target + (cond ((= (length urls) 1) + (car urls)) + ((> (length urls) 1) + (completing-read + (format-prompt "URL to browse" + (gnus-shorten-url (car urls) 40)) + urls nil t nil nil (car urls)))))) + (if target + (if external + (funcall browse-url-secondary-browser-function target) + (browse-url target)) + (message "No URLs found.")))) (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. @@ -9908,7 +9813,6 @@ article. Normally, the keystroke is `\\[universal-argument] \\[gnus-summary-sho ;; Destroy any MIME parts. (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer - (gnus-article-stop-animations) (gnus-stop-downloads) (mm-destroy-parts gnus-article-mime-handles) ;; Set it to nil for safety reason. @@ -10257,8 +10161,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (cdr art-group)) (push 'read to-marks) (setf (gnus-info-read info) - (gnus-add-to-range (gnus-info-read info) - (list (cdr art-group))))) + (range-add-list (gnus-info-read info) + (list (cdr art-group))))) ;; See whether the article is to be put in the cache. (let* ((expirable (gnus-group-auto-expirable-p to-group)) @@ -10501,7 +10405,6 @@ latter case, they will be copied into the relevant groups." "Create an article in a mail newsgroup." (interactive nil gnus-summary-mode) (let ((group gnus-newsgroup-name) - (now (current-time)) group-art) (unless (gnus-check-backend-function 'request-accept-article group) (error "%s does not support article importing" group)) @@ -10511,7 +10414,7 @@ latter case, they will be copied into the relevant groups." ;; This doesn't look like an article, so we fudge some headers. (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" - "Date: " (message-make-date now) "\n" + "Date: " (message-make-date) "\n" "Message-ID: " (message-make-message-id) "\n") (setq group-art (gnus-request-accept-article group nil t)) (kill-buffer (current-buffer))) @@ -10542,7 +10445,7 @@ This will be the case if the article has both been mailed and posted." ;; This backend supports expiry. (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) (expirable - (gnus-list-range-difference + (range-list-difference (if total (progn ;; We need to update the info for @@ -11316,7 +11219,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (defun gnus-summary-update-mark (mark type) (let ((forward (cdr (assq type gnus-summary-mark-positions))) (inhibit-read-only t)) - (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit) + (re-search-backward "[\n\r]" (line-beginning-position) 'move-to-limit) (when forward (when (looking-at "\r") (cl-incf forward)) @@ -11853,7 +11756,7 @@ If ARG is positive number, turn showing conversation threads on." Returns nil if no thread was there to be shown." (interactive nil gnus-summary-mode) (let* ((orig (point)) - (end (point-at-eol)) + (end (line-end-position)) (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end)))) ;; Leave point at bol (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point))))) @@ -11915,7 +11818,8 @@ Returns nil if no threads were there to be hidden." (beginning-of-line) (let ((start (point)) (starteol (line-end-position)) - (article (gnus-summary-article-number))) + (article (unless (gnus-summary-article-intangible-p) + (gnus-summary-article-number)))) ;; Go forward until either the buffer ends or the subthread ends. (when (and (not (eobp)) (or (zerop (gnus-summary-next-thread 1 t)) @@ -11929,7 +11833,9 @@ Returns nil if no threads were there to be hidden." (let ((ol (make-overlay starteol (point) nil t nil))) (overlay-put ol 'invisible 'gnus-sum) (overlay-put ol 'evaporate t))) - (gnus-summary-goto-subject article) + (if article + (gnus-summary-goto-subject article) + (gnus-summary-position-point)) ;; We moved backward past the start point (invisible thread?) (when (> start (point)) (goto-char starteol))) @@ -12769,8 +12675,8 @@ If REVERSE, save parts that do not match TYPE." ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. (when gnus-summary-selected-face (save-excursion - (let* ((beg (point-at-bol)) - (end (point-at-eol)) + (let* ((beg (line-beginning-position)) + (end (line-end-position)) ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>. (from (if (get-text-property beg 'mouse-face) beg @@ -12826,7 +12732,7 @@ If REVERSE, save parts that do not match TYPE." (with-no-warnings ;See docstring of gnus-summary-highlight. (defvar score) (defvar default) (defvar default-high) (defvar default-low) (defvar mark) (defvar uncached)) - (let* ((beg (point-at-bol)) + (let* ((beg (line-beginning-position)) (article (or (gnus-summary-article-number) gnus-current-article)) (score (or (cdr (assq article gnus-newsgroup-scored)) @@ -12842,7 +12748,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 (1+ (point-at-eol)) 'face + beg (1+ (line-end-position)) 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function (funcall gnus-summary-highlight-line-function article face)))))) @@ -12888,8 +12794,8 @@ UNREAD is a sorted list." (gnus-find-method-for-group group) 'server-marks) (gnus-check-backend-function 'request-set-mark group)) - (let ((del (gnus-remove-from-range (gnus-info-read info) read)) - (add (gnus-remove-from-range read (gnus-info-read info)))) + (let ((del (range-remove (gnus-info-read info) read)) + (add (range-remove read (gnus-info-read info)))) (when (or add del) (unless (gnus-check-group group) (error "Can't open server for %s" group)) @@ -12989,7 +12895,7 @@ treated as multipart/mixed." (insert "Mime-Version: 1.0\n") (widen) (when (search-forward "\n--" nil t) - (let ((separator (buffer-substring (point) (point-at-eol)))) + (let ((separator (buffer-substring (point) (line-end-position)))) (message-narrow-to-head) (message-remove-header "Content-Type") (goto-char (point-max)) @@ -13021,7 +12927,7 @@ treated as multipart/mixed." (expirable gnus-expirable-mark "e")) "An alist of names/marks/keystrokes.") -(defvar gnus-summary-generic-mark-map (make-sparse-keymap)) +(defvar-keymap gnus-summary-generic-mark-map) (defvar gnus-summary-mark-map) (defun gnus-summary-make-all-marking-commands () @@ -13147,10 +13053,10 @@ If ALL is a number, fetch this number of articles." ;; Some nntp servers lie about their active range. When ;; this happens, the active range can be in the millions. ;; Use a compressed range to avoid creating a huge list. - (gnus-range-difference - (gnus-range-difference (list gnus-newsgroup-active) old) + (range-difference + (range-difference (list gnus-newsgroup-active) old) gnus-newsgroup-unexist)) - (setq len (gnus-range-length older)) + (setq len (range-length older)) (cond ((null older) nil) ((numberp all) @@ -13167,9 +13073,9 @@ If ALL is a number, fetch this number of articles." (push max older) (setq all (1- all) max (1- max)))))) - (setq older (gnus-uncompress-range older)))) + (setq older (range-uncompress older)))) (all - (setq older (gnus-uncompress-range older))) + (setq older (range-uncompress older))) (t (when (and (numberp gnus-large-newsgroup) (> len gnus-large-newsgroup)) @@ -13204,7 +13110,7 @@ If ALL is a number, fetch this number of articles." (push max older) (setq all (1- all) max (1- max)))))))))) - (setq older (gnus-uncompress-range older)))) + (setq older (range-uncompress older)))) (if (not older) (message "No old news.") (gnus-summary-insert-articles older) @@ -13294,6 +13200,8 @@ BOOKMARK is a bookmark name or a bookmark record." (buffer . ,(current-buffer)) . ,(bookmark-get-bookmark-record bookmark))))) +(put 'gnus-summary-bookmark-jump 'bookmark-handler-type "Gnus") + (gnus-summary-make-all-marking-commands) (provide 'gnus-sum) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 9493b02d062..13263dddc9c 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -107,15 +107,15 @@ should return non-nil if the topic is to be displayed." (defun gnus-group-topic-name () "The name of the topic on the current line." - (get-text-property (point-at-bol) 'gnus-topic)) + (get-text-property (line-beginning-position) 'gnus-topic)) (defun gnus-group-topic-level () "The level of the topic on the current line." - (get-text-property (point-at-bol) 'gnus-topic-level)) + (get-text-property (line-beginning-position) 'gnus-topic-level)) (defun gnus-group-topic-unread () "The number of unread articles in topic on the current line." - (get-text-property (point-at-bol) 'gnus-topic-unread)) + (get-text-property (line-beginning-position) 'gnus-topic-unread)) (defun gnus-topic-unread (topic) "Return the number of unread articles in TOPIC." @@ -128,7 +128,7 @@ should return non-nil if the topic is to be displayed." (defun gnus-topic-visible-p () "Return non-nil if the current topic is visible." - (get-text-property (point-at-bol) 'gnus-topic-visible)) + (get-text-property (line-beginning-position) 'gnus-topic-visible)) (defun gnus-topic-articles-in-topic (entries) (let ((total 0) @@ -188,7 +188,7 @@ If TOPIC, start with that topic." (defun gnus-group-active-topic-p () "Say whether the current topic comes from the active topics." - (get-text-property (point-at-bol) 'gnus-active)) + (get-text-property (line-beginning-position) 'gnus-active)) (defun gnus-topic-find-groups (topic &optional level all lowest recursive) "Return entries for all visible groups in TOPIC. @@ -650,6 +650,7 @@ articles in the topic and its subtopics." (let* ((visible (if visiblep "" "...")) (level level) (name name) + (entries entries) (indentation (make-string (* gnus-topic-indent-level level) ? )) (total-number-of-articles unread) (number-of-groups (length entries)) @@ -677,7 +678,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-topic-mode) + (when (and (derived-mode-p 'gnus-group-mode) gnus-topic-mode) (save-excursion (let ((alist gnus-topic-alist)) @@ -693,7 +694,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-topic-mode) + (when (and (derived-mode-p 'gnus-group-mode) gnus-topic-mode) (let ((group (gnus-group-group-name)) (m (point-marker)) @@ -747,8 +748,8 @@ articles in the topic and its subtopics." (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)) + (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))))) @@ -787,8 +788,8 @@ articles in the topic and its subtopics." (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)) + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode) nil t)) (parent (gnus-topic-parent-topic topic-name)) (all-entries entries) (unread 0) @@ -1056,63 +1057,56 @@ articles in the topic and its subtopics." ;;; Topic mode, commands and keymap. -(defvar gnus-topic-mode-map nil) -(defvar gnus-group-topic-map nil) - -(unless gnus-topic-mode-map - (setq gnus-topic-mode-map (make-sparse-keymap)) - +(defvar-keymap gnus-topic-mode-map ;; Override certain group mode keys. - (gnus-define-keys gnus-topic-mode-map - "=" gnus-topic-select-group - "\r" gnus-topic-select-group - " " gnus-topic-read-group - "\C-c\C-x" gnus-topic-expire-articles - "c" gnus-topic-catchup-articles - "\C-k" gnus-topic-kill-group - "\C-y" gnus-topic-yank-group - "\M-g" gnus-topic-get-new-news-this-topic - "AT" gnus-topic-list-active - "Gp" gnus-topic-edit-parameters - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - [tab] gnus-topic-indent - [(meta tab)] gnus-topic-unindent - "\C-i" gnus-topic-indent - "\M-\C-i" gnus-topic-unindent - [mouse-2] gnus-mouse-pick-topic) - - ;; Define a new submap. - (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map) - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - "n" gnus-topic-create-topic - "m" gnus-topic-move-group - "D" gnus-topic-remove-group - "c" gnus-topic-copy-group - "h" gnus-topic-hide-topic - "s" gnus-topic-show-topic - "j" gnus-topic-jump-to-topic - "M" gnus-topic-move-matching - "C" gnus-topic-copy-matching - "\M-p" gnus-topic-goto-previous-topic - "\M-n" gnus-topic-goto-next-topic - "\C-i" gnus-topic-indent - [tab] gnus-topic-indent - "r" gnus-topic-rename - "\177" gnus-topic-delete - [delete] gnus-topic-delete - "H" gnus-topic-toggle-display-empty-topics) - - (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map) - "s" gnus-topic-sort-groups - "a" gnus-topic-sort-groups-by-alphabet - "u" gnus-topic-sort-groups-by-unread - "l" gnus-topic-sort-groups-by-level - "e" gnus-topic-sort-groups-by-server - "v" gnus-topic-sort-groups-by-score - "r" gnus-topic-sort-groups-by-rank - "m" gnus-topic-sort-groups-by-method)) + "=" #'gnus-topic-select-group + "RET" #'gnus-topic-select-group + "SPC" #'gnus-topic-read-group + "C-c C-x" #'gnus-topic-expire-articles + "c" #'gnus-topic-catchup-articles + "C-k" #'gnus-topic-kill-group + "C-y" #'gnus-topic-yank-group + "M-g" #'gnus-topic-get-new-news-this-topic + "A T" #'gnus-topic-list-active + "G p" #'gnus-topic-edit-parameters + "#" #'gnus-topic-mark-topic + "M-#" #'gnus-topic-unmark-topic + "<tab>" #'gnus-topic-indent + "M-<tab>" #'gnus-topic-unindent + "TAB" #'gnus-topic-indent + "C-M-i" #'gnus-topic-unindent + "<mouse-2>" #'gnus-mouse-pick-topic + + "T" (define-keymap :prefix 'gnus-group-topic-map + "#" #'gnus-topic-mark-topic + "M-#" #'gnus-topic-unmark-topic + "n" #'gnus-topic-create-topic + "m" #'gnus-topic-move-group + "D" #'gnus-topic-remove-group + "c" #'gnus-topic-copy-group + "h" #'gnus-topic-hide-topic + "s" #'gnus-topic-show-topic + "j" #'gnus-topic-jump-to-topic + "M" #'gnus-topic-move-matching + "C" #'gnus-topic-copy-matching + "M-p" #'gnus-topic-goto-previous-topic + "M-n" #'gnus-topic-goto-next-topic + "TAB" #'gnus-topic-indent + "<tab>" #'gnus-topic-indent + "r" #'gnus-topic-rename + "DEL" #'gnus-topic-delete + "<delete>" #'gnus-topic-delete + "H" #'gnus-topic-toggle-display-empty-topics + + "S" (define-keymap :prefix 'gnus-topic-sort-map + "s" #'gnus-topic-sort-groups + "a" #'gnus-topic-sort-groups-by-alphabet + "u" #'gnus-topic-sort-groups-by-unread + "l" #'gnus-topic-sort-groups-by-level + "e" #'gnus-topic-sort-groups-by-server + "v" #'gnus-topic-sort-groups-by-score + "r" #'gnus-topic-sort-groups-by-rank + "m" #'gnus-topic-sort-groups-by-method))) (defun gnus-topic-make-menu-bar () (unless (boundp 'gnus-topic-menu) diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index 406d0a51d52..8c2be7b07e4 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -75,15 +75,12 @@ ;;; Minor mode definition. -(defvar gnus-undo-mode-map - (let ((map (make-sparse-keymap))) - (gnus-define-keys map - "\M-\C-_" gnus-undo - "\C-_" gnus-undo - "\C-xu" gnus-undo - ;; Many people are used to type `C-/' on GUI frames and get `C-_'. - [(control /)] gnus-undo) - map)) +(defvar-keymap gnus-undo-mode-map + "C-M-_" #'gnus-undo + "C-_" #'gnus-undo + "C-x u" #'gnus-undo + ;; many people are used to type `C-/' on GUI frames and get `C-_'. + "C-/" #'gnus-undo) (defun gnus-undo-make-menu-bar () ;; This is disabled for the time being. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 662817255bb..fe556b155a8 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -40,17 +40,14 @@ (defcustom gnus-completing-read-function 'gnus-emacs-completing-read "Function use to do completing read." - :version "24.1" + :version "29.1" :group 'gnus-meta :type '(radio (function-item :doc "Use Emacs standard `completing-read' function." gnus-emacs-completing-read) (function-item :doc "Use `ido-completing-read' function." - gnus-ido-completing-read) - (function-item - :doc "Use iswitchb based completing-read function." - gnus-iswitchb-completing-read))) + gnus-ido-completing-read))) (defcustom gnus-completion-styles (append (when (and (assq 'substring completion-styles-alist) @@ -121,7 +118,7 @@ This is a compatibility function for different Emacsen." ;; Delete the current line (and the next N lines). (defmacro gnus-delete-line (&optional n) - `(delete-region (point-at-bol) + `(delete-region (line-beginning-position) (progn (forward-line ,(or n 1)) (point)))) (defun gnus-extract-address-components (from) @@ -181,7 +178,7 @@ is slower." (defun gnus-goto-colon () (move-beginning-of-line 1) - (let ((eol (point-at-eol))) + (let ((eol (line-end-position))) (goto-char (or (text-property-any (point) eol 'gnus-position t) (search-forward ":" eol t) (point))))) @@ -300,25 +297,26 @@ Symbols are also allowed; their print names are used instead." (defmacro gnus-local-set-keys (&rest plist) "Set the keys in PLIST in the current keymap." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 (current-local-map) ',plist)) (defmacro gnus-define-keys (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 ,(if (symbolp keymap) keymap `',keymap) (quote ,plist))) (defmacro gnus-define-keys-safe (keymap &rest plist) "Define all keys in PLIST in KEYMAP without overwriting previous definitions." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) (defmacro gnus-define-keymap (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - (declare (indent 1)) + (declare (obsolete define-keymap "29.1") (indent 1)) `(gnus-define-keys-1 ,keymap (quote ,plist))) (defun gnus-define-keys-1 (keymap plist &optional safe) + (declare (obsolete define-keymap "29.1")) (when (null keymap) (error "Can't set keys in a null keymap")) (cond ((symbolp keymap) (error "First arg should be a keymap object")) @@ -382,7 +380,7 @@ Cache the result as a text property stored in DATE." ;; Either return the cached value... `(let ((d ,date)) (if (equal "" d) - '(0 0) + 0 (or (get-text-property 0 'gnus-time d) ;; or compute the value... (let ((time (safe-date-to-time d))) @@ -561,7 +559,7 @@ If N, return the Nth ancestor instead." buffer)) (define-obsolete-function-alias 'gnus-buffer-exists-p - 'gnus-buffer-live-p "27.1") + #'gnus-buffer-live-p "27.1") (defun gnus-horizontal-recenter () "Recenter the current buffer horizontally." @@ -679,7 +677,7 @@ yield \"nnimap:yxa\"." (defun gnus-turn-off-edit-menu (type) "Turn off edit menu in `gnus-TYPE-mode-map'." (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) - [menu-bar edit] 'undefined)) + [menu-bar edit] #'undefined)) (defvar print-string-length) @@ -749,15 +747,6 @@ nil. See also `gnus-bind-print-variables'." (when (file-exists-p file) (delete-file file))) -(defun gnus-delete-duplicates (list) - "Remove duplicate entries from LIST." - (let ((result nil)) - (while list - (unless (member (car list) result) - (push (car list) result)) - (pop list)) - (nreverse result))) - (defun gnus-delete-directory (directory) "Delete files in DIRECTORY. Subdirectories remain. If there's no subdirectory, delete DIRECTORY as well." @@ -857,126 +846,9 @@ variables and then do only the assignment atomically." `(let ((inhibit-quit gnus-atomic-be-safe)) ,@forms)) -;;; Functions for saving to babyl/mail files. - -(require 'rmail) -(autoload 'rmail-update-summary "rmailsum") - (defvar mm-text-coding-system) - (declare-function mm-append-to-file "mm-util" (start end filename &optional codesys inhibit)) -(declare-function rmail-swap-buffers-maybe "rmail" ()) -(declare-function rmail-maybe-set-message-counters "rmail" ()) -(declare-function rmail-count-new-messages "rmail" (&optional nomsg)) -(declare-function rmail-summary-exists "rmail" ()) -(declare-function rmail-show-message "rmail" (&optional n no-summary)) -;; Macroexpansion of rmail-select-summary: -(declare-function rmail-summary-displayed "rmail" ()) -(declare-function rmail-pop-to-buffer "rmail" (&rest args)) -(declare-function rmail-maybe-display-summary "rmail" ()) - -(defun gnus-output-to-rmail (filename &optional ask) - "Append the current article to an Rmail file named FILENAME. -In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless -FILENAME exists and is Babyl format." - (require 'rmail) - (require 'mm-util) - (require 'nnmail) - ;; Some of this codes is borrowed from rmailout.el. - (setq filename (expand-file-name filename)) - ;; FIXME should we really be messing with this defcustom? - ;; It is not needed for the operation of this function. - (if (boundp 'rmail-default-rmail-file) - (setq rmail-default-rmail-file filename) ; 22 - (setq rmail-default-file filename)) ; 23 - (let ((artbuf (current-buffer)) - (tmpbuf (gnus-get-buffer-create " *Gnus-output*")) - ;; Babyl rmail.el defines this, mbox does not. - (babyl (fboundp 'rmail-insert-rmail-file-header))) - (save-excursion - ;; Note that we ignore the possibility of visiting a Babyl - ;; format buffer in Emacs 23, since Rmail no longer supports that. - (or (get-file-buffer filename) - (progn - ;; In case someone wants to write to a Babyl file from Emacs 23. - (when (file-exists-p filename) - (setq babyl (mail-file-babyl-p filename)) - t)) - (if (or (not ask) - (gnus-yes-or-no-p - (concat "\"" filename "\" does not exist, create it? "))) - (let ((file-buffer (create-file-buffer filename))) - (with-current-buffer file-buffer - (if (fboundp 'rmail-insert-rmail-file-header) - (rmail-insert-rmail-file-header)) - (let ((require-final-newline nil) - (coding-system-for-write mm-text-coding-system)) - (gnus-write-buffer filename))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (erase-buffer) - (insert-buffer-substring artbuf) - (if babyl - (gnus-convert-article-to-rmail) - ;; Non-Babyl case copied from gnus-output-to-mail. - (goto-char (point-min)) - (if (looking-at "From ") - (forward-line 1) - (insert "From nobody " (current-time-string) "\n")) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert ">")))) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer filename))) - (if (not outbuf) - (progn - (unless babyl ; from gnus-output-to-mail - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (forward-char -2) - (unless (looking-at "\n\n") - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert "\n")))) - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (mm-append-to-file (point-min) (point-max) filename))) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil) - (msg (and (boundp 'rmail-current-message) - (symbol-value 'rmail-current-message)))) - ;; If MSG is non-nil, buffer is in RMAIL mode. - ;; Compare this with rmail-output-to-rmail-buffer in Emacs 23. - (when msg - (unless babyl - (rmail-swap-buffers-maybe) - (rmail-maybe-set-message-counters)) - (widen) - (unless babyl - (goto-char (point-max)) - ;; Ensure we have a blank line before the next message. - (unless (bolp) - (insert "\n")) - (insert "\n")) - (narrow-to-region (point-max) (point-max))) - (insert-buffer-substring tmpbuf) - (when msg - (when babyl - (goto-char (point-min)) - (widen) - (search-backward "\n\^_") - (narrow-to-region (point) (point-max))) - (rmail-count-new-messages t) - (when (rmail-summary-exists) - (rmail-select-summary - (rmail-update-summary))) - (rmail-show-message msg)) - (save-buffer))))) - (kill-buffer tmpbuf))) (defun gnus-output-to-mail (filename &optional ask) "Append the current article to a mail file named FILENAME." @@ -1034,17 +906,6 @@ FILENAME exists and is Babyl format." (insert-buffer-substring tmpbuf))))) (kill-buffer tmpbuf))) -(defun gnus-convert-article-to-rmail () - "Convert article in current buffer to Rmail message format." - (let ((buffer-read-only nil)) - ;; Convert article directly into Babyl format. - (goto-char (point-min)) - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (while (search-forward "\n\^_" nil t) ;single char - (replace-match "\n^_" t t)) ;2 chars: "^" and "_" - (goto-char (point-max)) - (insert "\^_"))) - (defun gnus-map-function (funs arg) "Apply the result of the first function in FUNS to the second, and so on. ARG is passed to the first function." @@ -1081,9 +942,9 @@ ARG is passed to the first function." (with-current-buffer gnus-group-buffer (eq major-mode 'gnus-group-mode)))) -(define-obsolete-function-alias 'gnus-remove-if 'seq-remove "27.1") +(define-obsolete-function-alias 'gnus-remove-if #'seq-remove "27.1") -(define-obsolete-function-alias 'gnus-remove-if-not 'seq-filter "27.1") +(define-obsolete-function-alias 'gnus-remove-if-not #'seq-filter "27.1") (defun gnus-grep-in-list (word list) "Find if a WORD matches any regular expression in the given LIST." @@ -1205,6 +1066,7 @@ ARG is passed to the first function." ;; (`string-equal' uses symbol print names.) (defun gnus-string-equal (x y) "Like `string-equal', except it compares case-insensitively." + (declare (obsolete string-equal-ignore-case "29.1")) (and (= (length x) (length y)) (or (string-equal x y) (string-equal (downcase x) (downcase y))))) @@ -1218,9 +1080,10 @@ ARG is passed to the first function." (defun gnus-byte-compile (form) "Byte-compile FORM if `gnus-use-byte-compile' is non-nil." (if gnus-use-byte-compile - (let ((byte-compile-warnings '(unresolved callargs redefine))) + (let ((byte-compile-warnings '(unresolved callargs redefine)) + (lexical-binding t)) (byte-compile form)) - form)) + (eval form t))) (defun gnus-remassoc (key alist) "Delete by side effect any elements of LIST whose car is `equal' to KEY. @@ -1259,14 +1122,11 @@ sure of changing the value of `foo'." If you find some problem with the directory separator character, try \"[/\\\\]\" for some systems.") -(defun gnus-url-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) +(autoload 'url-unhex "url-util") +(define-obsolete-function-alias 'gnus-url-unhex #'url-unhex "29.1") -;; Fixme: Do it like QP. +;; FIXME: Make obsolete in favor of `url-unhex-string', which is +;; identical except for the call to `char-to-string'. (defun gnus-url-unhex-string (str &optional allow-newlines) "Remove %XX, embedded spaces, etc in a url. If optional second argument ALLOW-NEWLINES is non-nil, then allow the @@ -1276,9 +1136,9 @@ forbidden in URL encoding." (case-fold-search t)) (while (string-match "%[0-9a-f][0-9a-f]" str) (let* ((start (match-beginning 0)) - (ch1 (gnus-url-unhex (elt str (+ start 1)))) + (ch1 (url-unhex (elt str (+ start 1)))) (code (+ (* 16 ch1) - (gnus-url-unhex (elt str (+ start 2)))))) + (url-unhex (elt str (+ start 2)))))) (setq tmp (concat tmp (substring str 0 start) (cond @@ -1310,9 +1170,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', initial-input history def) "Call `gnus-completing-read-function'." (funcall gnus-completing-read-function - (concat prompt (when def - (concat " (default " def ")")) - ": ") + (format-prompt prompt def) collection require-match initial-input history def)) (defun gnus-emacs-completing-read (prompt collection &optional require-match @@ -1341,6 +1199,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (defun gnus-iswitchb-completing-read (prompt collection &optional require-match initial-input history def) "`iswitchb' based completing-read function." + (declare (obsolete nil "29.1")) ;; Make sure iswitchb is loaded before we let-bind its variables. ;; If it is loaded inside the let, variables can become unbound afterwards. (require 'iswitchb) @@ -1381,7 +1240,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', contents value) (if (or (null (setq value (symbol-value variable))) (not (equal (car value) file)) - (not (equal (nth 1 value) time))) + (not (time-equal-p (nth 1 value) time))) (progn (setq contents (funcall function file)) (set variable (list file time contents)) @@ -1515,8 +1374,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp system-configuration) ((memq 'type lst) (symbol-name system-type)) - (t nil))) - ) ;; codename + (t nil)))) (cond ((not (memq 'emacs lst)) nil) @@ -1676,6 +1534,13 @@ lists of strings." (while overlays (delete-overlay (pop overlays))))) +;; This function used to live in this file, but was moved to a +;; separate file to avoid pulling in rmail.el when requiring +;; gnus-util. +(autoload 'gnus-output-to-rmail "gnus-rmail") + +(define-obsolete-function-alias 'gnus-delete-duplicates #'seq-uniq "29.1") + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 6990d8ee778..9cafc78ab89 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -260,9 +260,10 @@ Default is t." "Non-nil means that files will be viewed with metamail. The gnus-uu viewing functions will be ignored and gnus-uu will try to guess at a content-type based on file name suffixes. Default -it nil." +is nil." :group 'gnus-extract :type 'boolean) +(make-obsolete-variable 'gnus-uu-view-with-metamail "don't use it." "29.1") (defcustom gnus-uu-unmark-articles-not-decoded nil "If non-nil, gnus-uu will mark unsuccessfully decoded articles as unread. @@ -543,11 +544,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "Various")))) (goto-char (point-min)) (when (re-search-forward "^Subject: ") - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) (insert subject)) (goto-char (point-min)) (when (re-search-forward "^From:") - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) (insert " " from)) (let ((message-forward-decoded-p t)) (message-forward post t)))) @@ -1762,7 +1763,7 @@ Gnus might fail to display all of it.") (unless (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string)) (when (not found) - (setq length (- (point-at-eol) (point-at-bol)))) + (setq length (- (line-end-position) (line-beginning-position)))) (setq found t) (beginning-of-line) (setq beg (point)) @@ -2067,7 +2068,7 @@ If no file has been included, the user will be asked for a file." (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (setq header (buffer-substring (point-min) (point-at-bol))) + (setq header (buffer-substring (point-min) (line-beginning-position))) (goto-char (point-min)) (when gnus-uu-post-separate-description diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index ad7062d84bd..0afd873a5df 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -662,12 +662,11 @@ be used directly.") (gnus-prune-buffers) (cl-pushnew (current-buffer) gnus-buffers)) -(defmacro gnus-kill-buffer (buffer) +(defun gnus-kill-buffer (buffer) "Kill BUFFER and remove from the list of Gnus buffers." - `(let ((buf ,buffer)) - (when (gnus-buffer-live-p buf) - (kill-buffer buf) - (gnus-prune-buffers)))) + (when (gnus-buffer-live-p buffer) + (kill-buffer buffer) + (gnus-prune-buffers))) (defun gnus-buffers () "Return a list of live Gnus buffers." @@ -1111,14 +1110,6 @@ that case, just return a fully prefixed name of the group -- sexp string)) -(defcustom gnus-secondary-servers nil - "List of NNTP servers that the user can choose between interactively. -To make Gnus query you for a server, you have to give `gnus' a -non-numeric prefix - `\\[universal-argument] \\[gnus]', in short." - :group 'gnus-server - :type '(repeat string)) -(make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1") - (defcustom gnus-secondary-select-methods nil "A list of secondary methods that will be used for reading news. This is a list where each element is a complete select method (see @@ -1131,16 +1122,6 @@ you could set this variable: :group 'gnus-server :type '(repeat gnus-select-method)) -(defcustom gnus-local-domain nil - "Local domain name without a host name. -The DOMAINNAME environment variable is used instead if it is defined. -If the function `system-name' returns the full Internet name, there is -no need to set this variable." - :group 'gnus-message - :type '(choice (const :tag "default" nil) - string)) -(make-obsolete-variable 'gnus-local-domain nil "24.1") - ;; Customization variables (defcustom gnus-refer-article-method 'current @@ -1467,11 +1448,11 @@ address was listed in gnus-group-split Addresses (see below).") :variable-group gnus-group-parameter :parameter-type '(gnus-email-address :tag "To List") :parameter-document "\ -This address will be used when doing a `a' in the group. +This address will be used when doing a \\`a' in the group. It is totally ignored when doing a followup--except that if it is present in a news group, you'll get mail group semantics when doing -`f'. +\\`f'. The gnus-group-split mail splitting mechanism will behave as if this address was listed in gnus-group-split Addresses (see below).") @@ -1592,7 +1573,7 @@ posting an article." "Alist of group regexps and its initial input of the number of articles." :variable-group gnus-group-parameter :parameter-type '(choice :tag "Initial Input for Large Newsgroup" - (const :tag "All" 'all) + (const :tag "All" all) (integer)) :parameter-document "\ @@ -2255,21 +2236,18 @@ Disabling the agent may result in noticeable loss of performance." "Which information should be exposed in the User-Agent header. Can be a list of symbols or a string. Valid symbols are `gnus' -\(show Gnus version) and `emacs' \(show Emacs version). In -addition to the Emacs version, you can add `codename' \(show -\(S)XEmacs codename) or either `config' \(show system -configuration) or `type' \(show system type). If you set it to -a string, be sure to use a valid format, see RFC 2616." - +(show Gnus version) and `emacs' (show Emacs version). In +addition to the Emacs version, you can add `config' (show system +configuration) or `type' (show system type). If you set it to a +string, be sure to use a valid format, see RFC 2616." :version "22.1" :group 'gnus-message :type '(choice (list (set :inline t - (const gnus :tag "Gnus version") - (const emacs :tag "Emacs version") + (const :value gnus :tag "Gnus version") + (const :value emacs :tag "Emacs version") (choice :tag "system" - (const type :tag "system type") - (const config :tag "system configuration")) - (const codename :tag "Emacs codename"))) + (const :value type :tag "system type") + (const :value config :tag "system configuration")))) (string))) ;; Convert old (< 2005-01-10) symbol type values: @@ -2317,11 +2295,6 @@ automatically cache the article in the agent cache." (defvar gnus-server-method-cache nil) (defvar gnus-extended-servers nil) -;; The carpal mode has been removed, but define the variable for -;; backwards compatibility. -(defvar gnus-carpal nil) -(make-obsolete-variable 'gnus-carpal nil "24.1") - (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") @@ -2528,16 +2501,9 @@ are always t.") ("babel" babel-as-string) ("nnmail" nnmail-split-fancy nnmail-article-group) ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) - ;; This is only used in message.el, which has an autoload. - ("rmailout" rmail-output) - ;; Next two used in gnus-util, which has autoloads, and contrib/sendmail. - ("rmail" rmail-count-new-messages rmail-show-message - ;; Next two only used in gnus-util. - rmail-summary-exists rmail-select-summary) - ;; Only used in gnus-util, which has an autoload. - ("rmailsum" rmail-update-summary) ("gnus-xmas" gnus-xmas-splash) ("score-mode" :interactive t gnus-score-mode) + ("gnus-score" :interactive t gnus-score-edit-all-score) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder) @@ -2609,7 +2575,11 @@ are always t.") gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view gnus-uu-unmark-thread - gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable) + gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable + gnus-uu-decode-postscript-and-save-view + gnus-uu-decode-postscript-view gnus-uu-decode-postscript-and-save + gnus-uu-decode-yenc gnus-uu-unmark-by-regexp gnus-uu-unmark-region + gnus-uu-decode-postscript) ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) gnus-article-mail gnus-copy-article-buffer gnus-extended-version) @@ -2656,6 +2626,7 @@ are always t.") gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-remove-cr gnus-article-remove-trailing-blank-lines + gnus-article-emojize-symbols gnus-article-display-x-face gnus-article-de-quoted-unreadable gnus-article-de-base64-unreadable gnus-article-decode-HZ @@ -2667,7 +2638,34 @@ are always t.") gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done gnus-article-decode-encoded-words gnus-start-date-timer gnus-stop-date-timer - gnus-mime-view-all-parts) + gnus-mime-view-all-parts gnus-article-pipe-part + gnus-article-inline-part gnus-article-encrypt-body + gnus-article-browse-html-article gnus-article-view-part-externally + gnus-article-view-part-as-charset gnus-article-copy-part + gnus-article-jump-to-part gnus-article-view-part-as-type + gnus-article-delete-part gnus-article-replace-part + gnus-article-save-part-and-strip gnus-article-save-part + gnus-article-remove-leading-whitespace gnus-article-strip-trailing-space + gnus-article-strip-leading-space gnus-article-strip-all-blank-lines + gnus-article-strip-blank-lines gnus-article-strip-multiple-blank-lines + gnus-article-date-user gnus-article-date-iso8601 + gnus-article-date-english gnus-article-date-ut + gnus-article-decode-charset gnus-article-decode-mime-words + gnus-article-toggle-fonts gnus-article-show-images + gnus-article-remove-images gnus-article-display-face + gnus-article-treat-fold-newsgroups gnus-article-treat-unfold-headers + gnus-article-treat-fold-headers gnus-article-highlight-signature + gnus-article-highlight-headers gnus-article-highlight + gnus-article-strip-banner gnus-article-hide-list-identifiers + gnus-article-hide gnus-article-outlook-rearrange-citation + gnus-article-treat-non-ascii gnus-article-treat-smartquotes + gnus-article-verify-x-pgp-sig gnus-article-strip-headers-in-body + gnus-treat-smiley gnus-article-treat-ansi-sequences + gnus-article-capitalize-sentences gnus-article-toggle-truncate-lines + gnus-article-fill-long-lines gnus-article-emphasize + gnus-article-add-buttons-to-head gnus-article-add-button + gnus-article-babel gnus-sticky-article gnus-article-view-part + gnus-article-add-buttons) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch @@ -3118,9 +3116,9 @@ g -- Group name." "Check whether GROUP supports function FUNC. GROUP can either be a string (a group name) or a select method." (ignore-errors - (let ((method (if (stringp group) - (car (gnus-find-method-for-group group)) - group))) + (when-let ((method (if (stringp group) + (car (gnus-find-method-for-group group)) + group))) (unless (featurep method) (require method)) (fboundp (intern (format "%s-%s" method func)))))) @@ -3754,6 +3752,8 @@ just the host name." (setq foreign server group (substring group (+ 1 colon)))) (setq foreign (concat foreign ":"))) + ;; Remove braces from name (common in IMAP groups). + (setq group (replace-regexp-in-string "[][]+" "" group)) ;; Collapse group name leaving LEVELS uncollapsed elements (let* ((slist (split-string group "/")) (slen (length slist)) @@ -4166,8 +4166,7 @@ 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 (or (byte-code-function-p (symbol-function 'gnus)) - (subr-native-elisp-p (symbol-function 'gnus))) + (unless (compiled-function-p (symbol-function 'gnus)) (message "You should compile Gnus") (sit-for 2)) (let ((gnus-action-message-log (list nil))) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index a0edbf6a2ad..320bc9c3b0e 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -31,6 +31,7 @@ (autoload 'pop3-movemail "pop3") (autoload 'pop3-get-message-count "pop3") (require 'mm-util) +(require 'gnus-range) (require 'message) ;; for `message-directory' (defvar display-time-mail-function) @@ -224,12 +225,9 @@ Leave mails for this many days" :value 14))))) (const :format "" :value :plugged) (boolean :tag "Plugged")))))))) -(defcustom mail-source-ignore-errors nil - "Ignore errors when querying mail sources. -If nil, the user will be prompted when an error occurs. If non-nil, -the error will be ignored." - :version "22.1" - :type 'boolean) +(make-obsolete-variable 'mail-source-ignore-errors + "configure `gnus-verbose' instead" + "29.1") (defcustom mail-source-primary-source nil "Primary source for incoming mail. @@ -415,7 +413,7 @@ the `mail-source-keyword-map' variable." (let* ((type (pop source)) (defaults (cdr (assq type mail-source-keyword-map))) (search '(:max 1)) - found default value keyword user-auth pass-auth) ;; auth-info + found default keyword user-auth pass-auth) ;; auth-info ;; append to the search the useful info from the source and the defaults: ;; user, host, and port @@ -442,22 +440,22 @@ the `mail-source-keyword-map' variable." ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL ;; using `mail-source-value' to evaluate the plist value (set (mail-source-strip-keyword (setq keyword (car default))) - ;; note the following reasons for this structure: + ;; Note the following reasons for this structure: ;; 1) the auth-sources user and password override everything ;; 2) it avoids macros, so it's cleaner ;; 3) it falls through to the mail-sources and then default values (cond ((and - (eq keyword :user) - (setq user-auth - (plist-get - ;; cache the search result in `found' - (or found - (setq found (nth 0 (apply #'auth-source-search - search)))) - :user))) + (eq keyword :user) + (setq user-auth + (plist-get + ;; cache the search result in `found' + (or found + (setq found (nth 0 (apply #'auth-source-search + search)))) + :user))) user-auth) - ((and + ((and ; cf. 'auth-source-pick-first-password' (eq keyword :password) (setq pass-auth (plist-get @@ -470,9 +468,8 @@ the `mail-source-keyword-map' variable." (if (functionp pass-auth) (setq pass-auth (funcall pass-auth)) pass-auth)) - (t (if (setq value (plist-get source keyword)) - (mail-source-value value) - (mail-source-value (cadr default))))))))) + (t (mail-source-value (or (plist-get source keyword) + (cadr default))))))))) (eval-and-compile (defun mail-source-bind-common-1 () @@ -554,18 +551,16 @@ Return the number of files that were found." (condition-case err (funcall function source callback) (error - (if (and (not mail-source-ignore-errors) - (not - (yes-or-no-p - (format "Mail source %s error (%s). Continue? " + (gnus-error + 5 + (format "Mail source %s error (%s)" (if (memq ':password source) (let ((s (copy-sequence source))) (setcar (cdr (memq ':password s)) "********") s) source) - (cadr err))))) - (error "Cannot get new mail")) + (cadr err))) 0))))))))) (declare-function gnus-message "gnus-util" (level &rest args)) @@ -1053,8 +1048,6 @@ This only works when `display-time' is enabled." (autoload 'imap-range-to-message-set "imap") (autoload 'nnheader-ms-strip-cr "nnheader") -(autoload 'gnus-compress-sequence "gnus-range") - (defvar mail-source-imap-file-coding-system 'binary "Coding system for the crashbox made by `mail-source-fetch-imap'.") @@ -1072,9 +1065,7 @@ This only works when `display-time' is enabled." (let ((from (format "%s:%s:%s" server user port)) (found 0) (buf (generate-new-buffer " *imap source*")) - (mail-source-string (format "imap:%s:%s" server mailbox)) - (imap-shell-program (or (list program) imap-shell-program)) - remove) + (imap-shell-program (or (list program) imap-shell-program))) (if (and (imap-open server port stream authentication buf) (imap-authenticate user (or (cdr (assoc from mail-source-password-cache)) @@ -1083,8 +1074,10 @@ This only works when `display-time' is enabled." (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox)))) (dolist (mailbox mailbox-list) (when (imap-mailbox-select mailbox nil buf) - (let ((coding-system-for-write mail-source-imap-file-coding-system) - str) + (let ((coding-system-for-write + mail-source-imap-file-coding-system) + (mail-source-string (format "imap:%s:%s" server mailbox)) + str remove) (message "Fetching from %s..." mailbox) (with-temp-file mail-source-crash-box ;; Avoid converting 8-bit chars from inserted strings to diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index cbaa74d61cf..49a04f601f8 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -48,6 +48,9 @@ (require 'puny) (require 'rmc) ; read-multiple-choice (require 'subr-x) +(require 'yank-media) +(require 'mailcap) +(require 'sendmail) (autoload 'mailclient-send-it "mailclient") @@ -714,7 +717,7 @@ The function accepts 1 parameter which is the matched prefix." (defvar sendmail-program) (cond ((executable-find sendmail-program) #'message-send-mail-with-sendmail) - ((bound-and-true-p 'smtpmail-default-smtp-server) + ((bound-and-true-p smtpmail-default-smtp-server) #'message-smtpmail-send-it) (t #'message-send-mail-with-mailclient))) @@ -1408,7 +1411,7 @@ text and it replaces `self-insert-command' with the other command, e.g. (file-name-as-directory (expand-file-name "drafts" message-directory)) "~/") "Directory where Message auto-saves buffers if Gnus isn't running. -If nil, Message won't auto-save." +If nil, Message won't auto-save, whether or not Gnus is running." :group 'message-buffers :link '(custom-manual "(message)Various Message Variables") :type '(choice directory (const :tag "Don't auto-save" nil))) @@ -1465,11 +1468,11 @@ candidates: (memq feature message-shoot-gnksa-feet))) (defcustom message-hidden-headers '("^References:" "^Face:" "^X-Face:" - "^X-Draft-From:") + "^X-Draft-From:" "^In-Reply-To:") "Regexp of headers to be hidden when composing new messages. This can also be a list of regexps to match headers. Or a list starting with `not' and followed by regexps." - :version "22.1" + :version "29.1" :group 'message :link '(custom-manual "(message)Message Headers") :type '(choice @@ -2051,7 +2054,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (autoload 'gnus-groups-from-server "gnus") (autoload 'gnus-open-server "gnus-int") (autoload 'gnus-output-to-mail "gnus-util") -(autoload 'gnus-output-to-rmail "gnus-util") +(autoload 'gnus-output-to-rmail "gnus-rmail") (autoload 'gnus-request-post "gnus-int") (autoload 'gnus-server-string "gnus") (autoload 'message-setup-toolbar "messagexmas") @@ -2078,11 +2081,13 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (defsubst message-delete-line (&optional n) "Delete the current line (and the next N lines)." + (declare (obsolete delete-line "29.1")) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line (or n 1)) (point)))) (defun message-mark-active-p () "Non-nil means the mark and region are currently active in this buffer." + (declare (obsolete mark-active "29.1")) mark-active) (defun message-unquote-tokens (elems) @@ -2180,7 +2185,7 @@ see `message-narrow-to-headers-or-head'." (progn (forward-line 1) (if (re-search-forward "^[^ \n\t]" nil t) - (point-at-bol) + (line-beginning-position) (point-max)))) (goto-char (point-min))) @@ -2381,7 +2386,7 @@ Leading \"Re: \" is not stripped by this function. Use the function (setq old-subject (message-strip-subject-re old-subject)) (message-goto-subject) - (message-delete-line) + (delete-line) (insert (concat "Subject: " new-subject " (was: " @@ -2496,12 +2501,12 @@ been made to before the user asked for a Crosspost." (while (re-search-backward (concat "^" (regexp-quote message-cross-post-note) ".*") head t) - (message-delete-line)) + (delete-line)) (message-goto-signature) (while (re-search-backward (concat "^" (regexp-quote message-followup-to-note) ".*") head t) - (message-delete-line)) + (delete-line)) ;; insert new note (if (message-goto-signature) (re-search-backward message-signature-separator)) @@ -2573,7 +2578,7 @@ With prefix-argument just set Follow-Up, don't cross-post." (cond (cc-content (save-excursion (message-goto-to) - (message-delete-line) + (delete-line) (insert (concat "To: " cc-content "\n")) (save-restriction (message-narrow-to-headers) @@ -2728,20 +2733,17 @@ Point is left at the beginning of the narrowed-to region." (interactive nil message-mode) (save-excursion (save-restriction - (let ((max (1+ (length message-header-format-alist))) - rank) + (let ((max (1+ (length message-header-format-alist)))) (message-narrow-to-headers) (while (re-search-forward "^[^ \n]+:" nil t) (put-text-property (match-beginning 0) (1+ (match-beginning 0)) 'message-rank - (if (setq rank (length (memq (assq (intern (buffer-substring - (match-beginning 0) - (1- (match-end 0)))) - message-header-format-alist) - message-header-format-alist))) - (- max rank) - (1+ max))))) + (- max (length + (memq (assq (intern (buffer-substring + (match-beginning 0) (1- (match-end 0)))) + message-header-format-alist) + message-header-format-alist)))))) (message-sort-headers-1)))) (defun message-kill-address () @@ -2870,84 +2872,78 @@ Consider adding this function to `message-header-setup-hook'" ;;; Set up keymap. -(defvar message-mode-map nil) - -(unless message-mode-map - (setq message-mode-map (make-keymap)) - (set-keymap-parent message-mode-map text-mode-map) - (define-key message-mode-map "\C-c?" #'describe-mode) - - (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to) - (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from) - (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc) - (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc) - (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc) - (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to) - (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups) - (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution) - (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to) - (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to) - (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords) - (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary) - (define-key message-mode-map "\C-c\C-f\C-i" - #'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\C-f\C-a" - #'message-generate-unsubscribed-mail-followup-to) +(defvar-keymap message-mode-map + :full t :parent text-mode-map + :doc "Message Mode keymap." + "C-c ?" #'describe-mode + + "C-c C-f C-t" #'message-goto-to + "C-c C-f C-o" #'message-goto-from + "C-c C-f C-b" #'message-goto-bcc + "C-c C-f C-w" #'message-goto-fcc + "C-c C-f C-c" #'message-goto-cc + "C-c C-f C-s" #'message-goto-subject + "C-c C-f C-r" #'message-goto-reply-to + "C-c C-f C-n" #'message-goto-newsgroups + "C-c C-f C-d" #'message-goto-distribution + "C-c C-f C-f" #'message-goto-followup-to + "C-c C-f C-m" #'message-goto-mail-followup-to + "C-c C-f C-k" #'message-goto-keywords + "C-c C-f C-u" #'message-goto-summary + "C-c C-f C-i" #'message-insert-or-toggle-importance + "C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to ;; modify headers (and insert notes in body) - (define-key message-mode-map "\C-c\C-fs" #'message-change-subject) + "C-c C-f s" #'message-change-subject ;; - (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to) + "C-c C-f x" #'message-cross-post-followup-to ;; prefix+message-cross-post-followup-to = same w/o cross-post - (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc) - (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header) + "C-c C-f t" #'message-reduce-to-to-cc + "C-c C-f a" #'message-add-archive-header ;; mark inserted text - (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region) - (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file) - - (define-key message-mode-map "\C-c\C-b" #'message-goto-body) - (define-key message-mode-map "\C-c\C-i" #'message-goto-signature) - - (define-key message-mode-map "\C-c\C-t" #'message-insert-to) - (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply) - (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups) - (define-key message-mode-map "\C-c\C-l" #'message-to-list-only) - (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires) - - (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\M-n" - #'message-insert-disposition-notification-to) - - (define-key message-mode-map "\C-c\C-y" #'message-yank-original) - (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer) - (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" #'message-insert-signature) - (define-key message-mode-map "\C-c\M-h" #'message-insert-headers) - (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" #'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer) - - (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit) - (define-key message-mode-map "\C-c\C-s" #'message-send) - (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer) - (define-key message-mode-map "\C-c\C-d" #'message-dont-send) - (define-key message-mode-map "\C-c\n" #'gnus-delay-article) - - (define-key message-mode-map "\C-c\M-k" #'message-kill-address) - (define-key message-mode-map "\C-c\C-e" #'message-elide-region) - (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region) - (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature) - (define-key message-mode-map "\M-\r" #'message-newline-and-reformat) - (define-key message-mode-map [remap split-line] #'message-split-line) - - (define-key message-mode-map "\C-c\C-a" #'mml-attach-file) - (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot) - - (define-key message-mode-map "\C-a" #'message-beginning-of-line) - (define-key message-mode-map "\t" #'message-tab) - - (define-key message-mode-map "\M-n" #'message-display-abbrev)) + "C-c M-m" #'message-mark-inserted-region + "C-c M-f" #'message-mark-insert-file + + "C-c C-b" #'message-goto-body + "C-c C-i" #'message-goto-signature + + "C-c C-t" #'message-insert-to + "C-c C-f w" #'message-insert-wide-reply + "C-c C-n" #'message-insert-newsgroups + "C-c C-l" #'message-to-list-only + "C-c C-f C-e" #'message-insert-expires + "C-c C-u" #'message-insert-or-toggle-importance + "C-c M-n" #'message-insert-disposition-notification-to + + "C-c C-y" #'message-yank-original + "C-c C-M-y" #'message-yank-buffer + "C-c C-q" #'message-fill-yanked-message + "C-c C-w" #'message-insert-signature + "C-c M-h" #'message-insert-headers + "C-c C-r" #'message-caesar-buffer-body + "C-c C-o" #'message-sort-headers + "C-c M-r" #'message-rename-buffer + + "C-c C-c" #'message-send-and-exit + "C-c C-s" #'message-send + "C-c C-k" #'message-kill-buffer + "C-c C-d" #'message-dont-send + "C-c C-j" #'gnus-delay-article + + "C-c M-k" #'message-kill-address + "C-c C-e" #'message-elide-region + "C-c C-v" #'message-delete-not-region + "C-c C-z" #'message-kill-to-signature + "M-RET" #'message-newline-and-reformat + "<remap> <split-line>" #'message-split-line + + "C-c C-a" #'mml-attach-file + "C-c C-p" #'message-insert-screenshot + + "C-a" #'message-beginning-of-line + "TAB" #'message-tab + + "M-n" #'message-display-abbrev) (easy-menu-define message-mode-menu message-mode-map "Message Menu." @@ -2956,12 +2952,12 @@ Consider adding this function to `message-header-setup-hook'" ["Fill Yanked Message" message-fill-yanked-message t] ["Insert Signature" message-insert-signature t] ["Caesar (rot13) Message" message-caesar-buffer-body t] - ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)] + ["Caesar (rot13) Region" message-caesar-region mark-active] ["Elide Region" message-elide-region - :active (message-mark-active-p) + :active mark-active :help "Replace text in region with an ellipsis"] ["Delete Outside Region" message-delete-not-region - :active (message-mark-active-p) + :active mark-active :help "Delete all quoted text outside region"] ["Kill To Signature" message-kill-to-signature t] ["Newline and Reformat" message-newline-and-reformat t] @@ -2969,7 +2965,7 @@ Consider adding this function to `message-header-setup-hook'" ["Spellcheck" ispell-message :help "Spellcheck this message"] "----" ["Insert Region Marked" message-mark-inserted-region - :active (message-mark-active-p) :help "Mark region with enclosing tags"] + :active mark-active :help "Mark region with enclosing tags"] ["Insert File Marked..." message-mark-insert-file :help "Insert file at point marked with enclosing tags"] ["Attach File..." mml-attach-file t] @@ -3161,6 +3157,7 @@ Like `text-mode', but with these additional commands: (setq-local message-checksum nil) (setq-local message-mime-part 0) (message-setup-fill-variables) + (yank-media-handler "image/.*" #'message--yank-media-image-handler) (when message-fill-column (setq fill-column message-fill-column) (turn-on-auto-fill)) @@ -3182,8 +3179,7 @@ Like `text-mode', but with these additional commands: (mail-abbrevs-setup)) ((message-mail-alias-type-p 'ecomplete) (ecomplete-setup))) - ;; FIXME: merge the completion tables from ecomplete/bbdb/...? - ;;(add-hook 'completion-at-point-functions #'message-ecomplete-capf nil t) + (add-hook 'completion-at-point-functions #'eudc-capf-complete -1 t) (add-hook 'completion-at-point-functions #'message-completion-function nil t) (unless buffer-file-name (message-set-auto-save-file-name)) @@ -3668,7 +3664,7 @@ Message buffers and is not meant to be called directly." (save-excursion (save-restriction (widen) - (let ((bound (+ (point-at-eol) 1)) case-fold-search) + (let ((bound (+ (line-end-position) 1)) case-fold-search) (goto-char (point-min)) (not (search-forward (concat "\n" mail-header-separator "\n") bound t)))))) @@ -3932,18 +3928,16 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line." (if all-removed (goto-char start) (forward-line 1)))) - ;; Delete blank lines at the start of the buffer. - (while (and (point-min) - (eolp) - (not (eobp))) - (message-delete-line)) + ;; Delete blank lines at the start of the cited text. + (while (and (eolp) (not (eobp))) + (delete-line)) ;; Delete blank lines at the end of the buffer. (goto-char (point-max)) (unless (eq (preceding-char) ?\n) (insert "\n")) (while (and (zerop (forward-line -1)) (looking-at "$")) - (message-delete-line))) + (delete-line))) ;; Do the indentation. (if (null message-yank-prefix) (indent-rigidly start (or end (mark t)) message-indentation-spaces) @@ -4183,8 +4177,7 @@ See `message-citation-line-format'." (setq fname (car names) lname (string-join (cdr names) " "))) ((> count 3) - (setq fname (string-join (butlast names (- count 2)) - " ") + (setq fname (string-join (take 2 names) " ") lname (string-join (nthcdr 2 names) " ")))) (when (string-match "\\(.*\\),\\'" fname) (let ((newlname (match-string 1 fname))) @@ -4338,6 +4331,48 @@ Instead, just auto-save the buffer and then bury it." (autoload 'mml-secure-bcc-is-safe "mml-sec") +(defcustom message-server-alist nil + "Alist of rules to generate \"X-Message-SMTP-Method\" header. +The header will be inserted just before the message is sent. +Elements should be of the form (COND . METHOD). +If COND is a string, METHOD will be inserted if the \"From\" +address compares equal with COND. +If COND is a function, METHOD will be inserted if COND returns +a non-nil value when called in the message buffer without any +arguments. If METHOD is nil in this case, the return value of +the function will be inserted instead. +If the buffer already has a\"X-Message-SMTP-Method\" header, +it is left unchanged." + :type '(alist :key-type '(choice + (string :tag "From Address") + (function :tag "Predicate")) + :value-type 'string) + :version "29.1" + :group 'message-sending) + +(defun message-update-smtp-method-header () + "Insert an X-Message-SMTP-Method header according to `message-server-alist'." + (unless (message-fetch-field "X-Message-SMTP-Method") + (let ((from (cadr (mail-extract-address-components + (save-restriction + (widen) + (message-narrow-to-headers-or-head) + (message-fetch-field "From"))))) + method) + (catch 'exit + (dolist (server message-server-alist) + (cond ((functionp (car server)) + (let ((res (funcall (car server)))) + (when res + (setq method (or (cdr server) res)) + (throw 'exit nil)))) + ((and (stringp (car server)) + (string= (car server) from)) + (setq method (cdr server)) + (throw 'exit nil))))) + (when method + (message-add-header (concat "X-Message-SMTP-Method: " method)))))) + (defun message-send (&optional arg) "Send the message in the current buffer. If `message-interactive' is non-nil, wait for success indication or @@ -4351,6 +4386,7 @@ It should typically alter the sending method in some way or other." (undo-boundary) (let ((inhibit-read-only t)) (put-text-property (point-min) (point-max) 'read-only nil)) + (message-update-smtp-method-header) (message-fix-before-sending) (run-hooks 'message-send-hook) (mml-secure-bcc-is-safe) @@ -4766,23 +4802,25 @@ Valid types are `send', `return', `exit', `kill' and `postpone'." t "\ The message size, " - (/ (buffer-size) 1000) "KB, is too large. + (/ (buffer-size) 1000) + (substitute-command-keys "KB, is too large. Some mail gateways (MTA's) bounce large messages. To avoid the -problem, answer `y', and the message will be split into several -smaller pieces, the size of each is about " +problem, answer \\`y', and the message will be split into several +smaller pieces, the size of each is about ") (/ message-send-mail-partially-limit 1000) - "KB except the last + (substitute-command-keys + "KB except the last one. However, some mail readers (MUA's) can't read split messages, i.e., -mails in message/partially format. Answer `n', and the message +mails in message/partially format. Answer \\`n', and the message will be sent in one piece. The size limit is controlled by `message-send-mail-partially-limit'. If you always want Gnus to send messages in one piece, set `message-send-mail-partially-limit' to nil. -"))) +")))) (progn (message "Sending via mail...") (if message-send-mail-real-function @@ -4863,7 +4901,18 @@ If you always want Gnus to send messages in one piece, set (message-generate-headers '(Lines))) ;; Remove some headers. (message-remove-header message-ignored-mail-headers t) - (mail-encode-encoded-word-buffer)) + (mail-encode-encoded-word-buffer) + ;; Then check for suspicious addresses. + (dolist (hdr '("To" "Cc" "Bcc")) + (let ((addr (message-fetch-field hdr))) + (when (stringp addr) + (dolist (address (mail-header-parse-addresses addr t)) + (when-let ((warning (textsec-suspicious-p + address 'email-address-header))) + (unless (y-or-n-p + (format "Suspicious address: %s; send anyway?" + warning)) + (user-error "Suspicious address %s" address)))))))) (goto-char (point-max)) ;; require one newline at the end. (or (= (preceding-char) ?\n) @@ -5092,9 +5141,9 @@ to find out how to use this." (let ((headers message-mh-deletable-headers)) (while headers (goto-char (point-min)) - (and (re-search-forward - (concat "^" (symbol-name (car headers)) ": *") nil t) - (message-delete-line)) + (when (re-search-forward + (concat "^" (symbol-name (car headers)) ": *") nil t) + (delete-line)) (pop headers)))) (run-hooks 'message-send-mail-hook) ;; Pass it on to mh. @@ -5358,7 +5407,7 @@ Otherwise, generate and save a value for `canlock-password' first." (zerop (length (setq to (completing-read - "Followups to (default no Followup-To header): " + (format-prompt "Followups to" "no Followup-To header") (mapcar #'list (cons "poster" (message-tokenize-header @@ -5621,11 +5670,11 @@ Otherwise, generate and save a value for `canlock-password' first." (goto-char (point-max)) (if (not (re-search-backward message-signature-separator nil t)) t - (setq sig-start (1+ (point-at-eol))) + (setq sig-start (1+ (line-end-position))) (setq sig-end (if (re-search-forward "<#/?\\(multipart\\|part\\|external\\|mml\\)" nil t) - (- (point-at-bol) 1) + (- (line-beginning-position) 1) (point-max))) (if (>= (count-lines sig-start sig-end) 5) (if (message-gnksa-enable-p 'signature) @@ -5829,15 +5878,15 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." ;; You might for example insert a "." somewhere (not next to another dot ;; or string boundary), or modify the "fsf" string. (defun message-unique-id () - ;; Don't use microseconds from (current-time), they may be unsupported. + ;; Don't use fractional seconds from timestamp; they may be unsupported. ;; Instead we use this randomly inited counter. (setq message-unique-id-char - (% (1+ (or message-unique-id-char - (random (ash 1 20)))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (current-time))) + ;; 2^16 * 25 just fits into 4 digits i base 36. + (let ((base (* 25 25))) + (if message-unique-id-char + (% (1+ message-unique-id-char) base) + (random base)))) + (let ((tm (time-convert nil 'integer))) (concat (if (or (eq system-type 'ms-dos) ;; message-number-base36 doesn't handle bigints. @@ -5847,10 +5896,12 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (aset user (match-beginning 0) ?_)) user) (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) - (ash (% message-unique-id-char 25) 16)) 4) - (message-number-base36 (+ (nth 1 tm) - (ash (/ message-unique-id-char 25) 16)) 4) + (message-number-base36 (+ (ash tm -16) + (ash (% message-unique-id-char 25) 16)) + 4) + (message-number-base36 (+ (logand tm #xffff) + (ash (/ message-unique-id-char 25) 16)) + 4) ;; Append a given name, because while the generated ID is unique ;; to this newsreader, other newsreaders might otherwise generate ;; the same ID via another algorithm. @@ -5947,12 +5998,9 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (defun message-make-expires () "Return an Expires header based on `message-expires'." - (let ((current (current-time)) - (future (* 1.0 message-expires 60 60 24))) + (let ((future (* 60 60 24 message-expires))) ;; Add the future to current. - (setcar current (+ (car current) (round (/ future (expt 2 16))))) - (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) - (message-make-date current))) + (message-make-date (time-add nil future)))) (defun message-make-path () "Return uucp path." @@ -6227,7 +6275,7 @@ Headers already prepared in the buffer are not modified." (and (re-search-forward (concat "^" (symbol-name (car headers)) ": *") nil t) (get-text-property (1+ (match-beginning 0)) 'message-deletable) - (message-delete-line)) + (delete-line)) (pop headers))) ;; Go through all the required headers and see if they are in the ;; articles already. If they are not, or are empty, they are @@ -6312,7 +6360,7 @@ Headers already prepared in the buffer are not modified." (forward-line -1))) ;; The value of this header was empty, so we clear ;; totally and insert the new value. - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) ;; If the header is optional, and the header was ;; empty, we can't insert it anyway. (unless optionalp @@ -6446,7 +6494,7 @@ If the current line has `message-yank-prefix', insert it on the new line." ;; Tapdance around looong Message-IDs. (forward-line -1) (when (looking-at "[ \t]*$") - (message-delete-line)) + (delete-line)) (goto-char begin) (search-forward ":" nil t) (when (looking-at "\n[ \t]+") @@ -6567,10 +6615,10 @@ beginning of a folded header)." (or (eq (char-after) ?\s) (eq (char-after) ?\t))) (beginning-of-line 0))) (when (or (eq (char-after) ?\s) (eq (char-after) ?\t) - (search-forward ":" (point-at-eol) t)) + (search-forward ":" (line-end-position) t)) ;; We are a bit more lacks than the RFC and allow any positive number of WSP ;; characters. - (skip-chars-forward " \t" (point-at-eol)) + (skip-chars-forward " \t" (line-end-position)) (point))) (defun message-beginning-of-line (&optional n) @@ -6829,13 +6877,14 @@ are not included." (or (bolp) (insert ?\n))) (insert (concat mail-header-separator "\n")) (forward-line -1) - ;; If a crash happens while replying, the auto-save file would *not* have a - ;; `References:' header if `message-generate-headers-first' was nil. - ;; Therefore, always generate it first. + ;; If a crash happens while replying, the auto-save file would *not* + ;; have a `References:' header if `message-generate-headers-first' + ;; was nil. Therefore, always generate it first. (And why not + ;; include the `In-Reply-To' header as well.) (let ((message-generate-headers-first (if (eq message-generate-headers-first t) t - (append message-generate-headers-first '(References))))) + (append message-generate-headers-first '(References In-Reply-To))))) (when (message-news-p) (when message-default-news-headers (insert message-default-news-headers) @@ -6965,7 +7014,15 @@ is a function used to switch to and display the mail buffer." ;; https://lists.gnu.org/r/emacs-devel/2011-01/msg00337.html ;; We need to convert any string input, eg from rmail-start-mail. (dolist (h other-headers other-headers) - (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) + (when (stringp (car h)) + (setcar h (intern (capitalize (car h))))) + ;; Firefox sends us In-Reply-To headers that are Message-IDs + ;; without <> around them. Fix that. + (when (and (eq (car h) 'In-Reply-To) + ;; Looks like a Message-ID. + (string-match-p "\\`[^ @]+@[^ @]+\\'" (cdr h)) + (not (string-match-p "\\`<.*>\\'" (cdr h)))) + (setcdr h (concat "<" (cdr h) ">"))))) yank-action send-actions continue switch-function return-action)))) @@ -7964,7 +8021,18 @@ is for the internal use." (select-safe-coding-system-function nil) message-required-mail-headers message-generate-hashcash - rfc2047-encode-encoded-words) + rfc2047-encode-encoded-words + ;; If `message-sendmail-envelope-from' is `header' then + ;; the envelope-from will be the original sender's + ;; address, not the resender's. But when resending, the + ;; envelope-from should be the resender's address. Defuse + ;; that particular case. + (message-sendmail-envelope-from + (and (not (and (eq message-sendmail-envelope-from + 'obey-mail-envelope-from) + (eq mail-envelope-from 'header))) + (not (eq message-sendmail-envelope-from 'header)) + message-sendmail-envelope-from))) (message-send-mail)) (when gcc (message-goto-eoh) @@ -8103,39 +8171,7 @@ which specify the range to operate on." ;; Support for toolbar (defvar tool-bar-mode) -;; Note: The :set function in the `message-tool-bar*' variables will only -;; affect _new_ message buffers. We might add a function that walks thru all -;; message-mode buffers and force the update. -(defun message-tool-bar-update (&optional symbol value) - "Update message mode toolbar. -Setter function for custom variables." - (setq-default message-tool-bar-map nil) - (when symbol - ;; When used as ":set" function: - (set-default symbol value))) - -(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome) - 'message-tool-bar-gnome - 'message-tool-bar-retro) - "Specifies the message mode tool bar. - -It can be either a list or a symbol referring to a list. See -`gmm-tool-bar-from-list' for the format of the list. The -default key map is `message-mode-map'. - -Pre-defined symbols include `message-tool-bar-gnome' and -`message-tool-bar-retro'." - :type '(repeat gmm-tool-bar-list-item) - :type '(choice (const :tag "GNOME style" message-tool-bar-gnome) - (const :tag "Retro look" message-tool-bar-retro) - (repeat :tag "User defined list" gmm-tool-bar-item) - (symbol)) - :version "23.1" ;; No Gnus - :initialize #'custom-initialize-default - :set #'message-tool-bar-update - :group 'message) - -(defcustom message-tool-bar-gnome +(defcustom message-tool-bar '((ispell-message "spell" nil :vert-only t :visible (not flyspell-mode)) @@ -8151,47 +8187,23 @@ Pre-defined symbols include `message-tool-bar-gnome' and (message-insert-importance-high "important" nil :visible nil) (message-insert-importance-low "unimportant" nil :visible nil) (message-insert-disposition-notification-to "receipt" nil :visible nil)) - "List of items for the message tool bar (GNOME style). - -See `gmm-tool-bar-from-list' for details on the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize #'custom-initialize-default - :set #'message-tool-bar-update - :group 'message) + "Specifies the message mode tool bar. -(defcustom message-tool-bar-retro - '(;; Old Emacs 21 icon for consistency. - (message-send-and-exit "mail/send") - (message-kill-buffer "close") - (message-dont-send "cancel") - (mml-attach-file "attach" mml-mode-map) - (ispell-message "spell") - (mml-preview "preview" mml-mode-map) - (message-insert-importance-high "gnus/important") - (message-insert-importance-low "gnus/unimportant") - (message-insert-disposition-notification-to "gnus/receipt")) - "List of items for the message tool bar (retro style). - -See `gmm-tool-bar-from-list' for details on the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize #'custom-initialize-default - :set #'message-tool-bar-update +It can be either a list or a symbol referring to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `message-mode-map'." + :type '(repeat gmm-tool-bar-list-item) + :type '(choice (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "29.1" :group 'message) -(defcustom message-tool-bar-zap-list - '(new-file open-file dired kill-buffer write-file - print-buffer customize help) - "List of icon items from the global tool bar. -These items are not displayed on the message mode tool bar. - -See `gmm-tool-bar-from-list' for the format of the list." - :type 'gmm-tool-bar-zap-list - :version "23.1" ;; No Gnus - :initialize #'custom-initialize-default - :set #'message-tool-bar-update - :group 'message) +(defvar message-tool-bar-gnome nil) +(make-obsolete-variable 'message-tool-bar-gnome nil "29.1") +(defvar message-tool-bar-retro nil) +(make-obsolete-variable 'message-tool-bar-gnome nil "29.1") +(defvar message-tool-bar-zap-list t) +(make-obsolete-variable 'message-tool-bar-zap-list nil "29.1") (defvar image-load-path) (declare-function image-load-path-for-library "image" @@ -8213,17 +8225,23 @@ When FORCE, rebuild the tool bar." 'message-mode-map)))) message-tool-bar-map) -;;; Group name completion. +;;; Group name and email address completion. (defcustom message-newgroups-header-regexp "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" - "Regexp that match headers that lists groups." + "Regexp matching headers that list groups." :group 'message :type 'regexp) +(defcustom message-email-recipient-header-regexp + "^\\([^ :]*-\\)?\\(To\\|B?Cc\\|From\\|Reply-to\\|Mail-Followup-To\\|Mail-Copies-To\\):" + "Regexp matching headers that list email addresses." + :version "29.1" + :type 'regexp) + (defcustom message-completion-alist `((,message-newgroups-header-regexp . ,#'message-expand-group) - ("^\\([^ :]*-\\)?\\(To\\|B?Cc\\|From\\):" . ,#'message-expand-name)) + (,message-email-recipient-header-regexp . ,#'message-expand-name)) "Alist of (RE . FUN). Use FUN for completion on header lines matching RE. FUN should be a function that obeys the same rules as those of `completion-at-point-functions'." @@ -8317,7 +8335,11 @@ regular text mode tabbing command." (defcustom message-expand-name-standard-ui nil "If non-nil, use the standard completion UI in `message-expand-name'. -E.g. this means it will obey `completion-styles' and other such settings." +E.g. this means it will obey `completion-styles' and other such settings. + +If this variable is non-nil and `message-mail-alias-type' is +`ecomplete', `message-self-insert-commands' should probably be +set to nil." :version "27.1" :type 'boolean) @@ -8346,7 +8368,8 @@ E.g. this means it will obey `completion-styles' and other such settings." (t (expand-abbrev)))) -(add-to-list 'completion-category-defaults '(email (styles substring))) +(add-to-list 'completion-category-defaults '(email (styles substring + partial-completion))) (defun message--bbdb-query-with-words (words) ;; FIXME: This (or something like this) should live on the BBDB side. @@ -8569,26 +8592,23 @@ From headers in the original article." message-hidden-headers)) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) - (end-of-headers (point-min))) + end-of-headers) (when regexps (save-excursion (save-restriction (message-narrow-to-headers) + (setq end-of-headers (point-min-marker)) (goto-char (point-min)) (while (not (eobp)) (if (not (message-hide-header-p regexps)) (message-next-header) - (let ((begin (point)) - header header-len) + (let ((begin (point))) (message-next-header) - (setq header (buffer-substring begin (point)) - header-len (- (point) begin)) - (delete-region begin (point)) - (goto-char end-of-headers) - (insert header) - (setq end-of-headers - (+ end-of-headers header-len)))))))) - (narrow-to-region end-of-headers (point-max)))) + (let ((header (delete-and-extract-region begin (point)))) + (save-excursion + (goto-char end-of-headers) + (insert-before-markers header)))))))) + (narrow-to-region end-of-headers (point-max))))) (defun message-hide-header-p (regexps) (let ((result nil) @@ -8621,7 +8641,7 @@ From headers in the original article." (autoload 'ecomplete-display-matches "ecomplete") (defun message--in-tocc-p () - (and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? )) + (and (memq (char-after (line-beginning-position)) '(?C ?T ?\t ? )) (message-point-in-header-p) (save-excursion (beginning-of-line) @@ -8879,24 +8899,29 @@ used to take the screenshot." (car message-screenshot-command) nil (current-buffer) nil (cdr message-screenshot-command)) (buffer-string)))) - (set-mark (point)) - (insert-image - (create-image image 'png t - :max-width (truncate (* (frame-pixel-width) 0.8)) - :max-height (truncate (* (frame-pixel-height) 0.8)) - :scale 1) - (format "<#part type=\"image/png\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>" - ;; Get a base64 version of the image -- this avoids later - ;; complications if we're auto-saving the buffer and - ;; restoring from a file. - (with-temp-buffer - (set-buffer-multibyte nil) - (insert image) - (base64-encode-region (point-min) (point-max) t) - (buffer-string)))) - (insert "\n\n") + (message--yank-media-image-handler 'image/png image) (message ""))) +(defun message--yank-media-image-handler (type image) + (set-mark (point)) + (insert-image + (create-image image (mailcap-mime-type-to-extension type) t + :max-width (truncate (* (frame-pixel-width) 0.8)) + :max-height (truncate (* (frame-pixel-height) 0.8)) + :scale 1) + (format "<#part type=\"%s\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>" + type + ;; Get a base64 version of the image -- this avoids later + ;; complications if we're auto-saving the buffer and + ;; restoring from a file. + (with-temp-buffer + (set-buffer-multibyte nil) + (insert image) + (base64-encode-region (point-min) (point-max) t) + (buffer-string))) + nil nil t) + (insert "\n\n")) + (declare-function gnus-url-unhex-string "gnus-util") (defun message-parse-mailto-url (url) @@ -8932,7 +8957,7 @@ used to take the screenshot." 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. For emacsclient use - emacsclient -e '(message-mailto \"%u\")'" + 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) diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 956449dac14..9045966df5a 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -191,19 +191,21 @@ If TYPE is `text/plain' CRLF->LF translation may occur." ((eq encoding 'base64) (base64-decode-region (point-min) - ;; Some mailers insert whitespace - ;; junk at the end which - ;; base64-decode-region dislikes. - ;; Also remove possible junk which could - ;; have been added by mailing list software. (save-excursion + ;; Some mailers insert whitespace junk at the end which + ;; base64-decode-region dislikes. (goto-char (point-min)) (while (re-search-forward "^[\t ]*\r?\n" nil t) (delete-region (match-beginning 0) (match-end 0))) + ;; Also ignore junk which could have been added by + ;; mailing list software by finding the final line with + ;; base64 text. (goto-char (point-max)) - (when (re-search-backward "^[\t ]*[A-Za-z0-9+/]+=*[\t ]*$" - nil t) - (forward-line)) + (beginning-of-line) + (while (and (not (mm-base64-line-p)) + (not (bobp))) + (forward-line -1)) + (forward-line 1) (point)))) ((memq encoding '(nil 7bit 8bit binary)) ;; Do nothing. @@ -236,6 +238,20 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (while (search-forward "\r\n" nil t) (replace-match "\n" t t))))) +(defun mm-base64-line-p () + "Say whether the current line is base64." + ;; This is coded in this way to avoid using regexps that may + ;; overflow -- a base64 line may be megabytes long. + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (and (looking-at "[A-Za-z0-9+/]\\{3\\}") + (progn + (skip-chars-forward "A-Za-z0-9+/") + (skip-chars-forward "=") + (skip-chars-forward " \t") + (eolp))))) + (defun mm-decode-body (charset &optional encoding type) "Decode the current article that has been encoded with ENCODING to CHARSET. ENCODING is a MIME content transfer encoding. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index e04423ce377..5268f192c61 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -117,8 +117,8 @@ (cond ((fboundp 'libxml-parse-html-region) 'shr) ((executable-find "w3m") 'gnus-w3m) ((executable-find "links") 'links) - ((executable-find "lynx") 'lynx) - ((locate-library "html2text") 'html2text)) + ((executable-find "lynx") 'lynx) + (t 'shr)) "Render of HTML contents. It is one of defined renderer types, or a rendering function. The defined renderer types are: @@ -127,16 +127,14 @@ The defined renderer types are: `w3m': use emacs-w3m; `w3m-standalone': use plain w3m; `links': use links; -`lynx': use lynx; -`html2text': use html2text." - :version "27.1" +`lynx': use lynx." + :version "29.1" :type '(choice (const shr) (const gnus-w3m) (const w3m :tag "emacs-w3m") (const w3m-standalone :tag "standalone w3m" ) (const links) (const lynx) - (const html2text) (function)) :group 'mime-display) @@ -193,7 +191,11 @@ before the external MIME handler is invoked." `(("image/p?jpeg" mm-inline-image ,(lambda (handle) - (mm-valid-and-fit-image-p 'jpeg handle))) + (mm-valid-and-fit-image-p 'jpeg handle))) + ("image/webp" + mm-inline-image + ,(lambda (handle) + (mm-valid-and-fit-image-p 'webp handle))) ("image/png" mm-inline-image ,(lambda (handle) @@ -446,10 +448,11 @@ If not set, `default-directory' will be used." :type 'integer :group 'mime-display) -(defcustom mm-external-terminal-program "xterm" - "The program to start an external terminal." - :version "22.1" - :type 'string +(defcustom mm-external-terminal-program '("xterm" "-e") + "The program to start an external terminal. +This should be a list of strings." + :version "29.1" + :type '(choice string (repeat string)) :group 'mime-display) ;;; Internal variables. @@ -473,6 +476,7 @@ The file will be saved in the directory `mm-tmp-directory'.") (autoload 'mml2015-verify-test "mml2015") (autoload 'mml-smime-verify "mml-smime") (autoload 'mml-smime-verify-test "mml-smime") +(autoload 'mm-view-pkcs7-verify "mm-view") (defvar mm-verify-function-alist '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test) @@ -481,7 +485,15 @@ The file will be saved in the directory `mm-tmp-directory'.") ("application/pkcs7-signature" mml-smime-verify "S/MIME" mml-smime-verify-test) ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" - mml-smime-verify-test))) + mml-smime-verify-test) + ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" + mml-smime-verify-test) + ;; these are only used for security-buttons and contain the + ;; smime-type after the underscore + ("application/pkcs7-mime_signed-data" mm-view-pkcs7-verify "S/MIME" + nil) + ("application/x-pkcs7-mime_signed-data" mml-view-pkcs7-verify "S/MIME" + nil))) (defcustom mm-verify-option 'never "Option of verifying signed parts. @@ -500,11 +512,17 @@ result of the verification." (autoload 'mml2015-decrypt "mml2015") (autoload 'mml2015-decrypt-test "mml2015") +(autoload 'mm-view-pkcs7-decrypt "mm-view") (defvar mm-decrypt-function-alist '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test) ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP" - mm-uu-pgp-encrypted-test))) + mm-uu-pgp-encrypted-test) + ;; these are only used for security-buttons and contain the + ;; smime-type after the underscore + ("application/pkcs7-mime_enveloped-data" mm-view-pkcs7-decrypt "S/MIME" nil) + ("application/x-pkcs7-mime_enveloped-data" + mm-view-pkcs7-decrypt "S/MIME" nil))) (defcustom mm-decrypt-option nil "Option of decrypting encrypted parts. @@ -681,18 +699,35 @@ MIME-Version header before proceeding." 'start start) (car ctl)) (cons (car ctl) (mm-dissect-multipart ctl from)))) - (t - (mm-possibly-verify-or-decrypt - (mm-dissect-singlepart - ctl - (and cte (intern (downcase (mail-header-strip-cte cte)))) - no-strict-mime - (and cd (mail-header-parse-content-disposition cd)) - description id) - ctl from)))) - (when id - (when (string-match " *<\\(.*\\)> *" id) - (setq id (match-string 1 id))) + (t + (let* ((handle + (mm-dissect-singlepart + ctl + (and cte (intern (downcase (mail-header-strip-cte cte)))) + no-strict-mime + (and cd (mail-header-parse-content-disposition cd)) + description id)) + (intermediate-result + (mm-possibly-verify-or-decrypt handle ctl from))) + (when (and (equal type "application") + (or (equal subtype "pkcs7-mime") + (equal subtype "x-pkcs7-mime"))) + (add-text-properties + 0 (length (car ctl)) + (list 'protocol + (concat (substring-no-properties (car ctl)) + "_" + (cdr (assoc 'smime-type ctl)))) + (car ctl)) + ;; If this is a pkcs7-mime lets treat this special and + ;; more like multipart so the pkcs7-mime part does not + ;; get ignored. + (setq intermediate-result + (cons (car ctl) (list intermediate-result)))) + intermediate-result)))) + (when id + (when (string-match " *<\\(.*\\)> *" id) + (setq id (match-string 1 id))) (push (cons id result) mm-content-id-alist)) result)))) @@ -957,10 +992,16 @@ external if displayed external." (unwind-protect (if window-system (set-process-sentinel - (start-process "*display*" nil - mm-external-terminal-program - "-e" shell-file-name - shell-command-switch command) + (apply #'start-process "*display*" nil + (append + (if (listp mm-external-terminal-program) + mm-external-terminal-program + ;; Be backwards-compatible. + (list mm-external-terminal-program + "-e")) + (list shell-file-name + shell-command-switch + command))) (lambda (process _state) (if (eq 'exit (process-status process)) (run-at-time @@ -1670,43 +1711,40 @@ If RECURSIVE, search recursively." (cond ((or (equal type "application/x-pkcs7-mime") (equal type "application/pkcs7-mime")) - (with-temp-buffer - (when (and (cond - ((equal smime-type "signed-data") t) - ((eq mm-decrypt-option 'never) nil) - ((eq mm-decrypt-option 'always) t) - ((eq mm-decrypt-option 'known) t) - (t (y-or-n-p "Decrypt (S/MIME) part? "))) - (mm-view-pkcs7 parts from)) - (goto-char (point-min)) - ;; The encrypted document is a MIME part, and may use either - ;; CRLF (Outlook and the like) or newlines for end-of-line - ;; markers. Translate from CRLF. - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - ;; Normally there will be a Content-type header here, but - ;; some mailers don't add that to the encrypted part, which - ;; makes the subsequent re-dissection fail here. - (save-restriction - (mail-narrow-to-head) - (unless (mail-fetch-field "content-type") - (goto-char (point-max)) - (insert "Content-type: text/plain\n\n"))) - (setq parts - (if (equal smime-type "signed-data") - (list (propertize - "multipart/signed" - 'protocol "application/pkcs7-signature" - 'gnus-info - (format - "%s:%s" - (get-text-property 0 'gnus-info - (car mm-security-handle)) - (get-text-property 0 'gnus-details - (car mm-security-handle)))) - (mm-dissect-buffer t) - parts) - (mm-dissect-buffer t)))))) + (add-text-properties 0 (length (car ctl)) + (list 'buffer (car parts)) + (car ctl)) + (let* ((envelope-p (string= smime-type "enveloped-data")) + (decrypt-or-verify-option (if envelope-p + mm-decrypt-option + mm-verify-option)) + (question (if envelope-p + "Decrypt (S/MIME) part? " + "Verify signed (S/MIME) part? "))) + (with-temp-buffer + (when (and (cond + ((equal smime-type "signed-data") t) + ((eq decrypt-or-verify-option 'never) nil) + ((eq decrypt-or-verify-option 'always) t) + ((eq decrypt-or-verify-option 'known) t) + (t (y-or-n-p (format question)))) + (mm-view-pkcs7 parts from)) + + (goto-char (point-min)) + ;; The encrypted document is a MIME part, and may use either + ;; CRLF (Outlook and the like) or newlines for end-of-line + ;; markers. Translate from CRLF. + (while (search-forward "\r\n" nil t) + (replace-match "\n")) + ;; Normally there will be a Content-type header here, but + ;; some mailers don't add that to the encrypted part, which + ;; makes the subsequent re-dissection fail here. + (save-restriction + (mail-narrow-to-head) + (unless (mail-fetch-field "content-type") + (goto-char (point-max)) + (insert "Content-type: text/plain\n\n"))) + (setq parts (mm-dissect-buffer t)))))) ((equal subtype "signed") (unless (and (setq protocol (mm-handle-multipart-ctl-parameter ctl 'protocol)) @@ -1833,7 +1871,7 @@ If RECURSIVE, search recursively." ;; Require since we bind its variables. (require 'shr) (let ((shr-width (if shr-use-fonts - nil + shr-width fill-column)) (shr-content-function (lambda (id) (let ((handle (mm-get-content-id id))) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 0910748ab50..e4d686ac837 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -34,8 +34,6 @@ (require 'gnus) (defvar url-current-object) -(defvar url-package-name) -(defvar url-package-version) (defgroup mm-url nil "A wrapper of url package and external url command for Gnus." diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 3c529dbea0f..48cca45cb9b 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -31,7 +31,7 @@ (defun mm-ucs-to-char (codepoint) "Convert Unicode codepoint to character." - (or (decode-char 'ucs codepoint) ?#)) + (or codepoint ?#)) (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () @@ -101,9 +101,9 @@ version, you could use `autoload-coding-system' here." :type '(list (repeat :inline t :tag "Other options" (cons (symbol :tag "charset") - (symbol :tag "form")))) + (symbol :tag "form")))) + :risky t :group 'mime) -(put 'mm-charset-eval-alist 'risky-local-variable t) (defvar mm-charset-override-alist) @@ -315,8 +315,7 @@ Valid elements include: "ISO-8859-15 exchangeable coding systems and inconvertible characters.") (defvar mm-iso-8859-x-to-15-table - (and (fboundp 'coding-system-p) - (mm-coding-system-p 'iso-8859-15) + (and (mm-coding-system-p 'iso-8859-15) (mapcar (lambda (cs) (if (mm-coding-system-p (car cs)) @@ -674,7 +673,6 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." inhibit-file-name-handlers))) (write-region start end filename append visit lockname))) -(defalias 'mm-make-temp-file 'make-temp-file) (define-obsolete-function-alias 'mm-make-temp-file 'make-temp-file "26.1") (defvar mm-image-load-path-cache nil) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 44c744b068b..5cfde5a8647 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -86,7 +86,7 @@ This is only used if `mm-inline-large-images' is set to (defun mm-inline-image (handle) (let ((b (point-marker)) (inhibit-read-only t)) - (put-image + (insert-image (let ((image (mm-get-image handle))) (if (eq mm-inline-large-images 'resize) (gnus-rescale-image @@ -98,7 +98,7 @@ This is only used if `mm-inline-large-images' is set to (truncate (* mm-inline-large-images-proportion (- (nth 3 edges) (nth 1 edges))))))) image)) - b) + " ") (insert "\n") (mm-handle-set-undisplayer handle @@ -504,8 +504,6 @@ If MODE is not set, try to find mode automatically." (setq coding-system (mm-find-buffer-file-coding-system))) (setq text (buffer-string)))) (with-temp-buffer - (buffer-disable-undo) - (mm-enable-multibyte) (insert (cond ((eq charset 'gnus-decoded) (with-current-buffer (mm-handle-buffer handle) (buffer-string))) @@ -521,17 +519,17 @@ If MODE is not set, try to find mode automatically." ;; setting now, but it seems harmless and potentially still useful. (setq-local font-lock-mode-hook nil) (setq buffer-file-name (mm-handle-filename handle)) - (with-demoted-errors - (if mode - (save-window-excursion - ;; According to Katsumi Yamaoka <yamaoka@jpl.org>, org-mode - ;; requires the buffer to be temporarily displayed here, but - ;; I could not reproduce this problem. Furthermore, if - ;; there's such a problem, we should fix org-mode rather than - ;; use switch-to-buffer which can have undesirable - ;; side-effects! - ;;(switch-to-buffer (current-buffer)) - (funcall mode)) + (with-demoted-errors "Error setting mode: %S" + (if mode + (save-window-excursion + ;; According to Katsumi Yamaoka <yamaoka@jpl.org>, org-mode + ;; requires the buffer to be temporarily displayed here, but + ;; I could not reproduce this problem. Furthermore, if + ;; there's such a problem, we should fix org-mode rather than + ;; use switch-to-buffer which can have undesirable + ;; side-effects! + ;;(switch-to-buffer (current-buffer)) + (funcall mode)) (let ((auto-mode-alist (delq (rassq 'doc-view-mode-maybe auto-mode-alist) (copy-sequence auto-mode-alist)))) @@ -634,12 +632,9 @@ If MODE is not set, try to find mode automatically." (context (epg-make-context 'CMS))) (prog1 (epg-verify-string context part) - (let ((result (car (epg-context-result-for context 'verify)))) + (let ((result (epg-context-result-for context 'verify))) (mm-sec-status - 'gnus-info (epg-signature-status result) - 'gnus-details - (format "%s:%s" (epg-signature-validity result) - (epg-signature-key-id result)))))))) + 'gnus-info (epg-verify-result-to-string result))))))) (with-temp-buffer (insert "MIME-Version: 1.0\n") (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m") @@ -659,7 +654,11 @@ If MODE is not set, try to find mode automatically." ;; Use EPG/gpgsm (let ((part (base64-decode-string (buffer-string)))) (erase-buffer) - (insert (epg-decrypt-string (epg-make-context 'CMS) part))) + (insert + (let ((context (epg-make-context 'CMS))) + (prog1 + (epg-decrypt-string context part) + (mm-sec-status 'gnus-info "OK"))))) ;; Use openssl (insert "MIME-Version: 1.0\n") (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m") diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index acf9ef0ebd1..e8291cfe6f7 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -35,7 +35,6 @@ (declare-function gnus-setup-posting-charset "gnus-msg" (group)) (autoload 'gnus-completing-read "gnus-util") (autoload 'message-fetch-field "message") -(autoload 'message-mark-active-p "message") (autoload 'message-info "message") (autoload 'fill-flowed-encode "flow-fill") (autoload 'message-posting-charset "message") @@ -500,7 +499,8 @@ type detected." (when (and (consp (car cont)) (= (length cont) 1) content-type) - (setcdr (assq 'type (cdr (car cont))) content-type)) + (when-let ((spec (assq 'type (cdr (car cont))))) + (setcdr spec content-type))) (when (fboundp 'libxml-parse-html-region) (setq cont (mapcar #'mml-expand-all-html-into-multipart-related cont))) (prog1 @@ -979,13 +979,10 @@ type detected." (symbol-name type) value)))))) (defvar ange-ftp-name-format) -(defvar efs-path-regexp) (defun mml-parse-file-name (path) - (if (if (boundp 'efs-path-regexp) - (string-match efs-path-regexp path) - (if (boundp 'ange-ftp-name-format) - (string-match (car ange-ftp-name-format) path))) + (if (and (boundp 'ange-ftp-name-format) + (string-match (car ange-ftp-name-format) path)) (list (match-string 1 path) (match-string 2 path) (substring path (1+ (match-end 2)))) path)) @@ -1143,48 +1140,40 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ;;; Mode for inserting and editing MML forms ;;; -(defvar mml-mode-map - (let ((sign (make-sparse-keymap)) - (encrypt (make-sparse-keymap)) - (signpart (make-sparse-keymap)) - (encryptpart (make-sparse-keymap)) - (map (make-sparse-keymap)) - (main (make-sparse-keymap))) - (define-key map "\C-s" 'mml-secure-message-sign) - (define-key map "\C-c" 'mml-secure-message-encrypt) - (define-key map "\C-e" 'mml-secure-message-sign-encrypt) - (define-key map "\C-p\C-s" 'mml-secure-sign) - (define-key map "\C-p\C-c" 'mml-secure-encrypt) - (define-key sign "p" 'mml-secure-message-sign-pgpmime) - (define-key sign "o" 'mml-secure-message-sign-pgp) - (define-key sign "s" 'mml-secure-message-sign-smime) - (define-key signpart "p" 'mml-secure-sign-pgpmime) - (define-key signpart "o" 'mml-secure-sign-pgp) - (define-key signpart "s" 'mml-secure-sign-smime) - (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime) - (define-key encrypt "o" 'mml-secure-message-encrypt-pgp) - (define-key encrypt "s" 'mml-secure-message-encrypt-smime) - (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime) - (define-key encryptpart "o" 'mml-secure-encrypt-pgp) - (define-key encryptpart "s" 'mml-secure-encrypt-smime) - (define-key map "\C-n" 'mml-unsecure-message) - (define-key map "f" 'mml-attach-file) - (define-key map "b" 'mml-attach-buffer) - (define-key map "e" 'mml-attach-external) - (define-key map "q" 'mml-quote-region) - (define-key map "m" 'mml-insert-multipart) - (define-key map "p" 'mml-insert-part) - (define-key map "v" 'mml-validate) - (define-key map "P" 'mml-preview) - (define-key map "s" sign) - (define-key map "S" signpart) - (define-key map "c" encrypt) - (define-key map "C" encryptpart) - ;;(define-key map "n" 'mml-narrow-to-part) - ;; `M-m' conflicts with `back-to-indentation'. - ;; (define-key main "\M-m" map) - (define-key main "\C-c\C-m" map) - main)) +(defvar-keymap mml-mode-map + "C-c C-m" + (define-keymap + "C-s" #'mml-secure-message-sign + "C-c" #'mml-secure-message-encrypt + "C-e" #'mml-secure-message-sign-encrypt + "C-p C-s" #'mml-secure-sign + "C-p C-c" #'mml-secure-encrypt + + "s" (define-keymap + "p" #'mml-secure-message-sign-pgpmime + "o" #'mml-secure-message-sign-pgp + "s" #'mml-secure-message-sign-smime) + "S" (define-keymap + "p" #'mml-secure-sign-pgpmime + "o" #'mml-secure-sign-pgp + "s" #'mml-secure-sign-smime) + "c" (define-keymap + "p" #'mml-secure-message-encrypt-pgpmime + "o" #'mml-secure-message-encrypt-pgp + "s" #'mml-secure-message-encrypt-smime) + "C" (define-keymap + "p" #'mml-secure-encrypt-pgpmime + "o" #'mml-secure-encrypt-pgp + "s" #'mml-secure-encrypt-smime) + "C-n" #'mml-unsecure-message + "f" #'mml-attach-file + "b" #'mml-attach-buffer + "e" #'mml-attach-external + "q" #'mml-quote-region + "m" #'mml-insert-multipart + "p" #'mml-insert-part + "v" #'mml-validate + "P" #'mml-preview)) (easy-menu-define mml-menu mml-mode-map "" @@ -1246,7 +1235,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ;; ;;["Narrow" mml-narrow-to-part t] ["Quote MML in region" mml-quote-region - :active (message-mark-active-p) + :active mark-active :help "Quote MML tags in region"] ["Validate MML" mml-validate t] ["Preview" mml-preview t] @@ -1409,6 +1398,13 @@ to specify options." :version "22.1" ;; Gnus 5.10.9 :group 'message) +(defcustom mml-attach-file-at-the-end nil + "If non-nil, \\[mml-attach-file] attaches files at the end of the message. +If nil, files are attached at point." + :type 'boolean + :version "29.1" + :group 'message) + ;;;###autoload (defun mml-attach-file (file &optional type description disposition) "Attach a file to the outgoing MIME message. @@ -1423,6 +1419,8 @@ specifies how the attachment is intended to be displayed. It can be either \"inline\" (displayed automatically within the message body) or \"attachment\" (separate from the body). +Also see the `mml-attach-file-at-the-end' variable. + If given a prefix interactively, no prompting will be done for the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults will be computed and used." @@ -1440,8 +1438,11 @@ will be computed and used." (mml-minibuffer-read-disposition type nil file)))) (list file type description disposition))) ;; If in the message header, attach at the end and leave point unchanged. - (let ((head (unless (message-in-body-p) (point)))) - (if head (goto-char (point-max))) + (let ((at-end (and (or (not (message-in-body-p)) + mml-attach-file-at-the-end) + (point)))) + (when at-end + (goto-char (point-max))) (mml-insert-empty-tag 'part 'type type ;; icicles redefines read-file-name and returns a @@ -1451,13 +1452,13 @@ will be computed and used." 'description description) ;; When using Mail mode, make sure it does the mime encoding ;; when you send the message. - (or (eq mail-user-agent 'message-user-agent) - (setq mail-encode-mml t)) - (when head + (unless (eq mail-user-agent 'message-user-agent) + (setq mail-encode-mml t)) + (when at-end (unless (pos-visible-in-window-p) (message "The file \"%s\" has been attached at the end of the message" (file-name-nondirectory file))) - (goto-char head)))) + (goto-char at-end)))) (defun mml-dnd-attach-file (uri _action) "Attach a drag and drop file. @@ -1512,7 +1513,7 @@ BUFFER is the name of the buffer to attach. See (defun mml-attach-external (file &optional type description) "Attach an external file into the buffer. -FILE is an ange-ftp/efs specification of the part location. +FILE is an ange-ftp specification of the part location. TYPE is the MIME type to use." (interactive (let* ((file (mml-minibuffer-read-file "Attach external file: ")) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index a373b7999ec..bf9e975f749 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -45,7 +45,7 @@ ;; could be removed. (defvar mml2015-use 'epg "The package used for PGP/MIME. -Valid packages include `epg', `pgg' and `mailcrypt'.") +Valid packages include `epg', and `mailcrypt'.") ;; Something is not RFC2015. (defvar mml2015-function-alist diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 60140a46411..d7e32e45809 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -35,6 +35,7 @@ (defconst nnagent-version "nnagent 1.0") +(make-obsolete-variable 'nnagent-version 'emacs-version "29.1") (defvoo nnagent-directory nil "Internal variable." diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index ff0dea8ecdd..1a699d0e705 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -55,6 +55,7 @@ (defconst nnbabyl-version "nnbabyl 1.0" "nnbabyl version.") +(make-obsolete-variable 'nnbabyl-version 'emacs-version "29.1") (defvoo nnbabyl-mbox-buffer nil) (defvoo nnbabyl-current-group nil) @@ -306,7 +307,7 @@ (while (re-search-forward "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (point-at-bol) (progn (forward-line 1) (point)))) + (delete-region (line-beginning-position) (progn (forward-line 1) (point)))) (setq result (eval accept-form t)) (kill-buffer (current-buffer)) result) @@ -423,7 +424,7 @@ (defun nnbabyl-delete-mail (&optional force leave-delim) ;; Delete the current X-Gnus-Newsgroup line. (unless force - (delete-region (point-at-bol) (progn (forward-line 1) (point)))) + (delete-region (line-beginning-position) (progn (forward-line 1) (point)))) ;; Beginning of the article. (save-excursion (save-restriction @@ -629,7 +630,8 @@ (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) (if (gethash (setq id (match-string 1)) idents) (progn - (delete-region (point-at-bol) (progn (forward-line 1) (point))) + (delete-region (line-beginning-position) + (progn (forward-line 1) (point))) (nnheader-message 7 "Moving %s..." id) (nnbabyl-save-mail (nnmail-article-group 'nnbabyl-active-number))) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 0ab92488f83..ab9c6dd74f9 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -165,22 +165,16 @@ In order to make this clear, here are some examples: :type 'boolean) -(define-obsolete-variable-alias 'nndiary-request-create-group-hooks - 'nndiary-request-create-group-functions "24.3") (defcustom nndiary-request-create-group-functions nil "Hook run after `nndiary-request-create-group' is executed. The hook functions will be called with the full group name as argument." :type 'hook) -(define-obsolete-variable-alias 'nndiary-request-update-info-hooks - 'nndiary-request-update-info-functions "24.3") (defcustom nndiary-request-update-info-functions nil "Hook run after `nndiary-request-update-info' is executed. The hook functions will be called with the full group name as argument." :type 'hook) -(define-obsolete-variable-alias 'nndiary-request-accept-article-hooks - 'nndiary-request-accept-article-functions "24.3") (defcustom nndiary-request-accept-article-functions nil "Hook run before accepting an article. Executed near the beginning of `nndiary-request-accept-article'. @@ -234,9 +228,11 @@ all. This may very well take some time.") (defconst nndiary-version "0.2-b14" "Current Diary back end version.") +(make-obsolete-variable 'nndiary-version 'emacs-version "29.1") (defun nndiary-version () "Current Diary back end version." + (declare (obsolete emacs-version "29.1")) (interactive) (message "NNDiary version %s" nndiary-version)) @@ -860,7 +856,7 @@ all. This may very well take some time.") (search-forward id nil t)) ; We find the ID. ;; And the id is in the fourth field. (if (not (and (search-backward "\t" nil t 4) - (not (search-backward"\t" (point-at-bol) t)))) + (not (search-backward"\t" (line-beginning-position) t)))) (forward-line 1) (beginning-of-line) (setq found t) @@ -1308,7 +1304,7 @@ all. This may very well take some time.") (let ((minute (nndiary-max (nth 0 sched))) (hour (nndiary-max (nth 1 sched))) (year (nndiary-max (nth 4 sched))) - (time-zone (or (and (nth 6 sched) (car (nth 6 sched))) + (time-zone (or (car (nth 6 sched)) (current-time-zone)))) (when year (or minute (setq minute 59)) @@ -1405,7 +1401,7 @@ all. This may very well take some time.") t)) (dow-list (nth 5 sched)) (year (1- this-year)) - (time-zone (or (and (nth 6 sched) (car (nth 6 sched))) + (time-zone (or (car (nth 6 sched)) (current-time-zone)))) ;; Special case: an asterisk in one of the days specifications means that ;; only the other should be taken into account. If both are unspecified, diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el index 2ca25534ce1..75a6ace107a 100644 --- a/lisp/gnus/nndir.el +++ b/lisp/gnus/nndir.el @@ -48,6 +48,7 @@ (defvoo nndir-status-string "" nil nnmh-status-string) (defconst nndir-version "nndir 1.0") +(make-obsolete-variable 'nndir-version 'emacs-version "29.1") diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 19ccce47b50..cdff7c9accf 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -218,6 +218,7 @@ from the document.") (defconst nndoc-version "nndoc 1.0" "nndoc version.") +(make-obsolete-variable 'nndoc-version 'emacs-version "29.1") diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index fa88b8a87e0..f21e4faf559 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -56,6 +56,7 @@ are generated if and only if they are also in `message-draft-headers'." (defvoo nndraft-current-directory nil nil nnmh-current-directory) (defconst nndraft-version "nndraft 1.0") +(make-obsolete-variable 'nndraft-version 'emacs-version "29.1") (defvoo nndraft-status-string "" nil nnmh-status-string) diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 829d912cb2d..ff72842a2ee 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -57,6 +57,7 @@ included.") (defconst nneething-version "nneething 1.0" "nneething version.") +(make-obsolete-variable 'nneething-version 'emacs-version "29.1") (defvoo nneething-current-directory nil "Current news group directory.") @@ -245,7 +246,8 @@ included.") (while map (if (and (member (cadr (car map)) files) ;; We also remove files that have changed mod times. - (equal (file-attribute-modification-time (file-attributes + (time-equal-p + (file-attribute-modification-time (file-attributes (nneething-file-name (cadr (car map))))) (cadr (cdar map)))) (progn diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 5dc8e5c30d0..c47a398c4c2 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -91,6 +91,7 @@ message, a huge time saver for large mailboxes.") (defconst nnfolder-version "nnfolder 2.0" "nnfolder version.") +(make-obsolete-variable 'nnfolder-version 'emacs-version "29.1") (defconst nnfolder-article-marker "X-Gnus-Article-Number: " "String used to demarcate what the article number for a message is.") @@ -178,7 +179,7 @@ all. This may very well take some time.") (goto-char (match-end 0)) (setq num (string-to-number (buffer-substring - (point) (point-at-eol)))) + (point) (line-end-position)))) (goto-char start) (< num article))) ;; Check that we are before an article with a @@ -188,7 +189,7 @@ all. This may very well take some time.") (progn (setq num (string-to-number (buffer-substring - (point) (point-at-eol)))) + (point) (line-end-position)))) (> num article)) ;; Discard any article numbers before the one we're ;; now looking at. @@ -258,7 +259,7 @@ all. This may very well take some time.") (if (search-forward (concat "\n" nnfolder-article-marker) nil t) (string-to-number (buffer-substring - (point) (point-at-eol))) + (point) (line-end-position))) -1)))))))) (deffoo nnfolder-request-group (group &optional server dont-check _info) @@ -860,7 +861,8 @@ deleted. Point is left where the deleted region was." (nnheader-find-file-noselect file t))))) (mm-enable-multibyte) ;; Use multibyte buffer for future copying. (buffer-disable-undo) - (if (equal (cadr (assoc group nnfolder-scantime-alist)) + (if (time-equal-p + (cadr (assoc group nnfolder-scantime-alist)) (file-attribute-modification-time (file-attributes file))) ;; This looks up-to-date, so we don't do any scanning. (if (file-exists-p file) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 8b3718ed7e8..b91798b8a0c 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -27,6 +27,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'range) (defvar gnus-decode-encoded-word-function) (defvar gnus-decode-encoded-address-function) @@ -44,8 +45,6 @@ (require 'mm-util) (require 'gnus-util) (autoload 'gnus-remove-odd-characters "gnus-sum") -(autoload 'gnus-range-add "gnus-range") -(autoload 'gnus-remove-from-range "gnus-range") ;; FIXME none of these are used explicitly in this file. (autoload 'gnus-sorted-intersection "gnus-range") (autoload 'gnus-intersection "gnus-range") @@ -189,7 +188,7 @@ on your system, you could say something like: (defsubst nnheader-header-value () (skip-chars-forward " \t") - (buffer-substring (point) (point-at-eol))) + (buffer-substring (point) (line-end-position))) (autoload 'ietf-drums-unfold-fws "ietf-drums") @@ -398,7 +397,7 @@ leaving the original buffer untouched." (autoload 'gnus-extract-message-id-from-in-reply-to "gnus-sum") (defun nnheader-parse-nov (&optional number) - (let ((eol (point-at-eol)) + (let ((eol (line-end-position)) references in-reply-to x header) (setq header (make-full-mail-header @@ -633,7 +632,7 @@ the line could be found." ;; This is invalid, but not all articles have Message-IDs. () (mail-position-on-field "References") - (let ((begin (point-at-bol)) + (let ((begin (line-beginning-position)) (fill-column 78) (fill-prefix "\t")) (when references @@ -919,15 +918,11 @@ first. Otherwise, find the newest one, though it may take a time." (car (sort results #'file-newer-than-file-p))))) (defvar ange-ftp-path-format) -(defvar efs-path-regexp) (defun nnheader-re-read-dir (path) "Re-read directory PATH if PATH is on a remote system." - (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp)) - (when (string-match efs-path-regexp path) - (efs-re-read-dir path)) - (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format)) - (when (string-match (car ange-ftp-path-format) path) - (ange-ftp-re-read-dir path))))) + (when (and (fboundp 'ange-ftp-reread-dir) (boundp 'ange-ftp-path-format)) + (when (string-match (car ange-ftp-path-format) path) + (ange-ftp-reread-dir path)))) (defun nnheader-insert-file-contents (filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but only reads in the file. @@ -1044,10 +1039,9 @@ See `find-file-noselect' for the arguments." mark (cond ((eq what 'add) - (gnus-range-add (cdr (assoc mark backend-marks)) range)) + (range-concat (cdr (assoc mark backend-marks)) range)) ((eq what 'del) - (gnus-remove-from-range - (cdr (assoc mark backend-marks)) range)) + (range-remove (cdr (assoc mark backend-marks)) range)) ((eq what 'set) range)) backend-marks))))) @@ -1061,7 +1055,7 @@ See `find-file-noselect' for the arguments." (or ,end (point-max))) '(buffer-string))))) -(defvar nnheader-last-message-time '(0 0)) +(defvar nnheader-last-message-time 0) (defun nnheader-message-maybe (&rest args) (let ((now (current-time))) (when (time-less-p 1 (time-subtract now nnheader-last-message-time)) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index fd6e3c0ccf7..73cd183a02a 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -34,12 +34,12 @@ (require 'gnus-util) (require 'gnus) (require 'nnoo) -(require 'netrc) (require 'utf7) (require 'nnmail) (autoload 'auth-source-forget+ "auth-source") (autoload 'auth-source-search "auth-source") +(autoload 'auth-info-password "auth-source") (nnoo-declare nnimap) @@ -94,9 +94,6 @@ Uses the same syntax as `nnmail-split-methods'.") (defvoo nnimap-unsplittable-articles '(%Deleted %Seen) "Articles with the flags in the list will not be considered when splitting.") -(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'." - "24.1") - (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. Possible choices are nil (use default methods), `anonymous', @@ -232,20 +229,30 @@ during splitting, which may be slow." params) (format "%s" (nreverse params)))) +(defvar nnimap--max-retrieve-headers 200) + (deffoo nnimap-retrieve-headers (articles &optional group server _fetch-old) (with-current-buffer nntp-server-buffer (erase-buffer) (when (nnimap-change-group group server) (with-current-buffer (nnimap-buffer) (erase-buffer) - (nnimap-wait-for-response - (nnimap-send-command - "UID FETCH %s %s" - (nnimap-article-ranges (gnus-compress-sequence articles)) - (nnimap-header-parameters)) - t) + ;; If we have a lot of ranges, split them up to avoid + ;; generating too-long lines. (The limit is 8192 octects, + ;; and this should guarantee that it's (much) shorter than + ;; that.) We don't stream the requests, since the server + ;; may respond to the requests out-of-order: + ;; https://datatracker.ietf.org/doc/html/rfc3501#section-5.5 + (dolist (ranges (seq-split (gnus-compress-sequence articles t) + nnimap--max-retrieve-headers)) + (nnimap-wait-for-response + (nnimap-send-command + "UID FETCH %s %s" + (nnimap-article-ranges ranges) + (nnimap-header-parameters)) + t)) (unless (process-live-p (get-buffer-process (current-buffer))) - (error "Server closed connection")) + (error "IMAP server %S closed connection" nnimap-address)) (nnimap-transform-headers) (nnheader-remove-cr-followed-by-lf)) (insert-buffer-substring @@ -407,10 +414,7 @@ during splitting, which may be slow." :create t)))) (if found (list (plist-get found :user) - (let ((secret (plist-get found :secret))) - (if (functionp secret) - (funcall secret) - secret)) + (auth-info-password found) (plist-get found :save-function)) nil))) @@ -429,8 +433,18 @@ during splitting, which may be slow." now (nnimap-last-command-time nnimap-object)))) (with-local-quit - (ignore-errors ;E.g. "buffer foo has no process". - (nnimap-send-command "NOOP"))))))))) + (ignore-errors ;E.g. "buffer foo has no process". + (nnimap-send-command "NOOP")) + ;; If our connection has died in the meantime, clean it + ;; and its buffer up. + (unless (process-live-p (get-buffer-process buffer)) + (setq nnimap-process-buffers + (delq buffer nnimap-process-buffers)) + (setq nnimap-connection-alist + (seq-filter (lambda (elt) + (null (eq buffer (cdr elt)))) + nnimap-connection-alist)) + (kill-buffer buffer))))))))) (defun nnimap-open-connection (buffer) ;; Be backwards-compatible -- the earlier value of nnimap-stream was @@ -541,7 +555,7 @@ during splitting, which may be slow." ;; Look for the credentials based on ;; the virtual server name and the address (nnimap-credentials - (gnus-delete-duplicates + (seq-uniq (list server nnimap-address)) ports nnimap-user)))) @@ -662,10 +676,17 @@ during splitting, which may be slow." (deffoo nnimap-close-server (&optional server defs) (when (nnoo-change-server 'nnimap server defs) - (ignore-errors - (delete-process (get-buffer-process (nnimap-buffer)))) - (nnoo-close-server 'nnimap server) - t)) + (let ((buf (nnimap-buffer))) + (ignore-errors + (delete-process (get-buffer-process buf))) + (setq nnimap-process-buffers + (delq buf nnimap-process-buffers) + nnimap-connection-alist + (seq-filter (lambda (elt) + (null (eq buf (cdr elt)))) + nnimap-connection-alist)) + (nnoo-close-server 'nnimap server) + t))) (deffoo nnimap-request-close () t) @@ -1645,13 +1666,13 @@ If LIMIT, first try to limit the search to the N last articles." (cdr (assoc '%Seen flags)) (cdr (assoc '%Deleted flags)))) (cdr (assoc '%Flagged flags))))) - (read (gnus-range-difference + (read (range-difference (cons start-article high) unread))) (when (> start-article 1) (setq read (gnus-range-nconcat (if (> start-article 1) - (gnus-sorted-range-intersection + (range-intersection (cons 1 (1- start-article)) (gnus-info-read info)) (gnus-info-read info)) @@ -1676,7 +1697,7 @@ If LIMIT, first try to limit the search to the N last articles." (pop old-marks) (when (and old-marks (> start-article 1)) - (setq old-marks (gnus-range-difference + (setq old-marks (range-difference old-marks (cons start-article high))) (setq new-marks (gnus-range-nconcat old-marks new-marks))) @@ -1687,15 +1708,15 @@ If LIMIT, first try to limit the search to the N last articles." (active (gnus-active group)) (unexists (if completep - (gnus-range-difference + (range-difference active (gnus-compress-sequence existing)) - (gnus-add-to-range + (range-add-list (cdr old-unexists) - (gnus-list-range-difference + (range-list-difference existing (gnus-active group)))))) (when (> (car active) 1) - (setq unexists (gnus-range-add + (setq unexists (range-concat (cons 1 (1- (car active))) unexists))) (if old-unexists @@ -1718,10 +1739,9 @@ If LIMIT, first try to limit the search to the N last articles." (defun nnimap-update-qresync-info (info existing vanished flags) ;; Add all the vanished articles to the list of read articles. (setf (gnus-info-read info) - (gnus-add-to-range - (gnus-add-to-range - (gnus-range-add (gnus-info-read info) - vanished) + (range-add-list + (range-add-list + (range-concat (gnus-info-read info) vanished) (cdr (assq '%Flagged flags))) (cdr (assq '%Seen flags)))) (let ((marks (gnus-info-marks info))) @@ -1735,9 +1755,9 @@ If LIMIT, first try to limit the search to the N last articles." (setq marks (delq ticks marks)) (pop ticks) ;; Add the new marks we got. - (setq ticks (gnus-add-to-range ticks new-marks)) + (setq ticks (range-add-list ticks new-marks)) ;; Remove the marks from messages that don't have them. - (setq ticks (gnus-remove-from-range + (setq ticks (range-remove ticks (gnus-compress-sequence (gnus-sorted-complement existing new-marks)))) @@ -1747,7 +1767,7 @@ If LIMIT, first try to limit the search to the N last articles." ;; Add vanished to the list of unexisting articles. (when vanished (let* ((old-unexists (assq 'unexist marks)) - (unexists (gnus-range-add (cdr old-unexists) vanished))) + (unexists (range-concat (cdr old-unexists) vanished))) (if old-unexists (setcdr old-unexists unexists) (push (cons 'unexist unexists) marks))) @@ -1937,10 +1957,13 @@ Return the server's response to the SELECT or EXAMINE command." (when entry (if (and (buffer-live-p (cadr entry)) (get-buffer-process (cadr entry)) - (memq (process-status (get-buffer-process (cadr entry))) - '(open run))) + (process-live-p (get-buffer-process (cadr entry)))) (get-buffer-process (cadr entry)) - (setq nnimap-connection-alist (delq entry nnimap-connection-alist)) + (setq nnimap-connection-alist (delq entry nnimap-connection-alist) + nnimap-process-buffers + (delq (cadr entry) nnimap-process-buffers)) + (when (buffer-live-p (cadr entry)) + (kill-buffer (cadr entry))) nil)))) ;; Leave room for `open-network-stream' to issue a couple of IMAP @@ -2224,7 +2247,7 @@ Return the server's response to the SELECT or EXAMINE command." (while (re-search-forward "^\\([0-9]+\\) OK\\b" nil t) (setq sequence (string-to-number (match-string 1))) (when (setq range (cadr (assq sequence sequences))) - (push (gnus-uncompress-range range) copied))) + (push (range-uncompress range) copied))) (gnus-compress-sequence (sort (apply #'nconc copied) #'<)))) (defun nnimap-new-articles (flags) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index c71627f83a4..afa14448fc7 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -661,7 +661,7 @@ nn*-request-list should have been called before calling this function." (while (not (eobp)) (condition-case nil (progn - (narrow-to-region (point) (point-at-eol)) + (narrow-to-region (point) (line-end-position)) (setq group (read buffer) group (cond ((symbolp group) @@ -1116,7 +1116,7 @@ FUNC will be called with the group name to determine the article number." (while (not (eobp)) (unless (< (move-to-column nnmail-split-header-length-limit) nnmail-split-header-length-limit) - (delete-region (point) (point-at-eol))) + (delete-region (point) (line-end-position))) (forward-line 1)) ;; Allow washing. (goto-char (point-min)) @@ -1650,7 +1650,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (skip-chars-forward "^\n\r\t") (unless (looking-at "[\r\n]") (forward-char 1) - (buffer-substring (point) (point-at-eol))))))) + (buffer-substring (point) (line-end-position))))))) ;; Function for nnmail-split-fancy: look up all references in the ;; cache and if a match is found, return that group. @@ -1937,9 +1937,7 @@ If TIME is nil, then return the cutoff time for oldness instead." (and (string-match (cadr regexp-target-pair) to) (let ((mail-dont-reply-to-names (message-dont-reply-to-names))) - (equal (if (fboundp 'rmail-dont-reply-to) - (rmail-dont-reply-to from) - (mail-dont-reply-to from)) ""))))) + (equal (mail-dont-reply-to from) ""))))) (setq target (format-time-string (caddr regexp-target-pair) date))) ((and (not (equal header 'to-from)) (string-match (cadr regexp-target-pair) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 690761a2d6c..4d1ecbf8642 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -62,6 +62,7 @@ (require 'subr-x)) (defconst nnmaildir-version "Gnus") +(make-obsolete-variable 'nnmaildir-version 'emacs-version "29.1") (defconst nnmaildir-flag-mark-mapping '((?F . tick) @@ -99,7 +100,7 @@ SUFFIX should start with \":2,\"." (let* ((flags (substring suffix 3)) (flags-as-list (append flags nil)) (new-flags - (concat (gnus-delete-duplicates + (concat (seq-uniq ;; maildir flags must be sorted (sort (cons flag flags-as-list) #'<))))) (concat ":2," new-flags))) @@ -463,7 +464,7 @@ This variable is set by `nnmaildir-request-article'.") ;; usable: if the message has been edited or if nnmail-extra-headers ;; has been augmented since this data was parsed from the message, ;; then we have to reparse. Otherwise it's up-to-date. - (when (and nov (equal mtime (nnmaildir--nov-get-mtime nov))) + (when (and nov (time-equal-p mtime (nnmaildir--nov-get-mtime nov))) ;; The timestamp matches. Now check nnmail-extra-headers. (setq old-extra (nnmaildir--nov-get-extra nov)) (when (equal nnmaildir--extra old-extra) ;; common case @@ -799,7 +800,7 @@ This variable is set by `nnmaildir-request-article'.") isnew (throw 'return t)) (setq nattr (file-attribute-modification-time nattr)) - (if (equal nattr (nnmaildir--grp-new group)) + (if (time-equal-p nattr (nnmaildir--grp-new group)) (setq nattr nil)) (if read-only (setq dir (and (or isnew nattr) ndir)) (when (or isnew nattr) @@ -811,7 +812,7 @@ This variable is set by `nnmaildir-request-article'.") (rename-file x (concat cdir (nnmaildir--ensure-suffix file))))) (setf (nnmaildir--grp-new group) nattr)) (setq cattr (file-attribute-modification-time (file-attributes cdir))) - (if (equal cattr (nnmaildir--grp-cur group)) + (if (time-equal-p cattr (nnmaildir--grp-cur group)) (setq cattr nil)) (setq dir (and (or isnew cattr) cdir))) (unless dir (throw 'return t)) @@ -899,7 +900,7 @@ This variable is set by `nnmaildir-request-article'.") (remhash scan-group groups)) (setq x (file-attribute-modification-time (file-attributes srv-dir)) scan-group (null scan-group)) - (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server)) + (if (time-equal-p x (nnmaildir--srv-mtime nnmaildir--cur-server)) (when scan-group (maphash (lambda (group-name _group) (nnmaildir--scan group-name t groups @@ -1006,16 +1007,16 @@ This variable is set by `nnmaildir-request-article'.") existing (nnmaildir--grp-nlist group) existing (mapcar #'car existing) existing (nreverse existing) - existing (gnus-compress-sequence existing 'always-list) + existing (range-compress-list existing) missing (list (cons 1 (nnmaildir--group-maxnum nnmaildir--cur-server group))) - missing (gnus-range-difference missing existing) + missing (range-difference missing existing) dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir dir gname) dir (nnmaildir--nndir dir) dir (nnmaildir--marks-dir dir) ls (nnmaildir--group-ls nnmaildir--cur-server pgname) - all-marks (gnus-delete-duplicates + all-marks (seq-uniq ;; get mark names from mark dirs and from flag ;; mappings (append @@ -1049,7 +1050,7 @@ This variable is set by `nnmaildir-request-article'.") (t markdir-mtime)))) (puthash mark mtime new-mmth) - (when (equal mtime (gethash mark old-mmth)) + (when (time-equal-p mtime (gethash mark old-mmth)) (setq ranges (assq mark old-marks)) (if ranges (setq ranges (cdr ranges))) (throw 'got-ranges nil)) @@ -1076,10 +1077,10 @@ This variable is set by `nnmaildir-request-article'.") (let ((article (nnmaildir--flist-art flist prefix))) (when article (push (nnmaildir--art-num article) article-list)))))) - (setq ranges (gnus-add-to-range ranges (sort article-list #'<))))) + (setq ranges (range-add-list ranges (sort article-list #'<))))) (if (eq mark 'read) (setq read ranges) (if ranges (setq marks (cons (cons mark ranges) marks))))) - (setf (gnus-info-read info) (gnus-range-add read missing)) + (setf (gnus-info-read info) (range-concat read missing)) (gnus-info-set-marks info marks 'extend) (setf (nnmaildir--grp-mmth group) new-mmth) info))) @@ -1548,11 +1549,11 @@ This variable is set by `nnmaildir-request-article'.") (unless group (setf (nnmaildir--srv-error nnmaildir--cur-server) (if gname (concat "No such group: " gname) "No current group")) - (throw 'return (gnus-uncompress-range ranges))) + (throw 'return (range-uncompress ranges))) (setq gname (nnmaildir--grp-name group) pgname (nnmaildir--pgname nnmaildir--cur-server gname)) (if (nnmaildir--param pgname 'read-only) - (throw 'return (gnus-uncompress-range ranges))) + (throw 'return (range-uncompress ranges))) (setq time (nnmaildir--param pgname 'expire-age)) (unless time (setq time (or (and nnmail-expiry-wait-function @@ -1564,7 +1565,7 @@ This variable is set by `nnmaildir-request-article'.") (setq time (round (* time 86400)))))) (when no-force (unless (integerp time) ;; handle 'never - (throw 'return (gnus-uncompress-range ranges))) + (throw 'return (range-uncompress ranges))) (setq boundary (time-since time))) (setq dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir dir gname) @@ -1686,7 +1687,7 @@ This variable is set by `nnmaildir-request-article'.") (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "No such group: " gname)) (dolist (action actions) - (setq ranges (gnus-range-add ranges (car action)))) + (setq ranges (range-concat ranges (car action)))) (throw 'return ranges)) (setq nlist (nnmaildir--grp-nlist group) marksdir (nnmaildir--srv-dir nnmaildir--cur-server) @@ -1697,7 +1698,7 @@ This variable is set by `nnmaildir-request-article'.") pgname (nnmaildir--pgname nnmaildir--cur-server gname) ls (nnmaildir--group-ls nnmaildir--cur-server pgname) all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort) - all-marks (gnus-delete-duplicates + all-marks (seq-uniq ;; get mark names from mark dirs and from flag ;; mappings (append @@ -1785,9 +1786,4 @@ This variable is set by `nnmaildir-request-article'.") (provide 'nnmaildir) -;; Local Variables: -;; indent-tabs-mode: t -;; fill-column: 77 -;; End: - ;;; nnmaildir.el ends here diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 8ca1cf0fe8b..b1eee2d5308 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -333,7 +333,7 @@ this might lead to problems, especially when used with marks propagation." (defvar nnmairix-widget-other '(threads flags) "Other editable mairix commands when using customization widgets. -Currently there are 'threads and 'flags.") +Currently there are `threads' and `flags'.") (defvar nnmairix-interactive-query-parameters '((?f "from" "f" "From") (?t "to" "t" "To") (?c "to" "tc" "To or Cc") @@ -574,7 +574,7 @@ Other back ends might or might not work.") (gnus-group-get-parameter qualgroup 'folder))) (progn (replace-match cur) - (delete-region cpoint (point-at-bol)) + (delete-region cpoint (line-beginning-position)) (forward-line) (setq cpoint (point))) (forward-line))) @@ -597,7 +597,7 @@ Other back ends might or might not work.") (dolist (cur actions) (let ((type (nth 1 cur)) (cmdmarks (nth 2 cur)) - (range (gnus-uncompress-range (nth 0 cur))) + (range (range-uncompress (nth 0 cur))) mid ogroup temp) ;; number method (when (and corr (not (zerop (cadr corr)))) diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index 5a350aac746..5735c97805e 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -52,6 +52,7 @@ (defconst nnmbox-version "nnmbox 1.0" "nnmbox version.") +(make-obsolete-variable 'nnmbox-version 'emacs-version "29.1") (defvoo nnmbox-current-group nil "Current nnmbox news group directory.") @@ -529,7 +530,7 @@ ;; add article to index, either by building complete list ;; in reverse order, or as a list of ranges. (if (not nnmbox-group-building-active-articles) - (setcdr entry (gnus-add-to-range (cdr entry) (list article))) + (setcdr entry (range-add-list (cdr entry) (list article))) (when (memq article (cdr entry)) (switch-to-buffer nnmbox-mbox-buffer) (error "Article %s:%d already exists!" group article)) @@ -548,10 +549,10 @@ nnmbox-group-active-articles) (car nnmbox-group-active-articles))))) ;; remove article from index - (setcdr entry (gnus-remove-from-range (cdr entry) (list article))))) + (setcdr entry (range-remove (cdr entry) (list article))))) (defun nnmbox-is-article-active-p (article) - (gnus-member-of-range + (range-member-p article (cdr (assoc nnmbox-current-group nnmbox-group-active-articles)))) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index 5d016267bc6..bced527d03f 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -55,6 +55,7 @@ as unread by Gnus.") (defconst nnmh-version "nnmh 1.0" "nnmh version.") +(make-obsolete-variable 'nnmh-version 'emacs-version "29.1") (defvoo nnmh-current-directory nil "Current news group directory.") @@ -539,7 +540,7 @@ as unread by Gnus.") (let ((arts articles) art) (while (setq art (pop arts)) - (when (not (equal + (when (not (time-equal-p (file-attribute-modification-time (file-attributes (concat dir (int-to-string (car art))))) (cdr art))) @@ -547,14 +548,17 @@ as unread by Gnus.") (push (car art) new)))) ;; Go through all the new articles and add them, and their ;; time-stamps, to the list. + ;; Use list format for timestamps, so Emacs <27 can read .nnmh-articles. (setq articles (nconc articles (mapcar (lambda (art) (cons art - (file-attribute-modification-time - (file-attributes - (concat dir (int-to-string art)))))) + (when-let ((modtime + (file-attribute-modification-time + (file-attributes + (concat dir (int-to-string art)))))) + (time-convert modtime 'list)))) new))) ;; Make Gnus mark all new articles as unread. (when new diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index afdb0c780a5..40e4b9ea828 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -89,6 +89,7 @@ non-nil.") (defconst nnml-version "nnml 1.0" "nnml version.") +(make-obsolete-variable 'nnml-version 'emacs-version "29.1") (defvoo nnml-nov-file-name ".overview") @@ -600,7 +601,7 @@ non-nil.") (search-forward id nil t)) ; We find the ID. ;; And the id is in the fourth field. (if (not (and (search-backward "\t" nil t 4) - (not (search-backward "\t" (point-at-bol) t)))) + (not (search-backward "\t" (line-beginning-position) t)))) (forward-line 1) (beginning-of-line) (setq found t) @@ -754,7 +755,7 @@ article number. This function is called narrowed to an article." (nnheader-insert-nov headers))) (defsubst nnml-header-value () - (buffer-substring (match-end 0) (point-at-eol))) + (buffer-substring (match-end 0) (line-end-position))) (defun nnml-parse-head (chars &optional number) "Parse the head of the current buffer." @@ -1060,7 +1061,7 @@ Use the nov database for the current group if available." (regexp-quote (concat group ":" old-number-string)) "\\>") - (point-at-eol) t)) + (line-end-position) t)) (replace-match (concat group ":" new-number-string))) ;; Save to the new file: @@ -1078,21 +1079,20 @@ Use the nov database for the current group if available." ;; #### doing anything on them. ;; 2 a/ read articles: (let ((read (gnus-info-read info))) - (setq read (gnus-remove-from-range read (list new-number))) - (when (gnus-member-of-range old-number read) - (setq read (gnus-remove-from-range read (list old-number))) - (setq read (gnus-add-to-range read (list new-number)))) + (setq read (range-remove read (list new-number))) + (when (range-member-p old-number read) + (setq read (range-remove read (list old-number))) + (setq read (range-add-list read (list new-number)))) (setf (gnus-info-read info) read)) ;; 2 b/ marked articles: (let ((oldmarks (gnus-info-marks info)) mark newmarks) (while (setq mark (pop oldmarks)) - (setcdr mark (gnus-remove-from-range (cdr mark) - (list new-number))) - (when (gnus-member-of-range old-number (cdr mark)) - (setcdr mark (gnus-remove-from-range (cdr mark) - (list old-number))) - (setcdr mark (gnus-add-to-range (cdr mark) + (setcdr mark (range-remove (cdr mark) (list new-number))) + (when (range-member-p old-number (cdr mark)) + (setcdr mark (range-remove (cdr mark) + (list old-number))) + (setcdr mark (range-add-list (cdr mark) (list new-number)))) (push mark newmarks)) (setf (gnus-info-marks info) newmarks)) @@ -1109,7 +1109,7 @@ Use the nov database for the current group if available." (regexp-quote (concat group ":" old-number-string)) "\\>") - (point-at-eol) t) + (line-end-position) t) (replace-match (concat "\\1" group ":" new-number-string)))))) ;; 4/ Possibly remove the article from the backlog: diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el index 36a8bc4581b..092b53298a2 100644 --- a/lisp/gnus/nnnil.el +++ b/lisp/gnus/nnnil.el @@ -40,7 +40,7 @@ (defun nnnil-open-server (_server &optional _definitions) t) -(defun nnnil-close-server (&optional _server) +(defun nnnil-close-server (&optional _server _defs) t) (defun nnnil-request-close () diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el index d042981ca98..4a799acad98 100644 --- a/lisp/gnus/nnregistry.el +++ b/lisp/gnus/nnregistry.el @@ -36,7 +36,7 @@ (nnoo-declare nnregistry) (deffoo nnregistry-server-opened (_server) - gnus-registry-enabled) + gnus-registry-db) (deffoo nnregistry-close-server (_server &optional _defs) t) @@ -45,7 +45,7 @@ nil) (deffoo nnregistry-open-server (_server &optional _defs) - gnus-registry-enabled) + gnus-registry-db) (defvar nnregistry-within-nnregistry nil) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 10b378fd44c..99e7b2a6f3f 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -71,6 +71,7 @@ this variable to the list of fields to be ignored.") (defvoo nnrss-status-string "") (defconst nnrss-version "nnrss 1.0") +(make-obsolete-variable 'nnrss-version 'emacs-version "29.1") (defvar nnrss-group-alist '() "List of RSS addresses.") @@ -325,7 +326,7 @@ for decoding when the cdr that the data specify is not available.") (nnmail-expired-article-p group (if (listp (setq days (nth 1 e))) days - (days-to-time (- days (time-to-days '(0 0))))) + (days-to-time (- days (time-to-days 0)))) force)) (setq nnrss-group-data (delq e nnrss-group-data) changed t) @@ -450,11 +451,11 @@ nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s" This function handles the ISO 8601 date format described in URL `https://www.w3.org/TR/NOTE-datetime', and also the RFC 822 style which RSS 2.0 allows." - (let (case-fold-search vector year month day time zone cts given) + (let (case-fold-search vector year month day time zone given) (cond ((null date)) ; do nothing for this case ;; if the date is just digits (unix time stamp): - ((string-match "^[0-9]+$" date) - (setq given (time-convert (string-to-number date)))) + ((string-match "\\`[0-9]+\\'" date) + (setq given (time-convert (string-to-number date) t))) ;; RFC 822 ((string-match " [0-9]+ " date) (setq vector (timezone-parse-date date) @@ -481,13 +482,13 @@ which RSS 2.0 allows." 0 (decoded-time-zone decoded)))))) (if month - (progn - (setq cts (current-time-string (encode-time 0 0 0 day month year))) - (format "%s, %02d %s %04d %s%s" - (substring cts 0 3) day (substring cts 4 7) year time - (if zone - (concat " " (format-time-string "%z" nil zone)) - ""))) + (concat (let ((system-time-locale "C")) + (format-time-string "%a, %d %b %Y " + (encode-time 0 0 0 day month year))) + time + (if zone + (format-time-string " %z" nil zone) + "")) (message-make-date given)))) ;;; data functions @@ -756,8 +757,7 @@ Export subscriptions to a buffer in OPML Format." (insert " </body>\n" "</opml>\n")) (pop-to-buffer "*OPML Export*") - (when (fboundp 'sgml-mode) - (sgml-mode))) + (sgml-mode)) (defun nnrss-generate-download-script () "Generate a download script in the current buffer. diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index e79b080e789..9b8333a7c6c 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -47,7 +47,8 @@ ;;; Setup: (require 'gnus-art) -(require 'gnus-search) +(autoload 'gnus-search-run-query "gnus-search") +(autoload 'gnus-search-server-to-engine "gnus-search") (eval-when-compile (require 'cl-lib)) @@ -79,33 +80,37 @@ ;;; Helper routines. (defun nnselect-compress-artlist (artlist) "Compress ARTLIST." - (let (selection) - (pcase-dolist (`(,artgroup . ,arts) - (nnselect-categorize artlist #'nnselect-artitem-group)) - (let (list) - (pcase-dolist (`(,rsv . ,articles) - (nnselect-categorize - arts #'nnselect-artitem-rsv #'nnselect-artitem-number)) - (push (cons rsv (gnus-compress-sequence (sort articles #'<))) - list)) - (push (cons artgroup list) selection))) - selection)) + (if (consp artlist) + artlist + (let (selection) + (pcase-dolist (`(,artgroup . ,arts) + (nnselect-categorize artlist #'nnselect-artitem-group)) + (let (list) + (pcase-dolist (`(,rsv . ,articles) + (nnselect-categorize + arts #'nnselect-artitem-rsv #'nnselect-artitem-number)) + (push (cons rsv (gnus-compress-sequence (sort articles #'<))) + list)) + (push (cons artgroup list) selection))) + selection))) (defun nnselect-uncompress-artlist (artlist) "Uncompress ARTLIST." (if (vectorp artlist) artlist (let (selection) - (pcase-dolist (`(,artgroup (,artrsv . ,artseq)) artlist) - (setq selection - (vconcat - (cl-map 'vector - (lambda (art) - (vector artgroup art artrsv)) - (gnus-uncompress-sequence artseq)) selection))) + (pcase-dolist (`(,artgroup . ,list) artlist) + (pcase-dolist (`(,artrsv . ,artseq) list) + (setq selection + (vconcat + (cl-map 'vector + (lambda (art) + (vector artgroup art artrsv)) + (gnus-uncompress-sequence artseq)) selection)))) selection))) (make-obsolete 'nnselect-group-server 'gnus-group-server "28.1") +(make-obsolete 'nnselect-run 'nnselect-generate-artlist "29.1") ;; Data type article list. @@ -207,7 +212,7 @@ as `(keyfunc member)' and the corresponding element is just (inline-quote (cond ((eq ,type 'range) - (nnselect-categorize (gnus-uncompress-range ,articles) + (nnselect-categorize (range-uncompress ,articles) #'nnselect-article-group #'nnselect-article-number)) ((eq ,type 'tuple) (nnselect-categorize ,articles @@ -227,11 +232,6 @@ as `(keyfunc member)' and the corresponding element is just `(gnus-group-prefixed-name (gnus-group-short-name ,group) '(nnselect "nnselect"))) -(defmacro nnselect-get-artlist (group) - "Retrieve the list of articles for GROUP." - `(when (gnus-nnselect-group-p ,group) - (nnselect-uncompress-artlist - (gnus-group-get-parameter ,group 'nnselect-artlist t)))) (defmacro nnselect-add-novitem (novitem) "Add NOVITEM to the list of headers." @@ -252,16 +252,78 @@ as `(keyfunc member)' and the corresponding element is just (define-obsolete-variable-alias 'nnir-retrieve-headers-override-function 'nnselect-retrieve-headers-override-function "28.1") +(defcustom nnselect-allow-ephemeral-expiry nil + "If non-nil, articles in ephemeral nnselect groups are subject to expiry." + :version "29.1" + :type 'boolean) + (defcustom nnselect-retrieve-headers-override-function nil "A function that retrieves article headers for ARTICLES from GROUP. The retrieved headers should populate the `nntp-server-buffer'. -Returns either the retrieved header format 'nov or 'headers. +Returns either the retrieved header format `nov' or `headers'. If this variable is nil, or if the provided function returns nil, `gnus-retrieve-headers' will be called instead." :version "28.1" :type '(repeat function)) +(defun nnselect-generate-artlist (group &optional specs) + "Generate the artlist for GROUP using SPECS. +SPECS should be an alist including an `nnselect-function' and an +`nnselect-args'. The former applied to the latter should create +the artlist. If SPECS is nil retrieve the specs from the group +parameters." + (let* ((specs + (or specs (gnus-group-get-parameter group 'nnselect-specs t))) + (function (alist-get 'nnselect-function specs)) + (args (alist-get 'nnselect-args specs))) + (condition-case-unless-debug err + (funcall function args) + ;; Don't swallow gnus-search errors; the user should be made + ;; aware of them. + (gnus-search-error + (signal (car err) (cdr err))) + (error + (gnus-error + 3 + "nnselect-generate-artlist: %s on %s gave error %s" function args err) + [])))) + +(defmacro nnselect-get-artlist (group) + "Get the list of articles for GROUP. +If the group parameter `nnselect-get-artlist-override-function' is +non-nil call this function with argument GROUP to get the +artlist; if the group parameter `nnselect-always-regenerate' is +non-nil, regenerate the artlist; otherwise retrieve the artlist +directly from the group parameters." + `(when (gnus-nnselect-group-p ,group) + (let ((override (gnus-group-get-parameter + ,group + 'nnselect-get-artlist-override-function))) + (cond + (override (funcall override ,group)) + ((gnus-group-get-parameter ,group 'nnselect-always-regenerate) + (nnselect-generate-artlist ,group)) + (t + (nnselect-uncompress-artlist + (gnus-group-get-parameter ,group 'nnselect-artlist t))))))) + +(defmacro nnselect-store-artlist (group artlist) + "Store the ARTLIST for GROUP. +If the group parameter `nnselect-store-artlist-override-function' +is non-nil call this function on GROUP and ARTLIST; if the group +parameter `nnselect-always-regenerate' is non-nil don't store the +artlist; otherwise store the ARTLIST in the group parameters." + `(let ((override (gnus-group-get-parameter + ,group + 'nnselect-store-artlist-override-function))) + (cond + (override (funcall override ,group ,artlist)) + ((gnus-group-get-parameter ,group 'nnselect-always-regenerate) t) + (t + (gnus-group-set-parameter ,group 'nnselect-artlist + (nnselect-compress-artlist ,artlist)))))) + ;; Gnus backend interface functions. (deffoo nnselect-open-server (server &optional definitions) @@ -287,11 +349,8 @@ If this variable is nil, or if the provided function returns nil, ;; Check for cached select result or run the selection and cache ;; the result. (unless nnselect-artlist - (gnus-group-set-parameter - group 'nnselect-artlist - (nnselect-compress-artlist (setq nnselect-artlist - (nnselect-run - (gnus-group-get-parameter group 'nnselect-specs t))))) + (nnselect-store-artlist group + (setq nnselect-artlist (nnselect-generate-artlist group))) (nnselect-request-update-info group (or info (gnus-get-info group)))) (if (zerop (setq length (nnselect-artlist-length nnselect-artlist))) @@ -329,6 +388,7 @@ If this variable is nil, or if the provided function returns nil, (gnus-group-find-parameter artgroup 'gnus-fetch-old-headers t)) fetch-old))) + (gnus-request-group artgroup) (erase-buffer) (pcase (setq gnus-headers-retrieved-by (or @@ -395,8 +455,7 @@ If this variable is nil, or if the provided function returns nil, (gnus-search-run-query (list (cons 'search-query-spec - (list (cons 'query `((id . ,article))) - (cons 'criteria "") (cons 'shortcut t))) + (list (cons 'query (format "id:%s" article)))) (cons 'search-group-spec servers)))) (unless (zerop (nnselect-artlist-length artlist)) (setq @@ -454,24 +513,26 @@ If this variable is nil, or if the provided function returns nil, :test #'equal :count 1))))) (deffoo nnselect-request-expire-articles - (articles _group &optional _server force) - (if force - (let (not-expired) - (pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles)) - (let ((artlist (sort (mapcar #'cdr artids) #'<))) - (unless (gnus-check-backend-function 'request-expire-articles - artgroup) - (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))) - (let ((nnimap-expunge 'immediately)) - (gnus-request-expire-articles - artlist artgroup force))) - not-expired))) - (sort (delq nil not-expired) #'<)) - articles)) + (articles group &optional _server force) + (let ((nnimap-expunge 'immediately) not-deleted) + (if (and (not force) + (not nnselect-allow-ephemeral-expiry) + (gnus-ephemeral-group-p (nnselect-add-prefix group))) + articles + (pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles)) + (let ((artlist (sort (mapcar #'cdr artids) #'<))) + (unless + (gnus-check-backend-function 'request-expire-articles artgroup) + (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)) + (setq not-deleted + (append + (mapcar (lambda (art) (car (rassq art artids))) + (gnus-request-expire-articles artlist artgroup + force)) + not-deleted)))) + (sort (delq nil not-deleted) #'<)))) (deffoo nnselect-warp-to-article () @@ -529,68 +590,65 @@ If this variable is nil, or if the provided function returns nil, (deffoo nnselect-request-update-info (group info &optional _server) (let* ((group (nnselect-add-prefix group)) - (gnus-newsgroup-selection - (or gnus-newsgroup-selection (nnselect-get-artlist group))) - newmarks) + (gnus-newsgroup-selection + (or gnus-newsgroup-selection (nnselect-get-artlist group))) + newmarks) (gnus-info-set-marks info nil) (setf (gnus-info-read info) nil) (pcase-dolist (`(,artgroup . ,nartids) - (ids-by-group - (number-sequence 1 (nnselect-artlist-length - gnus-newsgroup-selection)))) + (ids-by-group + (number-sequence 1 (nnselect-artlist-length + gnus-newsgroup-selection)))) (let* ((gnus-newsgroup-active nil) - (artids (cl-sort nartids #'< :key 'car)) - (group-info (gnus-get-info artgroup)) - (marks (gnus-info-marks group-info)) - (unread (gnus-uncompress-sequence - (gnus-range-difference (gnus-active artgroup) - (gnus-info-read group-info))))) + (idmap (make-hash-table :test 'eql)) + (gactive (sort (mapcar 'cdr nartids) '<)) + (group-info (gnus-get-info artgroup)) + (marks (gnus-info-marks group-info))) + (pcase-dolist (`(,val . ,key) nartids) + (puthash key val idmap)) (setf (gnus-info-read info) - (gnus-add-to-range - (gnus-info-read info) - (delq nil (mapcar - (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) - (when - (setq new - (delq nil - (cond - ((eq mark-type 'tuple) - (mapcar - (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))))) - (let ((previous (alist-get type newmarks))) - (if previous - (nconc previous new) - (push (cons type new) newmarks)))))))) + (range-add-list + (gnus-info-read info) + (sort (mapcar (lambda (art) (gethash art idmap)) + (gnus-sorted-intersection + gactive + (range-uncompress (gnus-info-read group-info)))) + '<))) + (pcase-dolist (`(,type . ,mark-list) marks) + (let ((mark-type (gnus-article-mark-to-type type)) new) + (when + (setq new + (if (not mark-list) nil + (cond + ((eq mark-type 'tuple) + (delq nil + (mapcar + (lambda (mark) + (let ((id (gethash (car mark) idmap))) + (when id (cons id (cdr mark))))) + mark-list))) + (t + (mapcar (lambda (art) (gethash art idmap)) + (gnus-sorted-intersection + gactive (range-uncompress mark-list))))))) + (let ((previous (alist-get type newmarks))) + (if previous + (nconc previous new) + (push (cons type new) newmarks)))))))) ;; Clean up the marks: compress lists; (pcase-dolist (`(,type . ,mark-list) newmarks) (let ((mark-type (gnus-article-mark-to-type type))) - (unless (eq mark-type 'tuple) - (setf (alist-get type newmarks) - (gnus-compress-sequence mark-list))))) + (unless (eq mark-type 'tuple) + (setf (alist-get type newmarks) + (gnus-compress-sequence (sort mark-list '<)))))) ;; and ensure an unexist key. (unless (assq 'unexist newmarks) (push (cons 'unexist nil) newmarks)) (gnus-info-set-marks info newmarks) (gnus-set-active group (cons 1 (nnselect-artlist-length - gnus-newsgroup-selection))))) + gnus-newsgroup-selection))))) (deffoo nnselect-request-thread (header &optional group server) @@ -645,8 +703,15 @@ If this variable is nil, or if the provided function returns nil, (lambda (article) (if (setq seq - (cl-position article - gnus-newsgroup-selection :test 'equal)) + (cl-position + article + gnus-newsgroup-selection + :test + (lambda (x y) + (and (equal (nnselect-artitem-group x) + (nnselect-artitem-group y)) + (eql (nnselect-artitem-number x) + (nnselect-artitem-number y)))))) (push (1+ seq) old-arts) (setq gnus-newsgroup-selection (vconcat gnus-newsgroup-selection (vector article))) @@ -657,10 +722,7 @@ If this variable is nil, or if the provided function returns nil, (append (sort old-arts #'<) (number-sequence first last)) nil t)) - (gnus-group-set-parameter - group - 'nnselect-artlist - (nnselect-compress-artlist gnus-newsgroup-selection)) + (nnselect-store-artlist group gnus-newsgroup-selection) (when (>= last first) (let (new-marks) (pcase-dolist (`(,artgroup . ,artids) @@ -707,6 +769,7 @@ If this variable is nil, or if the provided function returns nil, (message "Creating nnselect group %s" group) (let* ((group (gnus-group-prefixed-name group '(nnselect "nnselect"))) (specs (assq 'nnselect-specs args)) + (otherargs (assq-delete-all 'nnselect-specs args)) (function-spec (or (alist-get 'nnselect-function specs) (intern (completing-read "Function: " obarray #'functionp)))) @@ -716,10 +779,12 @@ If this variable is nil, or if the provided function returns nil, (nnselect-specs (list (cons 'nnselect-function function-spec) (cons 'nnselect-args args-spec)))) (gnus-group-set-parameter group 'nnselect-specs nnselect-specs) - (gnus-group-set-parameter - group 'nnselect-artlist - (nnselect-compress-artlist (or (alist-get 'nnselect-artlist args) - (nnselect-run nnselect-specs)))) + (dolist (arg otherargs) + (gnus-group-set-parameter group (car arg) (cdr arg))) + (nnselect-store-artlist + group + (or (alist-get 'nnselect-artlist args) + (nnselect-generate-artlist group nnselect-specs))) (nnselect-request-update-info group (gnus-get-info group))) t) @@ -744,20 +809,17 @@ If this variable is nil, or if the provided function returns nil, (deffoo nnselect-request-scan (group _method) (when (and group - (gnus-group-get-parameter (nnselect-add-prefix group) + (gnus-group-find-parameter (nnselect-add-prefix group) 'nnselect-rescan t)) (nnselect-request-group-scan group))) (deffoo nnselect-request-group-scan (group &optional _server _info) (let* ((group (nnselect-add-prefix group)) - (artlist (nnselect-run - (gnus-group-get-parameter group 'nnselect-specs t)))) + (artlist (nnselect-generate-artlist group))) (gnus-set-active group (cons 1 (nnselect-artlist-length artlist))) - (gnus-group-set-parameter - group 'nnselect-artlist - (nnselect-compress-artlist artlist)))) + (nnselect-store-artlist group artlist))) ;; Add any undefined required backend functions @@ -772,16 +834,6 @@ If this variable is nil, or if the provided function returns nil, (eq 'nnselect (car gnus-command-method)))) -(defun nnselect-run (specs) - "Apply nnselect-function to nnselect-args from SPECS. -Return an article list." - (let ((func (alist-get 'nnselect-function specs)) - (args (alist-get 'nnselect-args specs))) - (condition-case-unless-debug err - (funcall func args) - (error (gnus-error 3 "nnselect-run: %s on %s gave error %s" func args err) - [])))) - (defun nnselect-search-thread (header) "Make an nnselect group containing the thread with article HEADER. The current server will be searched. If the registry is @@ -860,19 +912,19 @@ article came from is also searched." ;; When the backend can store marks we collect any ;; changes. Unlike a normal group the mark lists only ;; include marks for articles we retrieved. - (when (and (gnus-check-backend-function - 'request-set-mark artgroup) - (not (gnus-article-unpropagatable-p type))) - (let* ((old (gnus-list-range-intersection + (when (and (gnus-check-backend-function + 'request-set-mark gnus-newsgroup-name) + (not (gnus-article-unpropagatable-p type))) + (let* ((old (range-list-intersection artlist (alist-get type (gnus-info-marks group-info)))) - (del (gnus-remove-from-range (copy-tree old) list)) - (add (gnus-remove-from-range (copy-tree list) old))) + (del (range-remove (copy-tree old) list)) + (add (range-remove (copy-tree list) old))) (when add (push (list add 'add (list type)) delta-marks)) (when del ;; Don't delete marks from outside the active range. ;; This shouldn't happen, but is a sanity check. - (setq del (gnus-sorted-range-intersection + (setq del (range-intersection (gnus-active artgroup) del)) (push (list del 'del (list type)) delta-marks)))) @@ -899,26 +951,29 @@ article came from is also searched." (setq list (cdr all)))) ;; now merge with the original list and sort just to ;; make sure - (setq list - (sort (map-merge - 'list list - (alist-get type (gnus-info-marks group-info))) - (lambda (elt1 elt2) - (< (car elt1) (car elt2)))))) + (setq + list (sort + (map-merge + 'alist list + (delq nil + (mapcar + (lambda (x) (unless (memq (car x) artlist) x)) + (alist-get type (gnus-info-marks group-info))))) + 'car-less-than-car))) (t (setq list - (gnus-compress-sequence + (range-compress-list (gnus-sorted-union (gnus-sorted-difference (gnus-uncompress-sequence (alist-get type (gnus-info-marks group-info))) artlist) - (sort list #'<)) t))) + (sort list #'<))))) ;; When exiting the group, everything that's previously been ;; unseen is now seen. (when (eq type 'seen) - (setq list (gnus-range-add + (setq list (range-concat list (cdr (assoc artgroup select-unseen)))))) (when (or list (eq type 'unexist)) @@ -941,16 +996,20 @@ article came from is also searched." ;; update read and unread (gnus-update-read-articles artgroup - (gnus-uncompress-range - (gnus-add-to-range - (gnus-remove-from-range + (range-uncompress + (range-add-list + (range-remove old-unread (cdr (assoc artgroup select-reads))) (sort (cdr (assoc artgroup select-unreads)) #'<)))) (gnus-get-unread-articles-in-group - group-info (gnus-active artgroup) t) - (gnus-group-update-group artgroup t t))))))) - + group-info (gnus-active artgroup) t)) + (gnus-group-update-group + artgroup t + (equal group-info + (setq group-info (copy-sequence (gnus-get-info artgroup)) + group-info + (delq (gnus-info-params group-info) group-info))))))))) (declare-function gnus-registry-get-id-key "gnus-registry" (id key)) diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 39b89abb88a..e5eb4b81604 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -114,6 +114,7 @@ there.") (defconst nnspool-version "nnspool 2.0" "Version numbers of this version of NNSPOOL.") +(make-obsolete-variable 'nnspool-version 'emacs-version "29.1") (defvoo nnspool-current-directory nil "Current news group directory.") diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index bdf6f629866..6dea405d02b 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -36,6 +36,7 @@ (eval-when-compile (require 'cl-lib)) (autoload 'auth-source-search "auth-source") +(autoload 'auth-info-password "auth-source") (defgroup nntp nil "NNTP access for Gnus." @@ -216,25 +217,6 @@ then use this hook to rsh to the remote machine and start a proxy NNTP server there that you can connect to. See also `nntp-open-connection-function'") -(defcustom nntp-authinfo-file "~/.authinfo" - ".netrc-like file that holds nntp authinfo passwords." - :type - '(choice file - (repeat :tag "Entries" - :menu-tag "Inline" - (list :format "%v" - :value ("" ("login" . "") ("password" . "")) - (string :tag "Host") - (checklist :inline t - (cons :format "%v" - (const :format "" "login") - (string :format "Login: %v")) - (cons :format "%v" - (const :format "" "password") - (string :format "Password: %v"))))))) - -(make-obsolete-variable 'nntp-authinfo-file 'netrc-file "24.1") - (defvoo nntp-connection-timeout nil @@ -277,6 +259,7 @@ update their active files often, this can help.") (defvoo nntp-connection-alist nil) (defvoo nntp-status-string "") (defconst nntp-version "nntp 5.0") +(make-obsolete-variable 'nntp-version 'emacs-version "29.1") (defvoo nntp-inhibit-erase nil) (defvoo nntp-inhibit-output nil) @@ -305,7 +288,7 @@ backend doesn't catch this error.") (nntp-record-command string)) (process-send-string process (concat string nntp-end-of-line)) (or (memq (process-status process) '(open run)) - (nntp-report "Server closed connection"))) + (nntp-report "NNTP server %S closed connection" nntp-address))) (defun nntp-record-command (string) "Record the command STRING." @@ -331,9 +314,7 @@ retried once before actually displaying the error report." (when nntp-record-commands (nntp-record-command "*** CALLED nntp-report ***")) - (nnheader-report 'nntp args) - - (apply #'error args))) + (nnheader-report 'nntp args))) (defsubst nntp-copy-to-buffer (buffer start end) "Copy string from unibyte current buffer to multibyte buffer." @@ -370,7 +351,7 @@ retried once before actually displaying the error report." (nntp-snarf-error-message) nil)) ((not (memq (process-status process) '(open run))) - (nntp-report "Server closed connection")) + (nntp-report "NNTP server %S closed connection" nntp-address)) (t (goto-char (point-max)) (let ((limit (point-min)) @@ -499,7 +480,7 @@ retried once before actually displaying the error report." (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) - (point-at-bol))))))) + (line-beginning-position))))))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -522,7 +503,7 @@ retried once before actually displaying the error report." (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) - (point-at-bol))))))) + (line-beginning-position))))))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -547,7 +528,8 @@ retried once before actually displaying the error report." (with-current-buffer buffer (goto-char pos) (if (looking-at (regexp-quote command)) - (delete-region pos (progn (forward-line 1) (point-at-bol)))) + (delete-region pos (progn (forward-line 1) + (line-beginning-position)))) ))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -1153,11 +1135,6 @@ It will make innd servers spawn an nnrpd process to allow actual article reading." (nntp-send-command "^.*\n" "MODE READER")) -(declare-function netrc-parse "netrc" (&optional file)) -(declare-function netrc-machine "netrc" - (list machine &optional port defaultport)) -(declare-function netrc-get "netrc" (alist type)) - (defun nntp-send-authinfo (&optional send-if-force) "Send the AUTHINFO to the nntp server. It will look in the \"~/.authinfo\" file for matching entries. If @@ -1166,33 +1143,16 @@ and a password. If SEND-IF-FORCE, only send authinfo to the server if the .authinfo file has the FORCE token." - (require 'netrc) - (let* ((list (netrc-parse nntp-authinfo-file)) - (alist (netrc-machine list nntp-address "nntp")) - (auth-info + (let* ((auth-info (nth 0 (auth-source-search :max 1 :host (list nntp-address (nnoo-current-server 'nntp)) :port `("119" "nntp" ,(format "%s" nntp-port-number) "563" "nntps" "snews")))) (auth-user (plist-get auth-info :user)) - (auth-force (plist-get auth-info :force)) - (auth-passwd (plist-get auth-info :secret)) - (auth-passwd (if (functionp auth-passwd) - (funcall auth-passwd) - auth-passwd)) - (force (or (netrc-get alist "force") - nntp-authinfo-force - auth-force)) - (user (or - ;; this is preferred to netrc-* - auth-user - (netrc-get alist "login") - nntp-authinfo-user)) - (passwd (or - ;; this is preferred to netrc-* - auth-passwd - (netrc-get alist "password")))) + (passwd (auth-info-password auth-info)) + (force (or nntp-authinfo-force (plist-get auth-info :force))) + (user (or auth-user nntp-authinfo-user))) (when (or (not send-if-force) force) (unless user @@ -1229,6 +1189,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (generate-new-buffer (format " *server %s %s %s*" nntp-address nntp-port-number buffer)) + (gnus-add-buffer) (mm-disable-multibyte) (setq-local after-change-functions nil nntp-process-wait-for nil @@ -1435,7 +1396,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the ;; be the process's former output buffer (i.e. now killed) (or (and process (memq (process-status process) '(open run))) - (nntp-report "Server closed connection"))))) + (nntp-report "NNTP server %S closed connection" nntp-address))))) (defun nntp-accept-response () "Wait for output from the process that outputs to BUFFER." @@ -1454,7 +1415,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (when group (let ((entry (nntp-find-connection-entry nntp-server-buffer))) (cond ((not entry) - (nntp-report "Server closed connection")) + (nntp-report "NNTP server %S closed connection" nntp-address)) ((not (equal group (caddr entry))) (with-current-buffer (process-buffer (car entry)) (erase-buffer) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 7478a2dd0af..e150cbf2b46 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -57,6 +57,7 @@ component group will show up when you enter the virtual group.") (defconst nnvirtual-version "nnvirtual 1.1") +(make-obsolete-variable 'nnvirtual-version 'emacs-version "29.1") (defvoo nnvirtual-current-group nil) @@ -114,14 +115,9 @@ It is computed from the marks of individual component groups.") (gnus-check-server (gnus-find-method-for-group cgroup) t) (gnus-request-group cgroup t) - (setq prefix (gnus-group-real-prefix cgroup)) - ;; FIX FIX FIX we want to check the cache! - ;; This is probably evil if people have set - ;; gnus-use-cache to nil themselves, but I - ;; have no way of finding the true value of it. - (let ((gnus-use-cache t)) - (setq result (gnus-retrieve-headers - articles cgroup nil)))) + (setq prefix (gnus-group-real-prefix cgroup) + result (gnus-retrieve-headers + articles cgroup nil))) (set-buffer nntp-server-buffer) ;; If we got HEAD headers, we convert them into NOV ;; headers. This is slow, inefficient and, come to think @@ -365,7 +361,7 @@ It is computed from the marks of individual component groups.") (lambda (article) (nnvirtual-reverse-map-article group article)) - (gnus-uncompress-range + (range-uncompress (gnus-group-expire-articles-1 group)))))) (sort (delq nil unexpired) #'<))) @@ -391,7 +387,7 @@ lines have the correct component server prefix." (looking-at "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") (goto-char (match-end 0)) - (unless (search-forward "\t" (point-at-eol) 'move) + (unless (search-forward "\t" (line-end-position) 'move) (insert "\t")) ;; Remove any spaces at the beginning of the Xref field. @@ -407,8 +403,8 @@ lines have the correct component server prefix." ;; component server prefix. (save-restriction (narrow-to-region (point) - (or (search-forward "\t" (point-at-eol) t) - (point-at-eol))) + (or (search-forward "\t" (line-end-position) t) + (line-end-position))) (goto-char (point-min)) (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t) (replace-match "" t t)) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index ac1e0810417..fd2791f5c51 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -119,7 +119,7 @@ ;;; Code: (require 'dig) - +(require 'gnutls) (require 'password-cache) (eval-when-compile (require 'cl-lib)) @@ -149,10 +149,11 @@ certificate." :type '(choice (const :tag "none" nil) directory)) -(defcustom smime-CA-file nil - "Files containing certificates for CAs you trust. -File should contain certificates in PEM format." - :version "22.1" +(defcustom smime-CA-file (car (gnutls-trustfiles)) + "File containing certificates for CAs you trust. +The file should contain certificates in PEM format. By default, +this is initialized from the `gnutls-trusfiles' variable." + :version "29.1" :type '(choice (const :tag "none" nil) file)) @@ -518,7 +519,7 @@ A string or a list of strings is returned." (goto-char b) (let (res) (while (< (point) e) - (let ((str (buffer-substring (point) (point-at-eol)))) + (let ((str (buffer-substring (point) (line-end-position)))) (unless (string= "" str) (push str res))) (forward-line)) diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 334204768b4..014b8254fa0 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -291,7 +291,7 @@ symbol `ask', query before flushing the queue file." (goto-char (point-min)) (while (and (not (eobp)) (re-search-forward - "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t)) + "http://\\([^/]+\\)\\(/.*\\) *$" (line-end-position) t)) (let ((spam-report-gmane-wait (zerop (% (line-number-at-pos) spam-report-gmane-max-requests)))) (gnus-message 6 "Reporting %s%s..." diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index b0d258d67a5..5763ac14bb3 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -189,7 +189,7 @@ When using `spam-stat-process-spam-directory' or been touched in this many days will be considered. Without this filter, re-training spam-stat with several thousand messages will start to take a very long time." - :type 'number) + :type 'integer) (defvar spam-stat-last-saved-at nil "Time stamp of last change of spam-stat-file on this run") @@ -422,7 +422,8 @@ spam-stat (spam-stat-to-hash-table '(" spam-stat-ngood spam-stat-nbad)) (cond (spam-stat-dirty (message "Spam stat not loaded: spam-stat-dirty t")) ((or (not (boundp 'spam-stat-last-saved-at)) (null spam-stat-last-saved-at) - (not (equal spam-stat-last-saved-at + (not (time-equal-p + spam-stat-last-saved-at (file-attribute-modification-time (file-attributes spam-stat-file))))) (progn diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 4b12a9a7804..e0d90e5547a 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -43,14 +43,12 @@ (require 'gnus-uu) ; because of key prefix issues ;;; for the definitions of group content classification and spam processors (require 'gnus) +(require 'dig) (eval-when-compile (require 'cl-lib) (require 'hashcash)) -;; autoload query-dig -(autoload 'query-dig "dig") - ;; autoload spam-report (autoload 'spam-report-gmane "spam-report") (autoload 'spam-report-gmane-spam "spam-report") @@ -663,13 +661,13 @@ order for SpamAssassin to recognize the new registered spam." ;;; Key bindings for spam control. -(gnus-define-keys gnus-summary-mode-map - "St" spam-generic-score - "Sx" gnus-summary-mark-as-spam - "Mst" spam-generic-score - "Msx" gnus-summary-mark-as-spam - "\M-d" gnus-summary-mark-as-spam - "$" gnus-summary-mark-as-spam) +(define-keymap :keymap gnus-summary-mode-map + "S t" #'spam-generic-score + "S x" #'gnus-summary-mark-as-spam + "M s t" #'spam-generic-score + "M s x" #'gnus-summary-mark-as-spam + "M-d" #'gnus-summary-mark-as-spam + "$" #'gnus-summary-mark-as-spam) (defvar spam-cache-lookups t "Whether spam.el will try to cache lookups using `spam-caches'.") @@ -852,7 +850,7 @@ The value nil means that the check does not yield a decision, and so, that further checks are needed. The value t means that the message is definitely not spam, and that further spam checks should be inhibited. Otherwise, a mailgroup name or the symbol -'spam (depending on `spam-split-symbolic-return') is returned where +`spam' (depending on `spam-split-symbolic-return') is returned where the mail should go, and further checks are also inhibited. The usual mailgroup name is the value of `spam-split-group', meaning that the message is definitely a spam." @@ -2008,7 +2006,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (unless matches (let ((query-string (concat ip "." server))) (if spam-use-dig - (let ((query-result (query-dig query-string))) + (let ((query-result (dig-query query-string))) (when query-result (gnus-message 6 "(DIG): positive blackhole check `%s'" query-result) @@ -2134,7 +2132,7 @@ See `spam-ifile-database'." ;; check the return now (we're back in the temp buffer) (goto-char (point-min)) (if (not (eobp)) - (setq category (buffer-substring (point) (point-at-eol)))) + (setq category (buffer-substring (point) (line-end-position)))) (when (not (zerop (length category))) ; we need a category here (if spam-ifile-all-categories (setq return category) @@ -2323,7 +2321,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (with-temp-buffer (insert-file-contents file) (while (not (eobp)) - (setq address (buffer-substring (point) (point-at-eol))) + (setq address (buffer-substring (point) (line-end-position))) (forward-line 1) ;; insert the e-mail address if detected, otherwise the raw data (unless (zerop (length address)) |