X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=3dbcc21e65cffda74992cbfd2c6f30977018c6a1;hp=a646afbb2abf8f11243b3364093129c9e45bba0d;hb=HEAD;hpb=e7b803c97811f4a42e3b0a4e1bfac7b8d0e43e88 diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index a646afbb2..5fc78baec 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,6 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996-2012 Free Software Foundation, Inc. +;; Copyright (C) 1996-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -24,9 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (eval-when-compile @@ -451,7 +448,7 @@ current article is unread." :group 'gnus-summary-maneuvering :type 'boolean) -(defcustom gnus-auto-center-summary +(defcustom gnus-auto-center-summary (max (or (bound-and-true-p scroll-margin) 0) 2) "*If non-nil, always center the current summary buffer. In particular, if `vertical' do only vertical recentering. If non-nil @@ -847,7 +844,6 @@ controls how articles are sorted." (function :tag "other")) (boolean :tag "Reverse order")))) - (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) "*List of functions used for sorting threads in the summary buffer. By default, threads are sorted by article number. @@ -873,7 +869,11 @@ and `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). When threading is turned off, the variable -`gnus-article-sort-functions' controls how articles are sorted." +`gnus-article-sort-functions' controls how articles are sorted. + +By default, threads and their subthreads are sorted according to +the value of this variable. To use a different sorting order for +subthreads, customize `gnus-subthread-sort-functions'." :group 'gnus-summary-sort :type '(repeat (gnus-widget-reversible @@ -890,6 +890,29 @@ When threading is turned off, the variable (function :tag "other")) (boolean :tag "Reverse order")))) +(defcustom gnus-subthread-sort-functions 'gnus-thread-sort-functions + "*List of functions used for sorting subthreads in the summary buffer. +By default, subthreads are sorted the same as threads, i.e., +according to the value of `gnus-thread-sort-functions'." + :version "24.4" + :group 'gnus-summary-sort + :type '(choice + (const :tag "Sort subthreads like threads" gnus-thread-sort-functions) + (repeat + (gnus-widget-reversible + (choice (function-item gnus-thread-sort-by-number) + (function-item gnus-thread-sort-by-author) + (function-item gnus-thread-sort-by-recipient) + (function-item gnus-thread-sort-by-subject) + (function-item gnus-thread-sort-by-date) + (function-item gnus-thread-sort-by-score) + (function-item gnus-thread-sort-by-most-recent-number) + (function-item gnus-thread-sort-by-most-recent-date) + (function-item gnus-thread-sort-by-random) + (function-item gnus-thread-sort-by-total-score) + (function :tag "other")) + (boolean :tag "Reverse order"))))) + (defcustom gnus-thread-score-function '+ "*Function used for calculating the total score of a thread. @@ -974,7 +997,7 @@ following hook: (mail-header-set-subject header (gnus-simplify-subject - (mail-header-subject header) 're-only))) + (mail-header-subject header) \\='re-only))) gnus-newsgroup-headers)))" :group 'gnus-group-select :type 'hook) @@ -1115,7 +1138,6 @@ score: The article's score. default: The default article score. default-high: The default score for high scored articles. default-low: The default score for low scored articles. -below: The score below which articles are automatically marked as read. mark: The article's mark. uncached: Non-nil if the article is uncached." :group 'gnus-summary-visual @@ -1138,9 +1160,9 @@ which it may alter in any way." 'mail-decode-encoded-address-string "Function used to decode addresses with encoded words.") -(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups) +(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups X-GM-LABELS) "*Extra headers to parse." - :version "24.1" ; added Cc Keywords Gcc + :version "25.1" :group 'gnus-summary :type '(repeat symbol)) @@ -1167,7 +1189,7 @@ using `gnus-ignored-from-addresses'." (defcustom gnus-summary-newsgroup-prefix "=> " "*String prefixed to the Newsgroup field in the summary -line when using `gnus-ignored-from-addresses'." +line when using the option `gnus-ignored-from-addresses'." :version "22.1" :group 'gnus-summary :type 'string) @@ -1525,7 +1547,7 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") "Range of seen articles in the current newsgroup.") (defvar gnus-newsgroup-unexist nil - "Range of unexistent articles in the current newsgroup.") + "Range of unexisting articles in the current newsgroup.") (defvar gnus-newsgroup-articles nil "List of articles in the current newsgroup.") @@ -1634,7 +1656,7 @@ while still allowing them to affect operations done in other buffers. For example: \(setq gnus-newsgroup-variables - '(message-use-followup-to + \\='(message-use-followup-to (gnus-visible-headers . \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\"))) ") @@ -1823,9 +1845,9 @@ increase the score of each group you read." (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 - [backspace] gnus-summary-prev-page "\r" gnus-summary-scroll-up "\M-\r" gnus-summary-scroll-down "n" gnus-summary-next-unread-article @@ -1915,7 +1937,7 @@ increase the score of each group you read." "a" gnus-summary-post-news "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article - [tab] gnus-summary-widget-forward + "\t" gnus-summary-widget-forward [backtab] gnus-summary-widget-backward "t" gnus-summary-toggle-header "g" gnus-summary-show-article @@ -2062,6 +2084,7 @@ increase the score of each group you read." (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 @@ -2080,7 +2103,7 @@ increase the score of each group you read." "W" gnus-warp-to-article "g" gnus-summary-show-article "s" gnus-summary-isearch-article - [tab] gnus-summary-widget-forward + "\t" gnus-summary-widget-forward [backtab] gnus-summary-widget-backward "P" gnus-summary-print-article "S" gnus-sticky-article @@ -2162,6 +2185,7 @@ increase the score of each group you read." (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) @@ -2332,7 +2356,8 @@ increase the score of each group you read." ["Mark above" gnus-summary-mark-above t] ["Tick above" gnus-summary-tick-above t] ["Clear above" gnus-summary-clear-above t]) - ["Current score" gnus-summary-current-score t] + ["Current article score" gnus-summary-current-score t] + ["Current thread score" (gnus-summary-current-score 'total) t] ["Set score" gnus-summary-set-score t] ["Switch current score file..." gnus-score-change-score-file t] ["Set mark below..." gnus-score-set-mark-below t] @@ -2368,6 +2393,8 @@ increase the score of each group you read." ["QP" gnus-article-de-quoted-unreadable t] ["Base64" gnus-article-de-base64-unreadable t] ["View MIME buttons" gnus-summary-display-buttonized t] + ["View MIME buttons in header" + gnus-mime-buttonize-attachments-in-header t] ["View all" gnus-mime-view-all-parts t] ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] ["Encrypt body" gnus-article-encrypt-body @@ -2398,6 +2425,7 @@ increase the score of each group you read." ["Lapsed" gnus-article-date-lapsed t] ["User-defined" gnus-article-date-user t]) ("Display" + ["Display HTML images" gnus-article-show-images t] ["Remove images" gnus-article-remove-images t] ["Toggle smiley" gnus-treat-smiley t] ["Show X-Face" gnus-article-display-x-face t] @@ -2971,12 +2999,6 @@ When FORCE, rebuild the tool bar." (setq gnus-summary-tool-bar-map map)))) (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)) -(defun gnus-score-set-default (var value) - "A version of set that updates the GNU Emacs menu-bar." - (set var value) - ;; It is the message that forces the active status to be updated. - (message "")) - (defun gnus-make-score-map (type) "Make a summary score map of type TYPE." (if t @@ -3082,6 +3104,7 @@ buffer; read the info pages for more information (`\\[gnus-info-find-node]'). The following commands are available: \\{gnus-summary-mode-map}" + ;; FIXME: Use define-derived-mode. (interactive) (kill-all-local-variables) (let ((gnus-summary-local-variables gnus-newsgroup-variables)) @@ -3262,13 +3285,6 @@ The following commands are available: "Say whether this article is a sparse article or not." `(memq ,article gnus-newsgroup-ancient)) -(defun gnus-article-parent-p (number) - "Say whether this article is a parent or not." - (let ((data (gnus-data-find-list number))) - (and (cdr data) ; There has to be an article after... - (< (gnus-data-level (car data)) ; And it has to have a higher level. - (gnus-data-level (nth 1 data)))))) - (defun gnus-article-children (number) "Return a list of all children to NUMBER." (let* ((data (gnus-data-find-list number)) @@ -3290,14 +3306,6 @@ The following commands are available: "Say whether this article is intangible or not." '(get-text-property (point) 'gnus-intangible)) -(defun gnus-article-read-p (article) - "Say whether ARTICLE is read or not." - (not (or (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-spam-marked) - (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected) - (memq article gnus-newsgroup-dormant)))) - ;; Some summary mode macros. (defmacro gnus-summary-article-number () @@ -3518,8 +3526,8 @@ If the setup was successful, non-nil is returned." (set-buffer buffer) (setq gnus-summary-buffer (current-buffer)) (not gnus-newsgroup-prepared)) - ;; Fix by Sudish Joseph - (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer))) + (set-buffer (gnus-get-buffer-create buffer)) + (setq gnus-summary-buffer (current-buffer)) (gnus-summary-mode group) (when (gnus-group-quit-config group) (set (make-local-variable 'gnus-single-article-buffer) nil)) @@ -3535,7 +3543,7 @@ If the setup was successful, non-nil is returned." "Set the global equivalents of the buffer-local variables. They are set to the latest values they had. These reflect the summary buffer that was in action when the last article was fetched." - (when (eq major-mode 'gnus-summary-mode) + (when (derived-mode-p 'gnus-summary-mode) (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) (marked gnus-newsgroup-marked) @@ -3577,11 +3585,7 @@ buffer that was in action when the last article was fetched." (if (consp (car locals)) (set (caar locals) (pop vlist)) (set (car locals) (pop vlist))) - (setq locals (cdr locals)))) - ;; The article buffer also has local variables. - (when (gnus-buffer-live-p gnus-article-buffer) - (set-buffer gnus-article-buffer) - (setq gnus-summary-buffer summary)))))) + (setq locals (cdr locals)))))))) (defun gnus-summary-article-unread-p (article) "Say whether ARTICLE is unread or not." @@ -3683,8 +3687,8 @@ buffer that was in action when the last article was fetched." (defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) (let ((mail-parse-charset gnus-newsgroup-charset) (ignored-from-addresses (gnus-ignored-from-addresses)) - ; Is it really necessary to do this next part for each summary line? - ; Luckily, doesn't seem to slow things down much. + ;; Is it really necessary to do this next part for each summary line? + ;; Luckily, doesn't seem to slow things down much. (mail-parse-ignored-charsets (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets))) @@ -3705,13 +3709,13 @@ buffer that was in action when the last article was fetched." (cdr (assq 'Newsgroups extra-headers)) (and (memq 'Newsgroups gnus-extra-headers) - (eq (car (gnus-find-method-for-group - gnus-newsgroup-name)) 'nntp) + (eq (car (gnus-find-method-for-group + gnus-newsgroup-name)) 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) (gnus-string-mark-left-to-right (inline - (gnus-summary-extract-address-component gnus-tmp-from)))))) + (gnus-summary-extract-address-component gnus-tmp-from)))))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current @@ -3987,7 +3991,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." t) ;; We couldn't select this group. ((null did-select) - (when (and (eq major-mode 'gnus-summary-mode) + (when (and (derived-mode-p 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer))) (kill-buffer (current-buffer)) (if (not quit-config) @@ -4006,7 +4010,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; The user did a `C-g' while prompting for number of articles, ;; so we exit this group. ((eq did-select 'quit) - (and (eq major-mode 'gnus-summary-mode) + (and (derived-mode-p 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) (when kill-buffer @@ -4022,6 +4026,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; The group was successfully selected. (t (gnus-set-global-variables) + (when (boundp 'spam-install-hooks) + (spam-initialize)) ;; Save the active value in effect when the group was entered. (setq gnus-newsgroup-active (gnus-copy-sequence @@ -4049,7 +4055,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (unless no-display (gnus-summary-prepare)) (when gnus-use-trees - (gnus-tree-open group) + (gnus-tree-open) (setq gnus-summary-highlight-line-function 'gnus-tree-highlight-article)) ;; If the summary buffer is empty, but there are some low-scored @@ -4088,9 +4094,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." gnus-auto-select-first) (progn (let ((art (gnus-summary-article-number))) - (unless (and (not gnus-plugged) - (or (memq art gnus-newsgroup-undownloaded) - (memq art gnus-newsgroup-downloadable))) + (when (and art + gnus-plugged + (not (memq art gnus-newsgroup-undownloaded)) + (not (memq art gnus-newsgroup-downloadable))) (gnus-summary-goto-article art)))) ;; Don't select any articles. (gnus-summary-position-point) @@ -4370,7 +4377,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; The last case ignores an existing entry, except it adds any ;; additional Xrefs (in case the two articles came from different ;; servers. - ;; Also sets `header' to `nil' meaning that the `dependencies' + ;; Also sets `header' to nil meaning that the `dependencies' ;; table was *not* modified. (t (mail-header-set-xref @@ -4869,10 +4876,25 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-delete-line))))))) (defun gnus-sort-threads-recursive (threads func) + ;; Responsible for sorting the root articles of threads. + (let ((subthread-sort-func (if (eq gnus-subthread-sort-functions + 'gnus-thread-sort-functions) + func + (gnus-make-sort-function + gnus-subthread-sort-functions)))) + (sort (mapcar (lambda (thread) + (cons (car thread) + (and (cdr thread) + (gnus-sort-subthreads-recursive + (cdr thread) subthread-sort-func)))) + threads) func))) + +(defun gnus-sort-subthreads-recursive (threads func) + ;; Responsible for sorting subthreads. (sort (mapcar (lambda (thread) (cons (car thread) (and (cdr thread) - (gnus-sort-threads-recursive (cdr thread) func)))) + (gnus-sort-subthreads-recursive (cdr thread) func)))) threads) func)) (defun gnus-sort-threads-loop (threads func) @@ -4898,9 +4920,9 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-message 8 "Sorting threads...") (prog1 (condition-case nil - (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000))) - (gnus-sort-threads-recursive - threads (gnus-make-sort-function gnus-thread-sort-functions))) + (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000)) + (sort-func (gnus-make-sort-function gnus-thread-sort-functions))) + (gnus-sort-threads-recursive threads sort-func)) ;; Even after binding max-lisp-eval-depth, the recursive ;; sorter might fail for very long threads. In that case, ;; try using a (less well-tested) non-recursive sorter. @@ -5519,6 +5541,8 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) +(declare-function gnus-parameter-list-identifier "gnus-art" (name) t) + (defun gnus-group-get-list-identifiers (group) "Get list identifier regexp for GROUP." (or (gnus-parameter-list-identifier group) @@ -5591,15 +5615,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (or (and entry (not (eq (car entry) t))) ; Either it's active... (gnus-activate-group group) ; Or we can activate it... (progn ; Or we bug out. - (when (equal major-mode 'gnus-summary-mode) + (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (error "Couldn't activate group %s: %s" (mm-decode-coding-string group charset) (mm-decode-coding-string (gnus-status-message group) charset)))) - (unless (gnus-request-group group t) - (when (equal major-mode 'gnus-summary-mode) + (unless (gnus-request-group group t nil (gnus-get-info group)) + (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" (mm-decode-coding-string group charset) @@ -5683,7 +5707,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) - (if (buffer-live-p gnus-group-buffer) + (if (gnus-buffer-live-p gnus-group-buffer) (gnus-set-global-variables) (set-default 'gnus-newsgroup-name gnus-newsgroup-name)) ;; Retrieve the headers and read them in. @@ -5931,17 +5955,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq articles (cdr articles))) out)) -(defun gnus-uncompress-marks (marks) - "Uncompress the mark ranges in MARKS." - (let ((uncompressed '(score bookmark)) - out) - (while marks - (if (memq (caar marks) uncompressed) - (push (car marks) out) - (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) - (setq marks (cdr marks))) - out)) - (defun gnus-article-mark-to-type (mark) "Return the type of MARK." (or (cadr (assq mark gnus-article-special-mark-lists)) @@ -5958,7 +5971,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (min (car active)) (max (cdr active)) (types gnus-article-mark-lists) - marks var articles article mark mark-type + var articles article mark mark-type bgn end) ;; Hack to avoid adjusting marks for imap. (when (eq (car (gnus-find-method-for-group (gnus-info-group info))) @@ -6101,7 +6114,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-active gnus-newsgroup-name) del)) (push (list del 'del (list (cdr type))) delta-marks)))) - (when list + (when (or list + (eq (cdr type) 'unexist)) (push (cons (cdr type) list) newmarked))) (when delta-marks @@ -7206,6 +7220,7 @@ 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. @@ -7246,7 +7261,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (when gnus-suppress-duplicates (gnus-dup-enter-articles)) (when gnus-use-trees - (gnus-tree-close group)) + (gnus-tree-close)) (when gnus-use-cache (gnus-cache-write-active)) ;; Remove entries for this group. @@ -7269,6 +7284,7 @@ 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) (if temporary nil ;Nothing to do. (set-buffer buf) @@ -7283,7 +7299,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) - (when (buffer-live-p gnus-group-buffer) + (when (gnus-buffer-live-p gnus-group-buffer) (set-buffer gnus-group-buffer)) (if quit-config (gnus-handle-ephemeral-exit quit-config) @@ -7309,6 +7325,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (unless quit-config (setq gnus-newsgroup-name nil))))) +(declare-function gnus-stop-downloads "gnus-art" ()) + (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) (defun gnus-summary-exit-no-update (&optional no-questions) "Quit reading current newsgroup without updating read article info." @@ -7318,6 +7336,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-group-is-exiting-without-update-p t) (quit-config (gnus-group-quit-config group))) (when (or no-questions + (gnus-ephemeral-group-p group) gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) @@ -7346,7 +7365,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (unless gnus-single-article-buffer (setq gnus-article-current nil)) (when gnus-use-trees - (gnus-tree-close group)) + (gnus-tree-close)) (gnus-async-prefetch-remove-group group) (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) @@ -7356,6 +7375,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-group-update-group group nil t)) (when (equal (gnus-group-group-name) group) (gnus-group-next-unread-group 1)) + (gnus-article-stop-animations) (when quit-config (gnus-handle-ephemeral-exit quit-config))))) @@ -7363,15 +7383,15 @@ If FORCE (the prefix), also save the .newsrc file(s)." "Handle movement when leaving an ephemeral group. The state which existed when entering the ephemeral is reset." (if (not (buffer-live-p (car quit-config))) - (when (buffer-live-p gnus-group-buffer) + (when (gnus-buffer-live-p gnus-group-buffer) (gnus-configure-windows 'group 'force)) (set-buffer (car quit-config)) (unless (eq (cdr quit-config) 'group) (setq gnus-current-select-method (gnus-find-method-for-group gnus-newsgroup-name))) - (cond ((eq major-mode 'gnus-summary-mode) + (cond ((derived-mode-p 'gnus-summary-mode) (gnus-set-global-variables)) - ((eq major-mode 'gnus-article-mode) + ((derived-mode-p 'gnus-article-mode) (save-current-buffer ;; The `gnus-summary-buffer' variable may point ;; to the old summary buffer when using a single @@ -7386,7 +7406,7 @@ The state which existed when entering the ephemeral is reset." (gnus-configure-windows 'pick 'force) (gnus-configure-windows (cdr quit-config) 'force)) (gnus-configure-windows (cdr quit-config) 'force)) - (when (eq major-mode 'gnus-summary-mode) + (when (derived-mode-p 'gnus-summary-mode) (if (memq gnus-auto-select-on-ephemeral-exit '(next-noselect next-unread-noselect)) (when (zerop (cond ((eq gnus-auto-select-on-ephemeral-exit @@ -7456,7 +7476,7 @@ The state which existed when entering the ephemeral is reset." (when (and gnus-use-trees (gnus-buffer-exists-p buffer)) (with-current-buffer buffer - (gnus-tree-close gnus-newsgroup-name))) + (gnus-tree-close))) (gnus-kill-buffer buffer)) ;; Deaden the buffer. ((gnus-buffer-exists-p buffer) @@ -7685,7 +7705,7 @@ Given a prefix, will force an `article' buffer configuration." "Display ARTICLE in article buffer." (unless (and (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer - (eq major-mode 'gnus-article-mode))) + (derived-mode-p 'gnus-article-mode))) (gnus-article-setup-buffer)) (gnus-set-global-variables) (with-current-buffer gnus-article-buffer @@ -7717,7 +7737,7 @@ non-nil, the article will be re-fetched even if it already present in the article buffer. If PSEUDO is non-nil, pseudo-articles will also be displayed." ;; Make sure we are in the summary buffer to work around bbdb bug. - (unless (eq major-mode 'gnus-summary-mode) + (unless (derived-mode-p 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be t or nil. @@ -7762,10 +7782,6 @@ be displayed." gnus-buttonized-mime-types))) (gnus-summary-select-article nil 'force))) -(defun gnus-summary-set-current-mark (&optional current-mark) - "Obsolete function." - nil) - (defun gnus-summary-next-article (&optional unread subject backward push) "Select the next article. If UNREAD, only unread articles are selected. @@ -7773,7 +7789,7 @@ If SUBJECT, only articles with SUBJECT are selected. If BACKWARD, the previous article is selected instead of the next." (interactive "P") ;; Make sure we are in the summary buffer. - (unless (eq major-mode 'gnus-summary-mode) + (unless (derived-mode-p 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (cond ;; Is there such an article? @@ -7905,6 +7921,8 @@ If UNREAD is non-nil, only unread articles are selected." (and gnus-auto-select-same (gnus-summary-article-subject)))) +(declare-function gnus-article-only-boring-p "gnus-art" ()) + (defun gnus-summary-next-page (&optional lines circular stop) "Show next page of the selected article. If at the end of the current article, select the next article. @@ -7918,7 +7936,6 @@ If STOP is non-nil, just stop when reaching the end of the message. Also see the variable `gnus-article-skip-boring'." (interactive "P") - (setq gnus-summary-buffer (current-buffer)) (gnus-set-global-variables) (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) @@ -8129,7 +8146,7 @@ score higher than the default score." "Select the first unread subject that has a score over the default score." (interactive) (let ((data gnus-newsgroup-data) - article score) + article) (while (and (setq article (gnus-data-number (car data))) (or (gnus-data-read-p (car data)) (not (> (gnus-summary-article-score article) @@ -8239,9 +8256,17 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp." "Limit the summary buffer to articles that have authors that match a regexp. If NOT-MATCHING, excluding articles that have authors that match a regexp." (interactive - (list (read-string (if current-prefix-arg - "Exclude author (regexp): " - "Limit to author (regexp): ")) + (list (let* ((header (gnus-summary-article-header)) + (default (and header (car (mail-header-parse-address + (mail-header-from header)))))) + (read-string (concat (if current-prefix-arg + "Exclude author (regexp" + "Limit to author (regexp") + (if default + (concat ", default \"" default "\"): ") + "): ")) + nil nil + default)) current-prefix-arg)) (gnus-summary-limit-to-subject from "from" not-matching)) @@ -8405,7 +8430,7 @@ articles that are younger than AGE days." (gnus-summary-position-point))) (defun gnus-summary-limit-to-extra (header regexp &optional not-matching) - "Limit the summary buffer to articles that match an 'extra' header." + "Limit the summary buffer to articles that match an `extra' header." (interactive (let ((header (intern @@ -8465,6 +8490,8 @@ If REVERSE (the prefix), limit to articles that don't match." (interactive "sMatch headers (regexp): \nP") (gnus-summary-limit-to-bodies match reverse t)) +(declare-function article-goto-body "gnus-art" ()) + (defun gnus-summary-limit-to-bodies (match &optional reverse headersp) "Limit the summary buffer to articles that have bodies that match MATCH. If REVERSE (the prefix), limit to articles that don't match." @@ -9042,25 +9069,62 @@ non-numeric or nil fetch the number specified by the (regexp-opt ',(append refs (list id subject))))))) (gnus-fetch-headers (list last) (if (numberp limit) (* 2 limit) limit) t)))) - article-ids) + article-ids new-unreads) (when (listp new-headers) (dolist (header new-headers) - (push (mail-header-number header) article-ids) - (when (member (mail-header-number header) gnus-newsgroup-unselected) - (push (mail-header-number header) gnus-newsgroup-unreads) - (setq gnus-newsgroup-unselected - (delete (mail-header-number header) - gnus-newsgroup-unselected)))) + (push (mail-header-number header) article-ids)) + (setq article-ids (nreverse article-ids)) + (setq new-unreads + (gnus-sorted-intersection gnus-newsgroup-unselected article-ids)) + (setq gnus-newsgroup-unselected + (gnus-sorted-ndifference gnus-newsgroup-unselected new-unreads)) + (setq gnus-newsgroup-unreads + (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads)) (setq gnus-newsgroup-headers (gnus-delete-duplicate-headers (gnus-merge 'list gnus-newsgroup-headers new-headers 'gnus-article-sort-by-number))) (setq gnus-newsgroup-articles - (gnus-sorted-nunion gnus-newsgroup-articles (nreverse article-ids))) + (gnus-sorted-nunion gnus-newsgroup-articles article-ids)) (gnus-summary-limit-include-thread id))) (gnus-summary-show-thread)) +(defun gnus-summary-open-group-with-article (message-id) + "Open a group containing the article with the given MESSAGE-ID." + (interactive "sMessage-ID: ") + (require 'nndoc) + (with-temp-buffer + ;; Prepare a dummy article + (erase-buffer) + (insert "From nobody Tue Sep 13 22:05:34 2011\n\n") + + ;; Prepare pretty modelines for summary and article buffers + (let ((gnus-summary-mode-line-format "Found %G") + (gnus-article-mode-line-format + ;; Group names just get in the way here, especially the + ;; abbreviated ones + (if (string-match "%[gG]" gnus-article-mode-line-format) + (concat (substring gnus-article-mode-line-format + 0 (match-beginning 0)) + (substring gnus-article-mode-line-format (match-end 0))) + gnus-article-mode-line-format))) + + ;; Build an ephemeral group containing the dummy article (hidden) + (gnus-group-read-ephemeral-group + message-id + `(nndoc ,message-id + (nndoc-address ,(current-buffer)) + (nndoc-article-type mbox)) + :activate + (cons (current-buffer) gnus-current-window-configuration) + (not :request-only) + '(-1) ; :select-articles + (not :parameters) + 0)) ; :number + ;; Fetch the desired article + (gnus-summary-refer-article message-id))) + (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") @@ -9173,7 +9237,7 @@ To control what happens when you exit the group, see the (list (cons 'save-article-group ogroup)))) (case-fold-search t) (buf (current-buffer)) - dig to-address) + dig to-address charset) (with-current-buffer gnus-original-article-buffer ;; Have the digest group inherit the main mail address of ;; the parent article. @@ -9181,21 +9245,38 @@ To control what happens when you exit the group, see the (gnus-fetch-field "from"))) (setq params (append + params (list (cons 'to-address (funcall gnus-decode-encoded-address-function to-address)))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) (insert-buffer-substring gnus-original-article-buffer) - ;; Remove lines that may lead nndoc to misinterpret the - ;; document type. (narrow-to-region (goto-char (point-min)) (or (search-forward "\n\n" nil t) (point))) + ;; Remove lines that may lead nndoc to misinterpret the + ;; document type. (goto-char (point-min)) (delete-matching-lines "^Path:\\|^From ") + ;; Parse charset, and decode content transfer encoding. + (setq charset (mail-content-type-get + (mail-header-parse-content-type + (or (gnus-fetch-field "content-type") "")) + 'charset)) + (let ((encoding (gnus-fetch-field "content-transfer-encoding"))) + (when encoding + (message-remove-header "content-transfer-encoding") + (goto-char (point-max)) + (widen) + (narrow-to-region (point) (point-max)) + (mm-decode-content-transfer-encoding + (intern (downcase (mail-header-strip encoding)))))) (widen)) (unwind-protect - (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) + (if (let ((gnus-newsgroup-ephemeral-charset + (if charset + (intern (downcase (gnus-strip-whitespace charset))) + gnus-newsgroup-charset)) (gnus-newsgroup-ephemeral-ignored-charsets gnus-newsgroup-ignored-charsets)) (gnus-group-read-ephemeral-group @@ -9257,7 +9338,7 @@ Obeys the standard process/prefix convention." ((gnus-group-read-ephemeral-group (setq vgroup (format "nnvirtual:%s-%s" gnus-newsgroup-name - (format-time-string "%Y%m%dT%H%M%S" (current-time)))) + (format-time-string "%Y%m%dT%H%M%S"))) `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups)) t (cons (current-buffer) 'summary))) @@ -9409,6 +9490,7 @@ Optional argument BACKWARD means do search for backward. ;; Return whether we found the regexp. (when (eq found 'found) (goto-char point) + (sit-for 0) ;; Ensure that the point is visible in the summary window. (gnus-summary-show-thread) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point) @@ -9437,7 +9519,7 @@ be taken into consideration. If NOT-CASE-FOLD, case won't be folded in the comparisons. If NOT-MATCHING, return a list of all articles that not match REGEXP on HEADER." (let ((case-fold-search (not not-case-fold)) - articles d func) + articles func) (if (consp header) (if (eq (car header) 'extra) (setq func @@ -9579,6 +9661,8 @@ to save in." (ps-spool-buffer-with-faces) (ps-spool-buffer))))) +(declare-function gnus-flush-original-article-buffer "gnus-art" ()) + (defun gnus-summary-show-complete-article () "Show a complete version of the current article. This is only useful if you're looking at a partial version of the @@ -9702,6 +9786,12 @@ If ARG is a negative number, turn header display off." t))) (gnus-summary-show-article)) +(declare-function article-narrow-to-head "gnus-art" ()) +(declare-function gnus-article-hidden-text-p "gnus-art" (type)) +(declare-function gnus-delete-wash-type "gnus-art" (type)) +(declare-function gnus-mime-buttonize-attachments-in-header + "gnus-art" (&optional interactive)) + (defun gnus-summary-toggle-header (&optional arg) "Show the headers if they are hidden, or hide them if they are shown. If ARG is a positive number, show the entire header. @@ -9732,7 +9822,10 @@ If ARG is a negative number, hide the unwanted header lines." (gnus-treat-hide-boring-headers nil)) (gnus-delete-wash-type 'headers) (gnus-treat-article 'head)) - (gnus-treat-article 'head)) + (gnus-treat-article 'head) + ;; Add attachment buttons to the header. + (when gnus-mime-display-attachment-buttons-in-header + (gnus-mime-buttonize-attachments-in-header))) (widen) (if window (set-window-start window (goto-char (point-min)))) @@ -9779,9 +9872,12 @@ invalid IDNA string (`xn--bar' is invalid). You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/') installed for this command to work." (interactive "P") - (if (not (and (condition-case nil (require 'idna) - (file-error)) - (mm-coding-system-p 'utf-8) + (if (not (and (mm-coding-system-p 'utf-8) + (condition-case nil + (require 'idna) + (file-error) + (invalid-operation)) + (symbol-value 'idna-program) (executable-find (symbol-value 'idna-program)))) (gnus-message 5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)") @@ -9811,7 +9907,7 @@ installed for this command to work." (when (message-goto-body) (gnus-narrow-to-body)) (goto-char (point-min)) - (while (search-forward "·" (point-max) t) + (while (search-forward "·" (point-max) t) (replace-match ".")) (unmorse-region (point-min) (point-max)) (widen) @@ -10147,17 +10243,20 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-push-marks-to-backend (article) (let ((set nil) + (del nil) (marks gnus-article-mark-lists)) (unless (memq article gnus-newsgroup-unreads) (push 'read set)) (while marks - (when (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) - (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks)))))) - (push (cdar marks) set)) + (if (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) + (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks)))))) + (push (cdar marks) set) + (push (cdar marks) del)) (pop marks)) - (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set))))) + (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set) + ((,article) del ,del))))) (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Copy the current article to some other group. @@ -10354,13 +10453,19 @@ This will be the case if the article has both been mailed and posted." (when (and (not (memq article es)) (gnus-data-find article)) (gnus-summary-mark-article article gnus-canceled-mark) - (run-hook-with-args 'gnus-summary-article-expire-hook - 'delete - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name - nil - nil))))))) + (run-hook-with-args + 'gnus-summary-article-expire-hook + 'delete + (gnus-data-header (assoc article (gnus-data-list nil))) + gnus-newsgroup-name + (cond + ((stringp nnmail-expiry-target) nnmail-expiry-target) + ((eq nnmail-expiry-target 'delete) nil) + (t + (let ((rescall (funcall nnmail-expiry-target + gnus-newsgroup-name))) + (if (stringp rescall) rescall nil)))) + nil))))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -10523,7 +10628,7 @@ groups." (let ((lines (count-lines (point) (point-max))) (length (- (point-max) (point))) (case-fold-search t) - (body (copy-marker (point)))) + (body (point-marker))) (goto-char (point-min)) (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) (delete-region (match-beginning 1) (match-end 1)) @@ -10611,13 +10716,31 @@ groups." ;;; Respooling +(defvar nnimap-split-fancy) +(defvar nnimap-split-methods) + (defun gnus-summary-respool-query (&optional silent trace) "Query where the respool algorithm would put this article." (interactive) (let (gnus-mark-article-hook) (gnus-summary-select-article) (with-current-buffer gnus-original-article-buffer - (let ((groups (nnmail-article-group 'identity trace))) + (let ((groups + (if (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) + 'nnimap) + ;; nnimap has its own splitting variables. + (let ((nnmail-split-methods + (cond + ((eq nnimap-split-methods 'default) + nnmail-split-methods) + (nnimap-split-methods + nnimap-split-methods) + (nnimap-split-fancy + 'nnmail-split-fancy))) + (nnmail-split-fancy (or nnimap-split-fancy + nnmail-split-fancy))) + (nnmail-article-group 'identity trace)) + (nnmail-article-group 'identity trace)))) (unless silent (if groups (message "This message would go to %s" @@ -11574,20 +11697,10 @@ If ARG is positive number, turn showing conversation threads on." (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off")) (gnus-summary-position-point))) -(eval-and-compile - (if (fboundp 'remove-overlays) - (defalias 'gnus-remove-overlays 'remove-overlays) - (defun gnus-remove-overlays (beg end name val) - "Clear BEG and END of overlays whose property NAME has value VAL. -For compatibility with XEmacs." - (dolist (ov (gnus-overlays-in beg end)) - (when (eq (gnus-overlay-get ov name) val) - (gnus-delete-overlay ov)))))) - (defun gnus-summary-show-all-threads () "Show all threads." (interactive) - (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum) + (remove-overlays (point-min) (point-max) 'invisible 'gnus-sum) (gnus-summary-position-point)) (defsubst gnus-summary--inv (p) @@ -11614,7 +11727,7 @@ Returns nil if no thread was there to be shown." 'gnus-sum)))) (point))))) (when eoi - (gnus-remove-overlays beg eoi 'invisible 'gnus-sum) + (remove-overlays beg eoi 'invisible 'gnus-sum) (goto-char orig) (gnus-summary-position-point) eoi))) @@ -11670,10 +11783,10 @@ If PREDICATE is supplied, threads that satisfy this predicate will not be hidden. Returns nil if no threads were there to be hidden." (interactive) + (beginning-of-line) (let ((start (point)) (starteol (line-end-position)) (article (gnus-summary-article-number))) - (goto-char start) ;; Go forward until either the buffer ends or the subthread ends. (when (and (not (eobp)) (or (zerop (gnus-summary-next-thread 1 t)) @@ -11683,10 +11796,10 @@ Returns nil if no threads were there to be hidden." (search-backward "\n" start t)) (progn (when (> (point) starteol) - (gnus-remove-overlays starteol (point) 'invisible 'gnus-sum) - (let ((ol (gnus-make-overlay starteol (point) nil t nil))) - (gnus-overlay-put ol 'invisible 'gnus-sum) - (gnus-overlay-put ol 'evaporate t))) + (remove-overlays starteol (point) 'invisible 'gnus-sum) + (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) (when (> start (point)) (message "Hiding the thread moved us backwards, aborting!") @@ -11985,6 +12098,8 @@ will not be marked as saved." (gnus-set-mode-line 'summary) n)) +(declare-function gnus-summary-save-in-pipe "gnus-art" (&optional command raw)) + (defun gnus-summary-pipe-output (&optional n sym) "Pipe the current article to a subprocess. If N is a positive number, pipe the N next articles. @@ -12438,7 +12553,9 @@ If REVERSE, save parts that do not match TYPE." (not (gnus-ephemeral-group-p (car where)))) (gnus-registry-handle-action (mail-header-id header) nil - (gnus-group-prefixed-name (car where) gnus-override-method) + (gnus-group-prefixed-name + (car where) + (or gnus-override-method (gnus-find-method-for-group group))) (mail-header-subject header) (mail-header-from header))) (when (and (stringp id) @@ -12501,11 +12618,11 @@ If REVERSE, save parts that do not match TYPE." (setq to end)) (if gnus-newsgroup-selected-overlay ;; Move old overlay. - (gnus-move-overlay + (move-overlay gnus-newsgroup-selected-overlay from to (current-buffer)) ;; Create new overlay. - (gnus-overlay-put - (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) + (overlay-put + (setq gnus-newsgroup-selected-overlay (make-overlay from to)) 'face gnus-summary-selected-face)))))) (defvar gnus-summary-highlight-line-cached nil) @@ -12544,7 +12661,7 @@ If REVERSE, save parts that do not match TYPE." (memq article gnus-newsgroup-undownloaded) (not (memq article gnus-newsgroup-cached))))) (let ((face (funcall (gnus-summary-highlight-line-0)))) - (unless (eq face (get-text-property beg 'face)) + (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (gnus-put-text-property-excluding-characters-with-faces beg (point-at-eol) 'face (setq face (if (boundp face) (symbol-value face) face))) @@ -12630,7 +12747,7 @@ UNREAD is a sorted list." (string-match "Summary" buffer) (with-current-buffer buffer ;; We check that this is, indeed, a summary buffer. - (and (eq major-mode 'gnus-summary-mode) + (and (derived-mode-p 'gnus-summary-mode) ;; Also make sure this isn't bogus. gnus-newsgroup-prepared ;; Also make sure that this isn't a @@ -12765,7 +12882,7 @@ returned." (defun gnus-summary-generic-mark (n mark move unread) "Mark N articles with MARK." - (unless (eq major-mode 'gnus-summary-mode) + (unless (derived-mode-p 'gnus-summary-mode) (error "This command can only be used in the summary buffer")) (gnus-summary-show-thread) (let ((nummove @@ -12798,7 +12915,7 @@ returned." (setq gnus-newsgroup-headers (gnus-merge 'list gnus-newsgroup-headers - (gnus-fetch-headers articles) + (gnus-fetch-headers articles nil t) 'gnus-article-sort-by-number)) (setq gnus-newsgroup-articles (gnus-sorted-nunion gnus-newsgroup-articles articles)) @@ -12851,7 +12968,9 @@ 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 (list gnus-newsgroup-active) old)) + (gnus-range-difference + (gnus-range-difference (list gnus-newsgroup-active) old) + gnus-newsgroup-unexist)) (setq len (gnus-range-length older)) (cond ((null older) nil) @@ -12935,6 +13054,7 @@ If ALL is a number, fetch this number of articles." (gnus-summary-position-point)) ;;; Bookmark support for Gnus. +(declare-function gnus-article-show-summary "gnus-art" ()) (declare-function bookmark-make-record-default "bookmark" (&optional no-file no-context posn)) (declare-function bookmark-prop-get "bookmark" (bookmark prop)) @@ -13001,7 +13121,7 @@ BOOKMARK is a bookmark name or a bookmark record." (run-hooks 'gnus-sum-load-hook) ;; Local Variables: -;; coding: iso-8859-1 +;; coding: utf-8 ;; End: ;;; gnus-sum.el ends here