X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=6ffc5d9e821e669b1391bbb865dd086366a3cd0e;hp=1bb4b4a689542f6325ad66101538115e07e47420;hb=cc4fc0c3aad0be9553b18e499ceb2218a21051e0;hpb=ed0fcec0be558d957ca96b427fd054f490acf079 diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 1bb4b4a68..6ffc5d9e8 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,7 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996-2011 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -119,6 +118,13 @@ If t, fetch all the available old headers." :type '(choice number (sexp :menu-tag "other" t))) +(defcustom gnus-refer-thread-use-nnir nil + "*Use nnir to search an entire server when referring threads. A +nil value will only search for thread-related articles in the +current group." + :group 'gnus-thread + :type 'boolean) + (defcustom gnus-summary-make-false-root 'adopt "*nil means that Gnus won't gather loose threads. If the root of a thread has expired or been read in a previous @@ -360,7 +366,7 @@ first subject), `unread' (place point on the subject line of the first unread article), `best' (place point on the subject line of the higest-scored article), `unseen' (place point on the subject line of the first unseen article), `unseen-or-unread' (place point on the subject -line of the first unseen article or, if all article have been seen, on the +line of the first unseen article or, if all articles have been seen, on the subject line of the first unread article), or a function to be called to place point on some subject line." :version "24.1" @@ -369,7 +375,8 @@ place point on some subject line." (const unread) (const first) (const unseen) - (const unseen-or-unread))) + (const unseen-or-unread) + (function :tag "Function to call"))) (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. @@ -1129,9 +1136,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 Newsgroups) +(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups) "*Extra headers to parse." - :version "21.1" + :version "24.1" ; added Cc Keywords Gcc :group 'gnus-summary :type '(repeat symbol)) @@ -1235,9 +1242,10 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :type 'boolean :group 'gnus-summary-marks) -(defcustom gnus-propagate-marks t - "If non-nil, do not propagate marks to the backends." - :version "23.1" ;; No Gnus +(defcustom gnus-propagate-marks nil + "If non-nil, Gnus will store and retrieve marks from the backends. +This means that marks will be stored both in .newsrc.eld and in +the backend, and will slow operation down somewhat." :type 'boolean :group 'gnus-summary-marks) @@ -1491,9 +1499,6 @@ the type of the variable (string, integer, character, etc).") (defvar gnus-newsgroup-forwarded nil "List of articles that have been forwarded in the current newsgroup.") -(defvar gnus-newsgroup-recent nil - "List of articles that have are recent in the current newsgroup.") - (defvar gnus-newsgroup-expirable nil "Sorted list of articles in the current newsgroup that can be expired.") @@ -1570,7 +1575,6 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-forwarded - gnus-newsgroup-recent gnus-newsgroup-expirable gnus-newsgroup-killed gnus-newsgroup-unseen @@ -1734,7 +1738,7 @@ If RE-ONLY is non-nil, strip leading `Re:'s only." (while (re-search-forward regexp nil t) (replace-match (or newtext "")))) -(defun gnus-simplify-buffer-fuzzy () +(defun gnus-simplify-buffer-fuzzy (regexp) "Simplify string in the buffer fuzzily. The string in the accessible portion of the current buffer is simplified. It is assumed to be a single-line subject. @@ -1748,11 +1752,10 @@ matter is removed. Additional things can be deleted by setting (while (not (eq modified-tick (buffer-modified-tick))) (setq modified-tick (buffer-modified-tick)) (cond - ((listp gnus-simplify-subject-fuzzy-regexp) - (mapc 'gnus-simplify-buffer-fuzzy-step - gnus-simplify-subject-fuzzy-regexp)) - (gnus-simplify-subject-fuzzy-regexp - (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp))) + ((listp regexp) + (mapc 'gnus-simplify-buffer-fuzzy-step regexp)) + (regexp + (gnus-simplify-buffer-fuzzy-step regexp))) (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") (gnus-simplify-buffer-fuzzy-step "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") @@ -1767,15 +1770,16 @@ matter is removed. Additional things can be deleted by setting "Simplify a subject string fuzzily. See `gnus-simplify-buffer-fuzzy' for details." (save-excursion - (gnus-set-work-buffer) - (let ((case-fold-search t)) - ;; Remove uninteresting prefixes. - (when (and gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - (insert subject) - (inline (gnus-simplify-buffer-fuzzy)) - (buffer-string)))) + (let ((regexp gnus-simplify-subject-fuzzy-regexp)) + (gnus-set-work-buffer) + (let ((case-fold-search t)) + ;; Remove uninteresting prefixes. + (when (and gnus-simplify-ignored-prefixes + (string-match gnus-simplify-ignored-prefixes subject)) + (setq subject (substring subject (match-end 0)))) + (insert subject) + (inline (gnus-simplify-buffer-fuzzy regexp)) + (buffer-string))))) (defsubst gnus-simplify-subject-fully (subject) "Simplify a subject string according to `gnus-summary-gather-subject-limit'." @@ -3702,7 +3706,9 @@ buffer that was in action when the last article was fetched." gnus-newsgroup-name)) 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) - (inline (gnus-summary-extract-address-component gnus-tmp-from))))) + (gnus-string-mark-left-to-right + (inline + (gnus-summary-extract-address-component gnus-tmp-from)))))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current @@ -3733,8 +3739,6 @@ buffer that was in action when the last article was fetched." gnus-forwarded-mark) ((memq gnus-tmp-current gnus-newsgroup-saved) gnus-saved-mark) - ((memq gnus-tmp-number gnus-newsgroup-recent) - gnus-recent-mark) ((memq gnus-tmp-number gnus-newsgroup-unseen) gnus-unseen-mark) (t gnus-no-mark))) @@ -3853,6 +3857,54 @@ This function is intended to be used in ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024)))) (t (format "%dM" (/ c (* 1024.0 1024))))))) +(defcustom gnus-user-date-format-alist + '(((gnus-seconds-today) . "Today, %H:%M") + ((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M") + (604800 . "%A %H:%M") ; That's one week + ((gnus-seconds-month) . "%A %d") + ((gnus-seconds-year) . "%B %d") + (t . "%b %d %Y")) ; This one is used when no other + ; does match + "Specifies date format depending on age of article. +This is an alist of items (AGE . FORMAT). AGE can be a number (of +seconds) or a Lisp expression evaluating to a number. When the age of +the article is less than this number, then use `format-time-string' +with the corresponding FORMAT for displaying the date of the article. +If AGE is not a number or a Lisp expression evaluating to a +non-number, then the corresponding FORMAT is used as a default value. + +Note that the list is processed from the beginning, so it should be +sorted by ascending AGE. Also note that items following the first +non-number AGE will be ignored. + +You can use the functions `gnus-seconds-today', `gnus-seconds-month' +and `gnus-seconds-year' in the AGE spec. They return the number of +seconds passed since the start of today, of this month, of this year, +respectively." + :version "24.1" + :group 'gnus-summary-format + :type '(alist :key-type sexp :value-type string)) + +(defun gnus-user-date (messy-date) + "Format the messy-date according to `gnus-user-date-format-alist'. +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-float-time (gnus-date-get-time messy-date))) + (now (gnus-float-time)) + ;;If we don't find something suitable we'll use this one + (my-format "%b %d '%y")) + (let* ((difference (- now messy-date)) + (templist gnus-user-date-format-alist) + (top (eval (caar templist)))) + (while (if (numberp top) (< top difference) (not top)) + (progn + (setq templist (cdr templist)) + (setq top (eval (caar templist))))) + (if (stringp (cdr (car templist))) + (setq my-format (cdr (car templist))))) + (format-time-string (eval my-format) (seconds-to-time messy-date))) + (error " ? "))) (defun gnus-summary-set-local-parameters (group) "Go through the local params of GROUP and set all variable specs in that list." @@ -3909,7 +3961,7 @@ If NO-DISPLAY, don't generate a summary buffer." ;; (when (and (not (gnus-group-native-p group)) ;; (not (gnus-gethash group gnus-newsrc-hashtb))) ;; (error "Dead non-native groups can't be entered")) - (gnus-message 5 "Retrieving newsgroup: %s..." + (gnus-message 7 "Retrieving newsgroup: %s..." (gnus-group-decoded-name group)) (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) @@ -3940,11 +3992,9 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1)) (gnus-handle-ephemeral-exit quit-config))) - (let ((grpinfo (gnus-get-info group))) - (if (null (gnus-info-read grpinfo)) - (gnus-message 3 "Group %s contains no messages" - (gnus-group-decoded-name group)) - (gnus-message 3 "Can't select group"))) + (if (null (gnus-list-of-unread-articles group)) + (gnus-message 3 "Group %s contains no messages" group) + (gnus-message 3 "Can't select group")) nil) ;; The user did a `C-g' while prompting for number of articles, ;; so we exit this group. @@ -4020,6 +4070,7 @@ If NO-DISPLAY, don't generate a summary buffer." ;; gnus-summary-prepare-hook since kill processing may not ;; work with hidden articles. (gnus-summary-maybe-hide-threads) + (gnus-configure-windows 'summary) (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) (gnus-summary-auto-select-subject) @@ -4029,7 +4080,6 @@ If NO-DISPLAY, don't generate a summary buffer." gnus-newsgroup-unreads gnus-auto-select-first) (progn - (gnus-configure-windows 'summary) (let ((art (gnus-summary-article-number))) (unless (and (not gnus-plugged) (or (memq art gnus-newsgroup-undownloaded) @@ -4052,7 +4102,7 @@ If NO-DISPLAY, don't generate a summary buffer." (setq gnus-newsgroup-prepared t) (gnus-run-hooks 'gnus-summary-prepared-hook) (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group)) + (gnus-group-update-group group nil t)) t))))) (defun gnus-summary-auto-select-subject () @@ -4677,7 +4727,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (car headers)))) (defun gnus-parent-headers (in-headers &optional generation) - "Return the headers of the GENERATIONeth parent of HEADERS." + "Return the headers of the GENERATIONth parent of HEADERS." (unless generation (setq generation 1)) (let ((parent t) @@ -5339,8 +5389,6 @@ or a straight list of headers." gnus-forwarded-mark) ((memq number gnus-newsgroup-saved) gnus-saved-mark) - ((memq number gnus-newsgroup-recent) - gnus-recent-mark) ((memq number gnus-newsgroup-unseen) gnus-unseen-mark) (t gnus-no-mark)) @@ -5464,12 +5512,17 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) +(defun gnus-group-get-list-identifiers (group) + "Get list identifier regexp for GROUP." + (or (gnus-parameter-list-identifier group) + (if (consp gnus-list-identifiers) + (mapconcat 'identity gnus-list-identifiers " *\\|") + gnus-list-identifiers))) + (defun gnus-summary-remove-list-identifiers () "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." - (let ((regexp (if (consp gnus-list-identifiers) - (mapconcat 'identity gnus-list-identifiers " *\\|") - gnus-list-identifiers)) - changed subject) + (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) + changed subject) (when regexp (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)")) (dolist (header gnus-newsgroup-headers) @@ -5490,7 +5543,7 @@ or a straight list of headers." (defun gnus-fetch-headers (articles &optional limit force-new dependencies) "Fetch headers of ARTICLES." (let ((name (gnus-group-decoded-name gnus-newsgroup-name))) - (gnus-message 5 "Fetching headers for %s..." name) + (gnus-message 7 "Fetching headers for %s..." name) (prog1 (if (eq 'nov (setq gnus-headers-retrieved-by @@ -5507,7 +5560,7 @@ or a straight list of headers." (gnus-get-newsgroup-headers-xover articles force-new dependencies gnus-newsgroup-name t) (gnus-get-newsgroup-headers dependencies force-new)) - (gnus-message 5 "Fetching headers for %s...done" name)))) + (gnus-message 7 "Fetching headers for %s...done" name)))) (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. @@ -5545,7 +5598,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (mm-decode-coding-string group charset) (mm-decode-coding-string (gnus-status-message group) charset))) - (when gnus-agent + (when (and gnus-agent + (gnus-active group)) (gnus-agent-possibly-alter-active group (gnus-active group) info) (setq gnus-summary-use-undownloaded-faces @@ -5603,7 +5657,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq gnus-newsgroup-processable nil) - (gnus-update-read-articles group gnus-newsgroup-unreads) + (gnus-update-read-articles group gnus-newsgroup-unreads t) ;; Adjust and set lists of article marks. (when info @@ -5660,11 +5714,11 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when gnus-agent (gnus-agent-get-undownloaded-list)) ;; Remove list identifiers from subject - (when gnus-list-identifiers - (gnus-summary-remove-list-identifiers)) + (gnus-summary-remove-list-identifiers) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire - (gnus-group-auto-expirable-p group)) + (and (gnus-group-auto-expirable-p group) + (not (gnus-group-read-only-p group)))) ;; Set up the article buffer now, if necessary. (unless (and gnus-single-article-buffer (equal gnus-article-buffer "*Article*")) @@ -5745,13 +5799,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." (memq article gnus-newsgroup-forwarded)) ((eq type 'seen) (not (memq article gnus-newsgroup-unseen))) - ((eq type 'recent) - (memq article gnus-newsgroup-recent)) (t t)))) (defun gnus-articles-to-read (group &optional read-all) "Find out what articles the user wants to read." - (let* ((articles + (let* ((only-read-p t) + (articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. (if (or read-all @@ -5775,6 +5828,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-uncompress-range (gnus-active group))) (gnus-cache-articles-in-group group)) ;; Select only the "normal" subset of articles. + (setq only-read-p nil) (gnus-sorted-nunion (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked) gnus-newsgroup-unreads))) @@ -5798,16 +5852,25 @@ If SELECT-ARTICLES, only select those articles from GROUP." (let* ((cursor-in-echo-area nil) (initial (gnus-parameter-large-newsgroup-initial gnus-newsgroup-name)) + (default (if only-read-p + (or initial gnus-large-newsgroup) + number)) (input (read-string - (format - "How many articles from %s (%s %d): " - (gnus-group-decoded-name gnus-newsgroup-name) - (if initial "max" "default") - number) - (if initial - (cons (number-to-string initial) - 0))))) + (if only-read-p + (format + "How many articles from %s (available %d, default %d): " + (gnus-group-decoded-name + (gnus-group-real-name gnus-newsgroup-name)) + number default) + (format + "How many articles from %s (%d default): " + (gnus-group-decoded-name + (gnus-group-real-name gnus-newsgroup-name)) + default)) + nil + nil + (number-to-string default)))) (if (string-match "^[ \t]*$" input) number input))) ((and (> scored marked) (< scored number) (> (- scored number) 20)) @@ -5815,7 +5878,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (read-string (format "%s %s (%d scored, %d total): " "How many articles from" - (gnus-group-decoded-name group) + (gnus-group-decoded-name + (gnus-group-real-name gnus-newsgroup-name)) scored number)))) (if (string-match "^[ \t]*$" input) number input))) @@ -6005,14 +6069,22 @@ If SELECT-ARTICLES, only select those articles from GROUP." 'request-set-mark gnus-newsgroup-name) (not (gnus-article-unpropagatable-p (cdr type)))) (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (del (gnus-remove-from-range (gnus-copy-sequence old) list)) - (add (gnus-remove-from-range - (gnus-copy-sequence list) old))) + ;; Don't do anything about marks for articles we + ;; didn't actually get any headers for. + (del + (gnus-list-range-intersection + gnus-newsgroup-articles + (gnus-remove-from-range (gnus-copy-sequence old) list))) + (add + (gnus-list-range-intersection + gnus-newsgroup-articles + (gnus-remove-from-range + (gnus-copy-sequence 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. + ;; Don't delete marks from outside the active range. + ;; This shouldn't happen, but is a sanity check. (setq del (gnus-sorted-range-intersection (gnus-active gnus-newsgroup-name) del)) (push (list del 'del (list (cdr type))) delta-marks)))) @@ -6490,7 +6562,10 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (defun gnus-summary-insert-subject (id &optional old-header use-old-header) "Find article ID and insert the summary line for that article. OLD-HEADER can either be a header or a line number to insert -the subject line on." +the subject line on. +If USE-OLD-HEADER is non-nil, then OLD-HEADER should be a header, +and OLD-HEADER will be used when the summary line is inserted, +too, instead of trying to fetch new headers." (let* ((line (and (numberp old-header) old-header)) (old-header (and (vectorp old-header) old-header)) (header (cond ((and old-header use-old-header) @@ -6517,9 +6592,8 @@ the subject line on." (1+ (point-at-eol)) (gnus-delete-line)))))) ;; Remove list identifiers from subject. - (when gnus-list-identifiers - (let ((gnus-newsgroup-headers (list header))) - (gnus-summary-remove-list-identifiers))) + (let ((gnus-newsgroup-headers (list header))) + (gnus-summary-remove-list-identifiers)) (when old-header (mail-header-set-number header (mail-header-number old-header))) (setq gnus-newsgroup-sparse @@ -6965,7 +7039,7 @@ displayed, no centering will be performed." (defun gnus-summary-select-article-buffer () "Reconfigure windows to show the article buffer. -If `gnus-widen-article-buffer' is set, show only the article +If `gnus-widen-article-window' is set, show only the article buffer." (interactive) (if (not (gnus-buffer-live-p gnus-article-buffer)) @@ -7069,7 +7143,12 @@ The prefix argument ALL means to select all articles." t))) (unless (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) - (let ((headers gnus-newsgroup-headers)) + (let ((headers gnus-newsgroup-headers) + (ephemeral-p (gnus-ephemeral-group-p group)) + info) + (unless ephemeral-p + (setq info (copy-sequence (gnus-get-info group)) + info (delq (gnus-info-params info) info))) ;; Set the new ranges of read articles. (with-current-buffer gnus-group-buffer (gnus-undo-force-boundary)) @@ -7089,8 +7168,12 @@ The prefix argument ALL means to select all articles." (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) - (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group))))))) + (unless ephemeral-p + (gnus-group-update-group + group nil + (equal info + (setq info (copy-sequence (gnus-get-info group)) + info (delq (gnus-info-params info) info)))))))))) (defun gnus-summary-save-newsrc (&optional force) "Save the current number of read/marked articles in the dribble buffer. @@ -7120,9 +7203,15 @@ If FORCE (the prefix), also save the .newsrc file(s)." (let* ((group gnus-newsgroup-name) (quit-config (gnus-group-quit-config gnus-newsgroup-name)) (gnus-group-is-exiting-p t) + (article-buffer gnus-article-buffer) + (original-article-buffer gnus-original-article-buffer) (mode major-mode) (group-point nil) - (buf (current-buffer))) + (buf (current-buffer)) + ;; `gnus-single-article-buffer' is nil buffer-locally in + ;; ephemeral group of which summary buffer will be killed, + ;; but the global value may be non-nil. + (single-article-buffer gnus-single-article-buffer)) (unless quit-config ;; Do adaptive scoring, and possibly save score files. (when gnus-newsgroup-adaptive @@ -7172,16 +7261,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (when (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - ;; Don't kill sticky article buffers - (unless (eq major-mode 'gnus-sticky-article-mode) - (gnus-kill-buffer gnus-article-buffer) - (setq gnus-article-current nil)))) - (gnus-kill-buffer gnus-original-article-buffer)) - (setq gnus-current-select-method gnus-select-method) (set-buffer gnus-group-buffer) (if quit-config @@ -7193,6 +7272,17 @@ If FORCE (the prefix), also save the .newsrc file(s)." (if win (set-window-point win (point)))) (unless leave-hidden (gnus-configure-windows 'group 'force))) + + ;; If we have several article buffers, we kill them at exit. + (unless single-article-buffer + (when (gnus-buffer-live-p article-buffer) + (with-current-buffer article-buffer + ;; Don't kill sticky article buffers + (unless (eq major-mode 'gnus-sticky-article-mode) + (gnus-kill-buffer article-buffer) + (setq gnus-article-current nil)))) + (gnus-kill-buffer original-article-buffer)) + ;; Clear the current group name. (unless quit-config (setq gnus-newsgroup-name nil))))) @@ -7212,6 +7302,7 @@ 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) (mm-destroy-parts gnus-article-mime-handles) ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) @@ -7221,6 +7312,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-kill-buffer gnus-article-buffer) (gnus-kill-buffer gnus-original-article-buffer) (setq gnus-article-current nil)) + ;; Return to the group buffer. + (gnus-configure-windows 'group 'force) (if (not gnus-kill-summary-on-exit) (gnus-deaden-summary) (gnus-close-group group) @@ -7232,12 +7325,10 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-async-prefetch-remove-group group) (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) - ;; Return to the group buffer. - (gnus-configure-windows 'group 'force) ;; Clear the current group name. (setq gnus-newsgroup-name nil) (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group)) + (gnus-group-update-group group nil t)) (when (equal (gnus-group-group-name) group) (gnus-group-next-unread-group 1)) (when quit-config @@ -7249,6 +7340,9 @@ The state which existed when entering the ephemeral is reset." (if (not (buffer-name (car quit-config))) (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) (gnus-set-global-variables)) ((eq major-mode 'gnus-article-mode) @@ -7683,13 +7777,11 @@ If BACKWARD, the previous article is selected instead of the next." (point (with-current-buffer gnus-group-buffer (point))) + (current-summary (current-buffer)) (group (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) - ;; For some reason, the group window gets selected. We change - ;; it back. - (select-window (get-buffer-window (current-buffer))) ;; Select next unread newsgroup automagically. (cond ((or (not gnus-auto-select-next) @@ -7710,6 +7802,11 @@ If BACKWARD, the previous article is selected instead of the next." (gnus-summary-next-group nil group backward))) (t (when (gnus-key-press-event-p last-input-event) + ;; Somehow or other, we may now have selected a different + ;; window. Make point go back to the summary buffer. + (when (eq current-summary (current-buffer)) + ;; FIXME: This burps when get-buffer-window returns nil. + (select-window (get-buffer-window current-summary 0))) (gnus-summary-walk-group-buffer gnus-newsgroup-name cmd unread backward point)))))))) @@ -8524,6 +8621,8 @@ fetched for this group." 'list gnus-newsgroup-headers (gnus-fetch-headers articles nil t) 'gnus-article-sort-by-number)) + (setq gnus-newsgroup-articles + (gnus-sorted-nunion gnus-newsgroup-articles articles)) (gnus-summary-limit (append articles gnus-newsgroup-limit)))) (defun gnus-summary-limit-exclude-dormant () @@ -8860,51 +8959,85 @@ Return the number of articles fetched." (gnus-summary-position-point) n))) +(defun gnus-delete-duplicate-headers (headers) + ;; First remove leading duplicates. + (while (and (> (length headers) 1) + (= (mail-header-number (car headers)) + (mail-header-number (cadr headers)))) + (pop headers)) + ;; Then the rest. + (let ((result headers)) + (while (> (length headers) 1) + (if (= (mail-header-number (car headers)) + (mail-header-number (cadr headers))) + (setcdr headers (cddr headers)) + (pop headers))) + result)) + (defun gnus-summary-refer-thread (&optional limit) - "Fetch all articles in the current thread. -If no backend-specific 'request-thread function is available -fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil -fetch what's specified by the `gnus-refer-thread-limit' -variable." + "Fetch all articles in the current thread. For backends that +know how to search for threads (currently only 'nnimap) a +non-numeric prefix arg will use nnir to search the entire +server; without a prefix arg only the current group is +searched. If the variable `gnus-refer-thread-use-nnir' is +non-nil the prefix arg has the reverse meaning. If no +backend-specific 'request-thread function is available fetch +LIMIT (the numerical prefix) old headers. If LIMIT is +non-numeric or nil fetch the number specified by the +`gnus-refer-thread-limit' variable." (interactive "P") (gnus-warp-to-article) - (let ((id (mail-header-id (gnus-summary-article-header))) - (gnus-inhibit-demon t) - (gnus-agent nil) - (gnus-summary-ignore-duplicates t) - (gnus-read-all-available-headers t) - (limit (if limit (prefix-numeric-value limit) - gnus-refer-thread-limit))) - (setq gnus-newsgroup-headers - (gnus-merge - 'list gnus-newsgroup-headers - (if (gnus-check-backend-function - 'request-thread gnus-newsgroup-name) - (gnus-request-thread (gnus-summary-article-header)) - (let* ((last (if (numberp limit) - (min (+ (mail-header-number - (gnus-summary-article-header)) - limit) - gnus-newsgroup-highest) - gnus-newsgroup-highest)) - (subject (gnus-simplify-subject - (mail-header-subject - (gnus-summary-article-header)))) - (refs (split-string (or (mail-header-references - (gnus-summary-article-header)) - ""))) - (gnus-parse-headers-hook - (lambda () (goto-char (point-min)) - (keep-lines - (regexp-opt (append refs (list id subject))))))) - (gnus-fetch-headers (list last) (if (numberp limit) - (* 2 limit) limit) t))) - 'gnus-article-sort-by-number)) - (gnus-summary-limit-include-thread id))) + (let* ((header (gnus-summary-article-header)) + (id (mail-header-id header)) + (gnus-inhibit-demon t) + (gnus-summary-ignore-duplicates t) + (gnus-read-all-available-headers t) + (gnus-refer-thread-use-nnir + (if (and (not (null limit)) (listp limit)) + (not gnus-refer-thread-use-nnir) gnus-refer-thread-use-nnir)) + (new-headers + (if (gnus-check-backend-function + 'request-thread gnus-newsgroup-name) + (gnus-request-thread header gnus-newsgroup-name) + (let* ((limit (if (numberp limit) (prefix-numeric-value limit) + gnus-refer-thread-limit)) + (last (if (numberp limit) + (min (+ (mail-header-number header) + limit) + gnus-newsgroup-highest) + gnus-newsgroup-highest)) + (subject (gnus-simplify-subject + (mail-header-subject header))) + (refs (split-string (or (mail-header-references header) + ""))) + (gnus-parse-headers-hook + `(lambda () (goto-char (point-min)) + (keep-lines + (regexp-opt ',(append refs (list id subject))))))) + (gnus-fetch-headers (list last) (if (numberp limit) + (* 2 limit) limit) t)))) + article-ids) + (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)))) + (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-summary-limit-include-thread id)))) (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") + (gnus-warp-to-article) (when (and (stringp message-id) (not (zerop (length message-id)))) (setq message-id (gnus-replace-in-string message-id " " "")) @@ -8963,7 +9096,12 @@ variable." (dolist (method gnus-refer-article-method) (push (if (eq 'current method) gnus-current-select-method - method) + (if (eq 'nnir (car method)) + (list + 'nnir + (or (cadr method) + (gnus-method-to-server gnus-current-select-method))) + method)) out)) (nreverse out))) ;; One single select method. @@ -8982,8 +9120,11 @@ variable." (defun gnus-summary-enter-digest-group (&optional force) "Enter an nndoc group based on the current article. -If FORCE, force a digest interpretation. If not, try -to guess what the document format is." +If FORCE, force a digest interpretation. If not, try to guess +what the document format is. + +To control what happens when you exit the group, see the +`gnus-auto-select-on-ephemeral-exit' variable." (interactive "P") (let ((conf gnus-current-window-configuration)) (save-window-excursion @@ -9470,10 +9611,11 @@ C-u g', show the raw article." (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t) (gnus-summary-update-secondary-mark (cdr gnus-article-current)))))) ((not arg) - ;; Select the article the normal way. - (gnus-summary-select-article nil 'force)) - ((or (equal arg '(16)) - (eq arg t)) + (require 'shr) + (let ((shr-ignore-cache t)) + ;; Select the article the normal way. + (gnus-summary-select-article nil 'force))) + ((equal arg '(16)) ;; C-u C-u g (let ((gnus-inhibit-article-treatments t)) (gnus-summary-select-article nil 'force))) @@ -9491,6 +9633,7 @@ C-u g', show the raw article." ;; Destroy any MIME parts. (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer + (gnus-article-stop-animations) (mm-destroy-parts gnus-article-mime-handles) ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) @@ -9839,7 +9982,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (unless (member to-group to-groups) (push to-group to-groups)) - (unless (memq article gnus-newsgroup-unreads) + (when (and (not (memq article gnus-newsgroup-unreads)) + (cdr art-group)) (push 'read to-marks) (gnus-info-set-read info (gnus-add-to-range (gnus-info-read info) @@ -9856,14 +10000,16 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;; Enter the article into the cache in the new group, ;; if that is required. - (when gnus-use-cache + (when (and to-article + gnus-use-cache) (gnus-cache-possibly-enter-article to-group to-article (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) - (when gnus-preserve-marks + (when (and gnus-preserve-marks + to-article) ;; Copy any marks over to the new group. (when (and (equal to-group gnus-newsgroup-name) (not (memq article gnus-newsgroup-unreads))) @@ -9912,7 +10058,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-dribble-enter (concat "(gnus-group-set-info '" (gnus-prin1-to-string (gnus-get-info to-group)) - ")")))) + ")") + (concat "^(gnus-group-set-info '(\"" + (regexp-quote to-group) "\"")))) ;; Update the Xref header in this article to point to ;; the new crossposted article we have just created. @@ -9955,7 +10103,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-push-marks-to-backend (article) (let ((set nil) (marks gnus-article-mark-lists)) - (when (memq article gnus-newsgroup-unreads) + (unless (memq article gnus-newsgroup-unreads) (push 'read set)) (while marks (when (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) @@ -10138,34 +10286,33 @@ This will be the case if the article has both been mailed and posted." ;; There are expirable articles in this group, so we run them ;; through the expiry process. (gnus-message 6 "Expiring articles...") - (unless (gnus-check-group gnus-newsgroup-name) - (error "Can't open server for %s" gnus-newsgroup-name)) - ;; The list of articles that weren't expired is returned. - (save-excursion - (if expiry-wait - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (unless total - (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (dolist (article expirable) - (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)))))) + (when (gnus-check-group gnus-newsgroup-name) + ;; The list of articles that weren't expired is returned. + (save-excursion + (if expiry-wait + (let ((nnmail-expiry-wait-function nil) + (nnmail-expiry-wait expiry-wait)) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name))) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name))) + (unless total + (setq gnus-newsgroup-expirable es)) + ;; We go through the old list of expirable, and mark all + ;; really expired articles as nonexistent. + (unless (eq es expirable) ;If nothing was expired, we don't mark. + (let ((gnus-use-cache nil)) + (dolist (article expirable) + (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))))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -10830,8 +10977,6 @@ If NO-EXPIRE, auto-expiry will be inhibited." gnus-forwarded-mark) ((memq article gnus-newsgroup-saved) gnus-saved-mark) - ((memq article gnus-newsgroup-recent) - gnus-recent-mark) ((memq article gnus-newsgroup-unseen) gnus-unseen-mark) (t gnus-no-mark)) @@ -11456,8 +11601,12 @@ will not be hidden." (interactive) (save-excursion (goto-char (point-min)) - (let ((end nil)) + (let ((end nil) + (count 0)) (while (not end) + (incf count) + (when (zerop (mod count 1000)) + (message "Hiding all threads... %d" count)) (when (or (not predicate) (gnus-map-articles predicate (gnus-summary-article-children))) @@ -11488,7 +11637,10 @@ Returns nil if no threads were there to be hidden." (let ((ol (gnus-make-overlay starteol (point) nil t nil))) (gnus-overlay-put ol 'invisible 'gnus-sum) (gnus-overlay-put ol 'evaporate t))) - (gnus-summary-goto-subject article)) + (gnus-summary-goto-subject article) + (when (> start (point)) + (message "Hiding the thread moved us backwards, aborting!") + (goto-char (point-max)))) (goto-char start) nil)))) @@ -12039,9 +12191,9 @@ If REVERSE, save parts that do not match TYPE." gnus-summary-save-parts-default-mime) 'gnus-summary-save-parts-type-history) (setq gnus-summary-save-parts-last-directory - (read-file-name "Save to directory: " - gnus-summary-save-parts-last-directory - nil t)) + (read-directory-name "Save to directory: " + gnus-summary-save-parts-last-directory + nil t)) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) @@ -12074,10 +12226,7 @@ If REVERSE, save parts that do not match TYPE." mm-file-name-rewrite-functions (file-name-nondirectory (or - (mail-content-type-get - (mm-handle-disposition handle) 'filename) - (mail-content-type-get - (mm-handle-type handle) 'name) + (mm-handle-filename handle) (format "%s.%d.%d" gnus-newsgroup-name (cdr gnus-article-current) gnus-summary-save-parts-counter)))) @@ -12382,7 +12531,10 @@ UNREAD is a sorted list." (save-excursion (let (setmarkundo) ;; Propagate the read marks to the backend. - (when (and gnus-propagate-marks + (when (and (or gnus-propagate-marks + (gnus-method-option-p + (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)))) @@ -12432,12 +12584,16 @@ UNREAD is a sorted list." ;; Go through all these summary buffers and offer to save them. (when buffers (save-excursion - (map-y-or-n-p - "Update summary buffer %s? " - (lambda (buf) - (switch-to-buffer buf) - (gnus-summary-exit)) - buffers))))) + (if (eq gnus-interactive-exit 'quiet) + (dolist (buffer buffers) + (switch-to-buffer buffer) + (gnus-summary-exit)) + (map-y-or-n-p + "Update summary buffer %s? " + (lambda (buf) + (switch-to-buffer buf) + (gnus-summary-exit)) + buffers)))))) (defun gnus-summary-setup-default-charset () "Setup newsgroup default charset." @@ -12588,6 +12744,8 @@ returned." gnus-newsgroup-headers (gnus-fetch-headers articles) 'gnus-article-sort-by-number)) + (setq gnus-newsgroup-articles + (gnus-sorted-nunion gnus-newsgroup-articles articles)) ;; Suppress duplicates? (when gnus-suppress-duplicates (gnus-dup-suppress-articles)) @@ -12614,8 +12772,7 @@ returned." (when gnus-agent (gnus-agent-get-undownloaded-list)) ;; Remove list identifiers from subject - (when gnus-list-identifiers - (gnus-summary-remove-list-identifiers)) + (gnus-summary-remove-list-identifiers) ;; First and last article in this newsgroup. (when gnus-newsgroup-headers (setq gnus-newsgroup-begin @@ -12700,26 +12857,26 @@ If ALL is a number, fetch this number of articles." (defun gnus-summary-insert-new-articles () "Insert all new articles in this group." (interactive) - (prog1 - (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) - (old-high gnus-newsgroup-highest) - (nnmail-fetched-sources (list t)) - i new) - (setq gnus-newsgroup-active - (gnus-copy-sequence - (gnus-activate-group gnus-newsgroup-name 'scan))) - (setq i (cdr gnus-newsgroup-active) - gnus-newsgroup-highest i) - (while (> i old-high) - (push i new) - (decf i)) - (if (not new) - (message "No gnus is bad news") - (gnus-summary-insert-articles new) - (setq gnus-newsgroup-unreads - (gnus-sorted-nunion gnus-newsgroup-unreads new)) - (gnus-summary-limit (gnus-sorted-nunion old new)))) - (gnus-summary-position-point))) + (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) + (old-high gnus-newsgroup-highest) + (nnmail-fetched-sources (list t)) + (new-active (gnus-activate-group gnus-newsgroup-name 'scan)) + i new) + (unless new-active + (error "Couldn't fetch new data")) + (setq gnus-newsgroup-active (gnus-copy-sequence new-active)) + (setq i (cdr gnus-newsgroup-active) + gnus-newsgroup-highest i) + (while (> i old-high) + (push i new) + (decf i)) + (if (not new) + (message "No gnus is bad news") + (gnus-summary-insert-articles new) + (setq gnus-newsgroup-unreads + (gnus-sorted-nunion gnus-newsgroup-unreads new)) + (gnus-summary-limit (gnus-sorted-nunion old new)))) + (gnus-summary-position-point)) ;;; Bookmark support for Gnus. (declare-function bookmark-make-record-default