X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=878a96b92648826ff0d874760793e97275e1005d;hp=3b003b74626c79ba290e7105c893229a4d8d313d;hb=992509a3574f9add376cc480db9bb5656285bd5b;hpb=15a4e4b567dca492a30ffb42dc964762e3b3aba9 diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 3b003b746..8d17d1fb1 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-2011 Free Software Foundation, Inc. +;; Copyright (C) 1996-2012 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -118,6 +118,14 @@ 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." + :version "24.1" + :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 @@ -357,7 +365,7 @@ newsgroups, set the variable to nil in `gnus-select-group-hook'." This variable can either be the symbols `first' (place point on the 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 +highest-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 articles have been seen, on the subject line of the first unread article), or a function to be called to @@ -368,7 +376,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. @@ -442,7 +451,8 @@ current article is unread." :group 'gnus-summary-maneuvering :type 'boolean) -(defcustom gnus-auto-center-summary 2 +(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 and non-`vertical', do both horizontal and vertical recentering." @@ -1128,9 +1138,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)) @@ -1234,12 +1244,6 @@ 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 - :type 'boolean - :group 'gnus-summary-marks) - (defcustom gnus-alter-articles-to-read-function nil "Function to be called to alter the list of articles to be selected." :type '(choice (const nil) function) @@ -1362,15 +1366,12 @@ the normal Gnus MIME machinery." (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) (?k (gnus-summary-line-message-size gnus-tmp-header) ?s) (?L gnus-tmp-lines ?s) - (?Z (or ,(gnus-macroexpand-all - '(nnir-article-rsv (mail-header-number gnus-tmp-header))) + (?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header)) 0) ?d) - (?G (or ,(gnus-macroexpand-all - '(nnir-article-group (mail-header-number gnus-tmp-header))) + (?G (or (nnir-article-group (mail-header-number gnus-tmp-header)) "") ?s) - (?g (or ,(gnus-macroexpand-all - '(gnus-group-short-name - (nnir-article-group (mail-header-number gnus-tmp-header)))) + (?g (or (gnus-group-short-name + (nnir-article-group (mail-header-number gnus-tmp-header))) "") ?s) (?O gnus-tmp-downloaded ?c) (?I gnus-tmp-indentation ?s) @@ -1490,9 +1491,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.") @@ -1526,6 +1524,9 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") (defvar gnus-newsgroup-seen nil "Range of seen articles in the current newsgroup.") +(defvar gnus-newsgroup-unexist nil + "Range of unexistent articles in the current newsgroup.") + (defvar gnus-newsgroup-articles nil "List of articles in the current newsgroup.") @@ -1569,11 +1570,11 @@ 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 gnus-newsgroup-seen + gnus-newsgroup-unexist gnus-newsgroup-cached gnus-newsgroup-downloadable gnus-newsgroup-undownloaded @@ -1652,7 +1653,7 @@ For example: This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a -\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups +\(REGEXP . FUNCTION), FUNCTION will be applied only to the newsgroups whose names match REGEXP. For example: @@ -1733,7 +1734,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. @@ -1747,11 +1748,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]*[])}]?[:;] *") @@ -1766,15 +1766,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'." @@ -1915,6 +1916,7 @@ increase the score of each group you read." "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article [tab] gnus-summary-widget-forward + [backtab] gnus-summary-widget-backward "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article @@ -2079,6 +2081,7 @@ increase the score of each group you read." "g" gnus-summary-show-article "s" gnus-summary-isearch-article [tab] gnus-summary-widget-forward + [backtab] gnus-summary-widget-backward "P" gnus-summary-print-article "S" gnus-sticky-article "M" gnus-mailing-list-insinuate @@ -2524,7 +2527,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Unshar and save" gnus-uu-decode-unshar-and-save t] ["Save" gnus-uu-decode-save t] ["Binhex" gnus-uu-decode-binhex t] - ["Postscript" gnus-uu-decode-postscript t] + ["PostScript" gnus-uu-decode-postscript t] ["All MIME parts" gnus-summary-save-parts t]) ("Cache" ["Enter article" gnus-cache-enter-article t] @@ -2830,7 +2833,7 @@ Setter function for custom variables." 'gnus-summary-tool-bar-retro) "Specifies the Gnus summary tool bar. -It can be either a list or a symbol refering to a list. See +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'. @@ -2964,16 +2967,10 @@ When FORCE, rebuild the tool bar." 'gnus-summary-mode-map))) (when map ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode' - ;; uses it's value. + ;; uses its value. (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 @@ -3057,6 +3054,7 @@ When FORCE, rebuild the tool bar." (declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ()) (defvar bookmark-make-record-function) +(defvar bidi-paragraph-direction) (defun gnus-summary-mode (&optional group) "Major mode for reading articles. @@ -3096,6 +3094,9 @@ The following commands are available: (setq buffer-read-only t ;Disable modification show-trailing-whitespace nil) (setq truncate-lines t) + ;; Force paragraph direction to be left-to-right. Don't make it + ;; bound globally in old Emacsen and XEmacsen. + (set (make-local-variable 'bidi-paragraph-direction) 'left-to-right) (add-to-invisibility-spec '(gnus-sum . t)) (gnus-summary-set-display-table) (gnus-set-default-directory) @@ -3255,13 +3256,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)) @@ -3283,14 +3277,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 () @@ -3498,7 +3484,8 @@ display only a single character." (current-buffer)))))) (defun gnus-summary-setup-buffer (group) - "Initialize summary buffer." + "Initialize summary buffer. +If the setup was successful, non-nil is returned." (let ((buffer (gnus-summary-buffer-name group)) (dead-name (concat "*Dead Summary " (gnus-group-decoded-name group) "*"))) @@ -3550,7 +3537,7 @@ buffer that was in action when the last article was fetched." (push (eval (car locals)) vlist)) (setq locals (cdr locals))) (setq vlist (nreverse vlist))) - (with-current-buffer gnus-group-buffer + (with-temp-buffer (setq gnus-newsgroup-name name gnus-newsgroup-marked marked gnus-newsgroup-spam-marked spam @@ -3701,7 +3688,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 @@ -3732,8 +3721,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))) @@ -3852,6 +3839,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." @@ -3878,7 +3913,11 @@ This function is intended to be used in "Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. If NO-ARTICLE is non-nil, no article is selected initially. -If NO-DISPLAY, don't generate a summary buffer." +If NO-DISPLAY, don't generate the summary buffer contents. +If KILL-BUFFER, it should be a buffer that's killed once the new +summary buffer has been generated. +If BACKWARD, move point to the previous group in the group buffer +If SELECT-ARTICLES, only select those articles from GROUP." (let (result) (while (and group (null (setq result @@ -3908,7 +3947,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)) @@ -4017,6 +4056,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) @@ -4026,7 +4066,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) @@ -4049,7 +4088,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 () @@ -4204,7 +4243,7 @@ If NO-DISPLAY, don't generate a summary buffer." result)) (defun gnus-sort-gathered-threads (threads) - "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'." + "Sort subthreads inside each gathered thread by `gnus-sort-gathered-threads-function'." (let ((result threads)) (while threads (when (stringp (caar threads)) @@ -4674,7 +4713,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) @@ -5336,8 +5375,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)) @@ -5461,12 +5498,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) @@ -5487,7 +5529,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 @@ -5504,7 +5546,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. @@ -5620,7 +5662,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) - (gnus-set-global-variables) + (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. (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) @@ -5658,11 +5702,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*")) @@ -5743,13 +5787,13 @@ 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 + (gnus-list-range-difference ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. (if (or read-all @@ -5773,9 +5817,11 @@ 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))) + gnus-newsgroup-unreads)) + (cdr (assq 'unexist (gnus-info-marks (gnus-get-info group)))))) (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) (scored (length scored-list)) (number (length articles)) @@ -5796,16 +5842,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)) @@ -5813,7 +5868,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))) @@ -5854,17 +5910,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)) @@ -5892,7 +5937,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq mark (car marks) mark-type (gnus-article-mark-to-type mark) var (intern (format "gnus-newsgroup-%s" (car (rassq mark types))))) - ;; We set the variable according to the type of the marks list, ;; and then adjust the marks to a subset of the active articles. (cond @@ -5947,7 +5991,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (and (numberp (car articles)) (> min (car articles))))) (pop articles)) - (set var articles)))))))) + (set var articles)) + ((eq mark 'unexist) + (set var (cdr marks))))))))) (defun gnus-update-missing-marks (missing) "Go through the list of MISSING articles and remove them from the mark lists." @@ -6003,14 +6049,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)))) @@ -6203,13 +6257,18 @@ The resulting hash table is returned, or nil if no Xrefs were found." (entry (gnus-group-entry group)) (info (nth 2 entry)) (active (gnus-active group)) + (set-marks + (gnus-method-option-p + (gnus-find-method-for-group group) + 'server-marks)) range) (if (not entry) ;; Group that Gnus doesn't know exists, but still allow the ;; backend to set marks. - (gnus-request-set-mark - group (list (list (gnus-compress-sequence (sort articles #'<)) - 'add '(read)))) + (when set-marks + (gnus-request-set-mark + group (list (list (gnus-compress-sequence (sort articles #'<)) + 'add '(read))))) ;; Normal, subscribed groups. (setq range (gnus-compute-read-articles group articles)) (with-current-buffer gnus-group-buffer @@ -6218,11 +6277,14 @@ The resulting hash table is returned, or nil if no Xrefs were found." (gnus-info-set-marks ',info ',(gnus-info-marks info) t) (gnus-info-set-read ',info ',(gnus-info-read info)) (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-request-set-mark ,group (list (list ',range 'del '(read)))) + (when ,set-marks + (gnus-request-set-mark + ,group (list (list ',range 'del '(read))))) (gnus-group-update-group ,group t)))) ;; Add the read articles to the range. (gnus-info-set-read info range) - (gnus-request-set-mark group (list (list range 'add '(read)))) + (when set-marks + (gnus-request-set-mark group (list (list range 'add '(read))))) ;; Then we have to re-compute how many unread ;; articles there are in this group. (when active @@ -6488,7 +6550,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) @@ -6515,9 +6580,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 @@ -6533,9 +6597,9 @@ the subject line on." ;; article if ID is a number -- so that the next `P' or `N' ;; command will fetch the previous (or next) article even ;; if the one we tried to fetch this time has been canceled. - (when (> number gnus-newsgroup-end) + (unless (and gnus-newsgroup-end (< number gnus-newsgroup-end)) (setq gnus-newsgroup-end number)) - (when (< number gnus-newsgroup-begin) + (unless (and gnus-newsgroup-begin (> number gnus-newsgroup-begin)) (setq gnus-newsgroup-begin number)) (setq gnus-newsgroup-unselected (delq number gnus-newsgroup-unselected))) @@ -6963,7 +7027,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)) @@ -7011,7 +7075,7 @@ With ARG, turn line truncation on if ARG is positive." (defun gnus-summary-find-for-reselect () "Return the number of an article to stay on across a reselect. The current article is considered, then following articles, then previous -articles. An article is sought which is not cancelled and isn't a temporary +articles. An article is sought which is not canceled and isn't a temporary insertion from another group. If there's no such then return a dummy 0." (let (found) (dolist (rev '(nil t)) @@ -7067,7 +7131,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)) @@ -7087,8 +7156,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. @@ -7118,9 +7191,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 @@ -7146,7 +7225,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-summary-update-info)) (gnus-close-group group) ;; Make sure where we were, and go to next newsgroup. - (set-buffer gnus-group-buffer) + (when (buffer-live-p (get-buffer gnus-group-buffer)) + (set-buffer gnus-group-buffer)) (unless quit-config (gnus-group-jump-to-group group)) (gnus-run-hooks 'gnus-summary-exit-hook) @@ -7170,18 +7250,9 @@ 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) + (when (gnus-buffer-live-p gnus-group-buffer) + (set-buffer gnus-group-buffer)) (if quit-config (gnus-handle-ephemeral-exit quit-config) (goto-char group-point) @@ -7191,6 +7262,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))))) @@ -7210,6 +7292,8 @@ 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. (setq gnus-article-mime-handle-alist nil) @@ -7219,8 +7303,12 @@ 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. (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) + (progn + (gnus-deaden-summary) + (gnus-configure-windows 'group 'force)) + (gnus-configure-windows 'group 'force) (gnus-close-group group) (gnus-kill-buffer gnus-summary-buffer)) (unless gnus-single-article-buffer @@ -7230,12 +7318,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 @@ -7244,9 +7330,13 @@ If FORCE (the prefix), also save the .newsrc file(s)." (defun gnus-handle-ephemeral-exit (quit-config) "Handle movement when leaving an ephemeral group. The state which existed when entering the ephemeral is reset." - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) + (if (not (buffer-live-p (car quit-config))) + (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) (gnus-set-global-variables)) ((eq major-mode 'gnus-article-mode) @@ -7640,10 +7730,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. @@ -7681,6 +7767,7 @@ 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) @@ -7705,6 +7792,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)))))))) @@ -8111,9 +8203,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)) @@ -8519,6 +8619,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 () @@ -8855,12 +8957,32 @@ 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* ((header (gnus-summary-article-header)) @@ -8868,35 +8990,53 @@ variable." (gnus-inhibit-demon t) (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 header) - (let* ((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))) - 'gnus-article-sort-by-number)) - (gnus-summary-limit-include-thread id))) + (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))) + (gnus-summary-show-thread)) (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 " " "")) @@ -8955,7 +9095,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. @@ -9100,6 +9245,17 @@ With optional ARG, move across that many fields." (select-window (gnus-get-buffer-window gnus-article-buffer)) (widget-forward arg)) +(defun gnus-summary-widget-backward (arg) + "Move point to the previous field or button in the article. +With optional ARG, move across that many fields." + (interactive "p") + (gnus-summary-select-article) + (gnus-configure-windows 'article) + (select-window (gnus-get-buffer-window gnus-article-buffer)) + (unless (widget-at (point)) + (goto-char (point-max))) + (widget-backward arg)) + (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." @@ -9466,9 +9622,13 @@ C-u g', show the raw article." (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)) + (if (eq mm-text-html-renderer 'shr) + (progn + (require 'shr) + (let ((shr-ignore-cache t)) + (gnus-summary-select-article nil 'force))) + (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))) @@ -9486,6 +9646,8 @@ 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) + (gnus-stop-downloads) (mm-destroy-parts gnus-article-mime-handles) ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) @@ -9903,14 +10065,19 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-add-marked-articles to-group 'expire (list to-article) info)) - (when to-marks + (when (and to-marks + (gnus-method-option-p + (gnus-find-method-for-group to-group) + 'server-marks)) (gnus-request-set-mark to-group (list (list (list to-article) 'add to-marks))))) (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. @@ -10115,16 +10282,19 @@ This will be the case if the article has both been mailed and posted." 'request-expire-articles gnus-newsgroup-name)) ;; This backend supports expiry. (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) - (expirable (if total - (progn - ;; We need to update the info for - ;; this group for `gnus-list-of-read-articles' - ;; to give us the right answer. - (gnus-run-hooks 'gnus-exit-group-hook) - (gnus-summary-update-info) - (gnus-list-of-read-articles gnus-newsgroup-name)) - (setq gnus-newsgroup-expirable - (sort gnus-newsgroup-expirable '<)))) + (expirable + (gnus-list-range-difference + (if total + (progn + ;; We need to update the info for + ;; this group for `gnus-list-of-read-articles' + ;; to give us the right answer. + (gnus-run-hooks 'gnus-exit-group-hook) + (gnus-summary-update-info) + (gnus-list-of-read-articles gnus-newsgroup-name)) + (setq gnus-newsgroup-expirable + (sort gnus-newsgroup-expirable '<))) + gnus-newsgroup-unexist)) (expiry-wait (if now 'immediate (gnus-group-find-parameter gnus-newsgroup-name 'expiry-wait))) @@ -10136,34 +10306,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 () @@ -10734,6 +10903,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) + (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (cond ((= mark gnus-ticked-mark) (setq gnus-newsgroup-marked (gnus-add-to-sorted-list gnus-newsgroup-marked @@ -10828,8 +10998,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)) @@ -11408,6 +11576,7 @@ Returns nil if no thread was there to be shown." (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point))))) (eoi (when end (if (fboundp 'next-single-char-property-change) + ;; Note: XEmacs version of n-s-c-p-c may return nil (or (next-single-char-property-change end 'invisible) (point-max)) (while (progn @@ -11454,8 +11623,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))) @@ -11486,7 +11659,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)))) @@ -11759,7 +11935,7 @@ will not be marked as saved." ;; This is a pseudo-article. (if (assq 'name header) (gnus-copy-file (cdr (assq 'name header))) - (gnus-message 1 "Article %d is unsaveable" article)) + (gnus-message 1 "Article %d is unsavable" article)) ;; This is a real article. (save-window-excursion (gnus-summary-select-article decode decode nil article) @@ -12037,9 +12213,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) @@ -12072,10 +12248,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)))) @@ -12233,6 +12406,13 @@ If REVERSE, save parts that do not match TYPE." (not (setq header (car (gnus-get-newsgroup-headers nil t))))) () ; Malformed head. (unless (gnus-summary-article-sparse-p (mail-header-number header)) + (when (and (bound-and-true-p gnus-registry-enabled) + (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) + (mail-header-subject header) + (mail-header-from header))) (when (and (stringp id) (or (not (string= (gnus-group-real-name group) @@ -12380,7 +12560,9 @@ UNREAD is a sorted list." (save-excursion (let (setmarkundo) ;; Propagate the read marks to the backend. - (when (and gnus-propagate-marks + (when (and (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)))) @@ -12430,12 +12612,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." @@ -12586,6 +12772,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)) @@ -12612,8 +12800,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 @@ -12636,7 +12823,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) @@ -12670,9 +12859,9 @@ If ALL is a number, fetch this number of articles." (gnus-group-decoded-name gnus-newsgroup-name) (if initial "max" "default") len) - (if initial - (cons (number-to-string initial) - 0))))) + nil nil + (and initial + (number-to-string initial))))) (unless (string-match "^[ \t]*$" input) (setq all (string-to-number input)) (if (< all len) @@ -12698,26 +12887,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