X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=31d99d9bf3f594faf2c858f0b5874178c6e138c0;hb=027a90912122f2cb3e36d82310f32962e3ce2f71;hp=8ef602df032dc00fa0fa22a1bb73ccf14b0b14df;hpb=30d9f23f0291edcefeca1958befadb992d2982b5;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 8ef602d..31d99d9 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -168,10 +168,13 @@ This variable will only be used if the value of :type 'string) (defcustom gnus-summary-goto-unread t - "*If t, marking commands will go to the next unread article. + "*If t, many commands will go to the next unread article. +This applies to marking commands as well as other commands that +\"naturally\" select the next article, like, for instance, `SPC' at +the end of an article. +If nil, only the marking commands will go to the next (un)read article. If `never', commands that usually go to the next unread article, will -go to the next article, whether it is read or not. -If nil, only the marking commands will go to the next (un)read article." +go to the next article, whether it is read or not." :group 'gnus-summary-marks :link '(custom-manual "(gnus)Setting Marks") :type '(choice (const :tag "off" nil) @@ -345,7 +348,7 @@ It uses the same syntax as the `gnus-split-methods' variable." (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) -(defcustom gnus-unread-mark ? ;Whitespace +(defcustom gnus-unread-mark ? ;Whitespace "*Mark used for unread articles." :group 'gnus-summary-marks :type 'character) @@ -460,7 +463,7 @@ It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-empty-thread-mark ? ;Whitespace +(defcustom gnus-empty-thread-mark ? ;Whitespace "*There is no thread under the article." :group 'gnus-summary-marks :type 'character) @@ -542,6 +545,15 @@ with some simple extensions: :group 'gnus-summary-format :type 'string) +(defcustom gnus-list-identifiers nil + "Regexp that matches list identifiers to be removed from subject. +This can also be a list of regexps." + :group 'gnus-summary-format + :group 'gnus-article-hiding + :type '(choice (const :tag "none" nil) + (regexp :value ".*") + (repeat :value (".*") regexp))) + (defcustom gnus-summary-mark-below 0 "*Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the @@ -801,10 +813,14 @@ which it may alter in any way.") '(("^hk\\>\\|^tw\\>\\|\\" cn-big5) ("^cn\\>\\|\\" cn-gb-2312) ("^fj\\>\\|^japan\\>" iso-2022-jp-2) + ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit) ("^relcom\\>" koi8-r) + ("^fido7\\>" koi8-r) ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2) ("^israel\\>" iso-8859-1) ("^han\\>" euc-kr) + ("^alt.chinese.text.big5\\>" chinese-big5) + ("^soc.culture.vietnamese\\>" vietnamese-viqr) ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1) (".*" iso-8859-1)) "Alist of regexps (to match group names) and default charsets to be used when reading." @@ -812,13 +828,48 @@ which it may alter in any way.") (symbol :tag "Charset"))) :group 'gnus-charset) -(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit) +(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown) "List of charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the default charset will be used instead." :type '(repeat symbol) :group 'gnus-charset) +(defcustom gnus-group-ignored-charsets-alist + '(("alt\\.chinese\\.text" iso-8859-1)) + "Alist of regexps (to match group names) and charsets that should be ignored. +When these charsets are used in the \"charset\" parameter, the +default charset will be used instead." + :type '(repeat (cons (regexp :tag "Group") + (repeat symbol))) + :group 'gnus-charset) + +(defcustom gnus-group-highlight-words-alist nil + "Alist of group regexps and highlight regexps. +This variable uses the same syntax as `gnus-emphasis-alist'." + :type '(repeat (cons (regexp :tag "Group") + (repeat (list (regexp :tag "Highlight regexp") + (number :tag "Group for entire word" 0) + (number :tag "Group for displayed part" 0) + (symbol :tag "Face" + gnus-emphasis-highlight-words))))) + :group 'gnus-summary-visual) + +(defcustom gnus-summary-show-article-charset-alist + nil + "Alist of number and charset. +The article will be shown with the charset corresponding to the +numbered argument. +For example: ((1 . cn-gb-2312) (2 . big5))." + :type '(repeat (cons (number :tag "Argument" 1) + (symbol :tag "Charset"))) + :group 'gnus-charset) + +(defcustom gnus-preserve-marks t + "Whether marks are preserved when moving, copying and respooling messages." + :type 'boolean + :group 'gnus-summary-marks) + ;;; Internal variables (defvar gnus-article-mime-handles nil) @@ -833,6 +884,8 @@ default charset will be used instead." (defvar gnus-thread-indent-array nil) (defvar gnus-thread-indent-array-level gnus-thread-indent-level) +(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number + "Function called to sort the articles within a thread after it has been gathered together.") ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) @@ -1008,6 +1061,8 @@ variable (string, integer, character, etc).") (defvar gnus-last-article nil) (defvar gnus-newsgroup-history nil) (defvar gnus-newsgroup-charset nil) +(defvar gnus-newsgroup-ephemeral-charset nil) +(defvar gnus-newsgroup-ephemeral-ignored-charsets nil) (defconst gnus-summary-local-variables '(gnus-newsgroup-name @@ -1053,8 +1108,8 @@ variable (string, integer, character, etc).") '(mail-decode-encoded-word-string) "List of methods used to decode encoded words. -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 +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 whose names match REGEXP. @@ -1072,13 +1127,13 @@ For example: (eq gnus-newsgroup-name (car gnus-decode-encoded-word-methods-cache))) (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name)) - (mapc '(lambda (x) - (if (symbolp x) - (nconc gnus-decode-encoded-word-methods-cache (list x)) - (if (and gnus-newsgroup-name - (string-match (car x) gnus-newsgroup-name)) - (nconc gnus-decode-encoded-word-methods-cache - (list (cdr x)))))) + (mapcar (lambda (x) + (if (symbolp x) + (nconc gnus-decode-encoded-word-methods-cache (list x)) + (if (and gnus-newsgroup-name + (string-match (car x) gnus-newsgroup-name)) + (nconc gnus-decode-encoded-word-methods-cache + (list (cdr x)))))) gnus-decode-encoded-word-methods)) (let ((xlist gnus-decode-encoded-word-methods-cache)) (pop xlist) @@ -1134,7 +1189,7 @@ If RE-ONLY is non-nil, strip leading `Re:'s only." (defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (replace-match (or newtext "")))) + (replace-match (or newtext "")))) (defun gnus-simplify-buffer-fuzzy () "Simplify string in the buffer fuzzily. @@ -1314,7 +1369,7 @@ increase the score of each group you read." "\C-d" gnus-summary-enter-digest-group "\M-\C-d" gnus-summary-read-document "\M-\C-e" gnus-summary-edit-parameters - "\M-\C-g" gnus-summary-customize-parameters + "\M-\C-a" gnus-summary-customize-parameters "\C-c\C-b" gnus-bug "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article @@ -1376,6 +1431,7 @@ increase the score of each group you read." "T" gnus-summary-limit-include-thread "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age + "x" gnus-summary-limit-to-extra "E" gnus-summary-limit-include-expunged "c" gnus-summary-limit-exclude-childless-dormant "C" gnus-summary-limit-mark-excluded-as-read) @@ -1446,11 +1502,13 @@ increase the score of each group you read." "e" gnus-summary-end-of-article "^" gnus-summary-refer-parent-article "r" gnus-summary-refer-parent-article + "D" gnus-summary-enter-digest-group "R" gnus-summary-refer-references "T" gnus-summary-refer-thread "g" gnus-summary-show-article "s" gnus-summary-isearch-article - "P" gnus-summary-print-article) + "P" gnus-summary-print-article + "t" gnus-article-babel) (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) "b" gnus-article-add-buttons @@ -1467,7 +1525,6 @@ increase the score of each group you read." "r" gnus-summary-caesar-message "t" gnus-article-hide-headers "v" gnus-summary-verbose-headers - "h" gnus-article-treat-html "H" gnus-article-strip-headers-in-body "d" gnus-article-treat-dumbquotes) @@ -1478,6 +1535,7 @@ increase the score of each group you read." "s" gnus-article-hide-signature "c" gnus-article-hide-citation "C" gnus-article-hide-citation-in-followups + "l" gnus-article-hide-list-identifiers "p" gnus-article-hide-pgp "B" gnus-article-strip-banner "P" gnus-article-hide-pem @@ -1525,6 +1583,7 @@ increase the score of each group you read." "\M-\C-e" gnus-summary-expire-articles-now "\177" gnus-summary-delete-article [delete] gnus-summary-delete-article + [backspace] gnus-summary-delete-article "m" gnus-summary-move-article "r" gnus-summary-respool-article "w" gnus-summary-edit-article @@ -1555,8 +1614,7 @@ increase the score of each group you read." "c" gnus-article-copy-part "e" gnus-article-externalize-part "i" gnus-article-inline-part - "|" gnus-article-pipe-part) - ) + "|" gnus-article-pipe-part)) (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1599,6 +1657,7 @@ increase the score of each group you read." ["Headers" gnus-article-hide-headers t] ["Signature" gnus-article-hide-signature t] ["Citation" gnus-article-hide-citation t] + ["List identifiers" gnus-article-hide-list-identifiers t] ["PGP" gnus-article-hide-pgp t] ["Banner" gnus-article-strip-banner t] ["Boring headers" gnus-article-hide-boring-headers t]) @@ -1637,14 +1696,14 @@ increase the score of each group you read." ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] ["Quoted-Printable" gnus-article-de-quoted-unreadable t] - ["UnHTMLize" gnus-article-treat-html t] ["Rot 13" gnus-summary-caesar-message t] ["Unix pipe" gnus-summary-pipe-message t] ["Add buttons" gnus-article-add-buttons t] ["Add buttons to head" gnus-article-add-buttons-to-head t] ["Stop page breaking" gnus-summary-stop-page-breaking t] ["Verbose header" gnus-summary-verbose-headers t] - ["Toggle header" gnus-summary-toggle-header t]) + ["Toggle header" gnus-summary-toggle-header t] + ["HZ" gnus-article-decode-HZ t]) ("Output" ["Save in default format" gnus-summary-save-article t] ["Save in file" gnus-summary-save-article-file t] @@ -1688,6 +1747,7 @@ increase the score of each group you read." ("Cache" ["Enter article" gnus-cache-enter-article t] ["Remove article" gnus-cache-remove-article t]) + ["Translate" gnus-article-babel t] ["Select article buffer" gnus-summary-select-article-buffer t] ["Enter digest buffer" gnus-summary-enter-digest-group t] ["Isearch article..." gnus-summary-isearch-article t] @@ -1722,8 +1782,7 @@ increase the score of each group you read." ["Mark thread as read" gnus-summary-kill-thread t] ["Lower thread score" gnus-summary-lower-thread t] ["Raise thread score" gnus-summary-raise-thread t] - ["Rethread current" gnus-summary-rethread-current t] - )) + ["Rethread current" gnus-summary-rethread-current t])) (easy-menu-define gnus-summary-post-menu gnus-summary-mode-map "" @@ -1778,6 +1837,7 @@ increase the score of each group you read." ["Subject..." gnus-summary-limit-to-subject t] ["Author..." gnus-summary-limit-to-author t] ["Age..." gnus-summary-limit-to-age t] + ["Extra..." gnus-summary-limit-to-extra t] ["Score" gnus-summary-limit-to-score t] ["Unread" gnus-summary-limit-to-unread t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] @@ -1945,7 +2005,8 @@ increase the score of each group you read." (list 'gnus-summary-header (nth 1 header))) (list 'quote (nth 1 (car ts))) - (list 'gnus-score-default nil) + (list 'gnus-score-delta-default + nil) (nth 1 (car ps)) t) t) @@ -2513,7 +2574,10 @@ marks of articles." (defun gnus-summary-from-or-to-or-newsgroups (header) (let ((to (cdr (assq 'To (mail-header-extra header)))) (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header)))) - (mail-parse-charset gnus-newsgroup-charset)) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (save-excursion (set-buffer gnus-summary-buffer) + gnus-newsgroup-ignored-charsets))) (cond ((and to gnus-ignored-from-addresses @@ -2547,7 +2611,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ? ;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) (gnus-tmp-replied @@ -2612,7 +2676,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ? ;Whitespace (if (< score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) 'score)) @@ -2763,6 +2827,7 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-summary-set-local-parameters gnus-newsgroup-name) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) + (gnus-update-summary-mark-positions) ;; Do score processing. (when gnus-use-scoring (gnus-possibly-score-headers)) @@ -2775,6 +2840,7 @@ If NO-DISPLAY, don't generate a summary buffer." (let ((gnus-newsgroup-dormant nil)) (gnus-summary-initial-limit show-all)) (gnus-summary-initial-limit show-all)) + ;; When untreaded, all articles are always shown. (setq gnus-newsgroup-limit (mapcar (lambda (header) (mail-header-number header)) @@ -2978,7 +3044,7 @@ If NO-DISPLAY, don't generate a summary buffer." (while threads (when (stringp (caar threads)) (setcdr (car threads) - (sort (cdar threads) 'gnus-thread-sort-by-number))) + (sort (cdar threads) gnus-sort-gathered-threads-function))) (setq threads (cdr threads))) result)) @@ -3113,6 +3179,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) + (mail-parse-charset gnus-newsgroup-charset) (gnus-summary-ignore-duplicates t) header references generation relations subject child end new-child date) @@ -3165,7 +3232,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; fetch the headers for the articles that aren't there. This will ;; build complete threads - if the roots haven't been expired by the ;; server, that is. - (let (id heads) + (let ((mail-parse-charset gnus-newsgroup-charset) + id heads) (mapatoms (lambda (refs) (when (not (car (symbol-value refs))) @@ -3196,19 +3264,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header (make-full-mail-header - number ; number + number ; number (funcall gnus-decode-encoded-word-function (nnheader-nov-field)) ; subject (funcall gnus-decode-encoded-word-function (nnheader-nov-field)) ; from - (nnheader-nov-field) ; date + (nnheader-nov-field) ; date (nnheader-nov-read-message-id) ; id - (nnheader-nov-field) ; refs - (nnheader-nov-read-integer) ; chars - (nnheader-nov-read-integer) ; lines + (nnheader-nov-field) ; refs + (nnheader-nov-read-integer) ; chars + (nnheader-nov-read-integer) ; lines (unless (eobp) - (nnheader-nov-field)) ; misc - (nnheader-nov-parse-extra)))) ; extra + (nnheader-nov-field)) ; misc + (nnheader-nov-parse-extra)))) ; extra (widen)) @@ -3254,6 +3322,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-build-all-threads () "Read all the headers." (let ((gnus-summary-ignore-duplicates t) + (mail-parse-charset gnus-newsgroup-charset) (dependencies gnus-newsgroup-dependencies) header article) (save-excursion @@ -3263,8 +3332,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (while (not (eobp)) (ignore-errors (setq article (read (current-buffer)) - header (gnus-nov-parse-line - article dependencies))) + header (gnus-nov-parse-line article dependencies))) (when header (save-excursion (set-buffer gnus-summary-buffer) @@ -3570,7 +3638,7 @@ If LINE, insert the rebuilt thread starting on line LINE." ;; using some other form will lead to serious barfage. (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; + (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" (vector thread) 2)) (defsubst gnus-article-sort-by-number (h1 h2) @@ -3897,7 +3965,7 @@ or a straight list of headers." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ? ;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) gnus-tmp-replied @@ -3981,6 +4049,20 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) +(defun gnus-summary-remove-list-identifiers () + "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." + (let ((regexp (if (stringp gnus-list-identifiers) + gnus-list-identifiers + (mapconcat 'identity gnus-list-identifiers " *\\|")))) + (dolist (header gnus-newsgroup-headers) + (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)") + (mail-header-subject header)) + (mail-header-set-subject + header (concat (substring (mail-header-subject header) + 0 (match-beginning 2)) + (substring (mail-header-subject header) + (match-end 2)))))))) + (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. If READ-ALL is non-nil, all articles in the group are selected. @@ -4100,6 +4182,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Let the Gnus agent mark articles as read. (when gnus-agent (gnus-agent-get-undownloaded-list)) + ;; Remove list identifiers from subject + (when gnus-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)) @@ -4126,7 +4211,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (zerop (length gnus-newsgroup-unreads))) (eq (gnus-group-find-parameter group 'display) 'all)) - (gnus-uncompress-range (gnus-active group)) + (or + (gnus-uncompress-range (gnus-active group)) + (gnus-cache-articles-in-group group)) (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked (copy-sequence gnus-newsgroup-unreads)) '<))) @@ -4264,13 +4351,14 @@ If SELECT-ARTICLES, only select those articles from GROUP." (uncompressed '(score bookmark killed)) type list newmarked symbol delta-marks) (when info - ;; Add all marks lists that are non-nil to the list of marks lists. + ;; Add all marks lists to the list of marks lists. (while (setq type (pop types)) - (when (setq list (symbol-value - (setq symbol - (intern (format "gnus-newsgroup-%s" - (car type)))))) + (setq list (symbol-value + (setq symbol + (intern (format "gnus-newsgroup-%s" + (car type)))))) + (when list ;; Get rid of the entries of the articles that have the ;; default score. (when (and (eq (cdr type) 'score) @@ -4285,27 +4373,27 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr prev (cdr arts)) (setq prev arts)) (setq arts (cdr arts))) - (setq list (cdr all)))) - - (when (gnus-check-backend-function 'request-set-mark - gnus-newsgroup-name) - ;; uncompressed:s are not proper flags (they are cons cells) - ;; cache is a internal gnus flag - (unless (memq (cdr type) (cons 'cache uncompressed)) - (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (list (gnus-compress-sequence (sort list '<))) - (del (gnus-remove-from-range old list)) - (add (gnus-remove-from-range list old))) - (if add - (push (list add 'add (list (cdr type))) delta-marks)) - (if del - (push (list del 'del (list (cdr type))) delta-marks))))) + (setq list (cdr all))))) + + (unless (memq (cdr type) uncompressed) + (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) + + (when (gnus-check-backend-function + 'request-set-mark gnus-newsgroup-name) + ;; uncompressed:s are not proper flags (they are cons cells) + ;; cache is a internal gnus flag + (unless (memq (cdr type) (cons 'cache uncompressed)) + (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))) + (when add + (push (list add 'add (list (cdr type))) delta-marks)) + (when del + (push (list del 'del (list (cdr type))) delta-marks))))) - (push (cons (cdr type) - (if (memq (cdr type) uncompressed) list - (gnus-compress-sequence - (set symbol (sort list '<)) t))) - newmarked))) + (when list + (push (cons (cdr type) list) newmarked))) (when delta-marks (unless (gnus-check-group gnus-newsgroup-name) @@ -4538,7 +4626,12 @@ The resulting hash table is returned, or nil if no Xrefs were found." (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-dependencies))) headers id end ref - (mail-parse-charset gnus-newsgroup-charset)) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (save-excursion (condition-case nil + (set-buffer gnus-summary-buffer) + (error)) + gnus-newsgroup-ignored-charsets))) (save-excursion (set-buffer nntp-server-buffer) ;; Translate all TAB characters into SPACE characters. @@ -4692,6 +4785,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; NNTP servers do not include Xrefs when using XOVER. (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) (cur nntp-server-buffer) (dependencies (or dependencies gnus-newsgroup-dependencies)) number headers header) @@ -4751,7 +4845,8 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (save-restriction (nnheader-narrow-to-headers) (goto-char (point-min)) - (when (or (and (eq (downcase (char-after)) ?x) + (when (or (and (not (eobp)) + (eq (downcase (char-after)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) @@ -4868,7 +4963,8 @@ executed with point over the summary line of the articles." `(let ((,articles (gnus-summary-work-articles ,arg))) (while ,articles (gnus-summary-goto-subject (car ,articles)) - ,@forms)))) + ,@forms + (pop ,articles))))) (put 'gnus-summary-iterate 'lisp-indent-function 1) (put 'gnus-summary-iterate 'edebug-form-spec '(form body)) @@ -5032,7 +5128,8 @@ displayed, no centering will be performed." ;; whichever is the least. (set-window-start window (min bottom (save-excursion - (forward-line (- top)) (point))))) + (forward-line (- top)) (point))) + t)) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) (not (eq gnus-auto-center-summary 'vertical))) @@ -5072,7 +5169,10 @@ displayed, no centering will be performed." ;; If the range of read articles is a single range, then the ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? - (if (not (listp (cdr read))) + (if (and (not (listp (cdr read))) + (or (< (car read) (car active)) + (progn (setq read (list read)) + nil))) (setq first (max (car active) (1+ (cdr read)))) ;; `read' is a list of ranges. (when (/= (setq nlast (or (and (numberp (car read)) (car read)) @@ -5129,8 +5229,7 @@ displayed, no centering will be performed." (key-binding (read-key-sequence (substitute-command-keys - "\\\\[gnus-summary-universal-argument]" - )))) + "\\\\[gnus-summary-universal-argument]")))) 'undefined) (gnus-error 1 "Undefined key") (save-excursion @@ -5226,7 +5325,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. -gnus-exit-group-hook is called with no arguments if that value is non-nil." +`gnus-exit-group-hook' is called with no arguments if that value is non-nil." (interactive) (gnus-set-global-variables) (when (gnus-buffer-live-p gnus-article-buffer) @@ -5259,6 +5358,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-dup-enter-articles)) (when gnus-use-trees (gnus-tree-close group)) + (when gnus-use-cache + (gnus-cache-write-active)) ;; Remove entries for this group. (nnmail-purge-split-history (gnus-group-real-name group)) ;; Make all changes in this group permanent. @@ -5324,7 +5425,7 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-async-halt-prefetch) (mapcar 'funcall (delq 'gnus-summary-expire-articles - (copy-list gnus-summary-prepare-exit-hook))) + (copy-sequence gnus-summary-prepare-exit-hook))) (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) @@ -5603,8 +5704,8 @@ returned." (if backward (gnus-summary-find-prev unread) (gnus-summary-find-next unread))) - (gnus-summary-show-thread) - (setq n (1- n))) + (unless (zerop (setq n (1- n))) + (gnus-summary-show-thread))) (when (/= 0 n) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) @@ -6137,7 +6238,21 @@ If given a prefix, remove all limits." "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to articles that are younger than AGE days." - (interactive "nTime in days: \nP") + (interactive + (let ((younger current-prefix-arg) + (days-got nil) + days) + (while (not days-got) + (setq days (if younger + (read-string "Limit to articles within (in days): ") + (read-string "Limit to articles old than (in days): "))) + (when (> (length days) 0) + (setq days (read days))) + (if (numberp days) + (setq days-got t) + (message "Please enter a number.") + (sleep-for 1))) + (list days younger))) (prog1 (let ((data gnus-newsgroup-data) (cutoff (days-to-time age)) @@ -6146,7 +6261,9 @@ articles that are younger than AGE days." (when (and (vectorp (gnus-data-header d)) (setq date (mail-header-date (gnus-data-header d)))) (setq is-younger (time-less-p - (time-since (date-to-time date)) + (time-since (condition-case () + (date-to-time date) + (error '(0 0)))) cutoff)) (when (if younger-p is-younger @@ -6155,6 +6272,30 @@ articles that are younger than AGE days." (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) +(defun gnus-summary-limit-to-extra (header regexp) + "Limit the summary buffer to articles that match an 'extra' header." + (interactive + (let ((header + (intern + (gnus-completing-read + (symbol-name (car gnus-extra-headers)) + "Limit extra header:" + (mapcar (lambda (x) + (cons (symbol-name x) x)) + gnus-extra-headers) + nil + t)))) + (list header + (read-string (format "Limit to header %s (regexp): " header))))) + (when (not (equal "" regexp)) + (prog1 + (let ((articles (gnus-summary-find-matching + (cons 'extra header) regexp 'all))) + (unless articles + (error "Found no matches for \"%s\"" regexp)) + (gnus-summary-limit articles)) + (gnus-summary-position-point)))) + (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) (make-obsolete 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) @@ -6352,6 +6493,7 @@ If ALL, mark even excluded ticked and dormants as read." "Go forwards in the thread until we find an article that we want to display." (when (or (eq gnus-fetch-old-headers 'some) (eq gnus-fetch-old-headers 'invisible) + (numberp gnus-fetch-old-headers) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) ;; Deal with old-fetched headers and sparse threads. @@ -6381,6 +6523,7 @@ If ALL, mark even excluded ticked and dormants as read." "Cut off all uninteresting articles from the beginning of threads." (when (or (eq gnus-fetch-old-headers 'some) (eq gnus-fetch-old-headers 'invisible) + (numberp gnus-fetch-old-headers) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) (let ((th threads)) @@ -6398,6 +6541,7 @@ fetch-old-headers verbiage, and so on." (if (or gnus-inhibit-limiting (and (null gnus-newsgroup-dormant) (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers)) (not (eq gnus-fetch-old-headers 'invisible)) (null gnus-summary-expunge-below) (not (eq gnus-build-sparse-threads 'some)) @@ -6451,7 +6595,8 @@ fetch-old-headers verbiage, and so on." (zerop children)) ;; If this is "fetch-old-headered" and there is no ;; visible children, then we don't want this article. - (and (eq gnus-fetch-old-headers 'some) + (and (or (eq gnus-fetch-old-headers 'some) + (numberp gnus-fetch-old-headers)) (gnus-summary-article-ancient-p number) (zerop children)) ;; If this is "fetch-old-headered" and `invisible', then @@ -6602,11 +6747,9 @@ of what's specified by the `gnus-refer-thread-limit' variable." (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)) (gnus-summary-limit-include-thread id))) -(defun gnus-summary-refer-article (message-id &optional arg) - "Fetch an article specified by MESSAGE-ID. -If ARG (the prefix), fetch the article using `gnus-refer-article-method' -or `gnus-select-method', no matter what backend the article comes from." - (interactive "sMessage-ID: \nP") +(defun gnus-summary-refer-article (message-id) + "Fetch an article specified by MESSAGE-ID." + (interactive "sMessage-ID: ") (when (and (stringp message-id) (not (zerop (length message-id)))) ;; Construct the correct Message-ID if necessary. @@ -6620,7 +6763,8 @@ or `gnus-select-method', no matter what backend the article comes from." (gnus-summary-article-sparse-p (mail-header-number header)) (memq (mail-header-number header) - gnus-newsgroup-limit)))) + gnus-newsgroup-limit))) + number) (cond ;; If the article is present in the buffer we just go to it. ((and header @@ -6633,22 +6777,37 @@ or `gnus-select-method', no matter what backend the article comes from." (when sparse (gnus-summary-update-article (mail-header-number header))))) (t - ;; We fetch the article - (let ((gnus-override-method - (cond ((gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method) - (arg - (or gnus-refer-article-method gnus-select-method)) - (t nil))) - number) - ;; Start the special refer-article method, if necessary. - (when (and gnus-refer-article-method - (gnus-news-group-p gnus-newsgroup-name)) - (gnus-check-server gnus-refer-article-method)) - ;; Fetch the header, and display the article. - (if (setq number (gnus-summary-insert-subject message-id)) + ;; We fetch the article. + (catch 'found + (dolist (gnus-override-method (gnus-refer-article-methods)) + (gnus-check-server gnus-override-method) + ;; Fetch the header, and display the article. + (when (setq number (gnus-summary-insert-subject message-id)) (gnus-summary-select-article nil nil nil number) - (gnus-message 3 "Couldn't fetch article %s" message-id)))))))) + (throw 'found t))) + (gnus-message 3 "Couldn't fetch article %s" message-id))))))) + +(defun gnus-refer-article-methods () + "Return a list of referrable methods." + (cond + ;; No method, so we default to current and native. + ((null gnus-refer-article-method) + (list gnus-current-select-method gnus-select-method)) + ;; Current. + ((eq 'current gnus-refer-article-method) + (list gnus-current-select-method)) + ;; List of select methods. + ((not (stringp (cadr gnus-refer-article-method))) + (let (out) + (dolist (method gnus-refer-article-method) + (push (if (eq 'current method) + gnus-current-select-method + method) + out)) + (nreverse out))) + ;; One single select method. + (t + (list gnus-refer-article-method)))) (defun gnus-summary-edit-parameters () "Edit the group parameters of the current group." @@ -6681,8 +6840,14 @@ to guess what the document format is." (list (cons 'save-article-group ogroup)))) (case-fold-search t) (buf (current-buffer)) - dig) + dig to-address) (save-excursion + (set-buffer gnus-original-article-buffer) + ;; Have the digest group inherit the main mail address of + ;; the parent article. + (when (setq to-address (or (message-fetch-field "reply-to") + (message-fetch-field "from"))) + (setq params (append (list (cons 'to-address to-address))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) (insert-buffer-substring gnus-original-article-buffer) ;; Remove lines that may lead nndoc to misinterpret the @@ -6691,14 +6856,17 @@ to guess what the document format is." (goto-char (point-min)) (or (search-forward "\n\n" nil t) (point))) (goto-char (point-min)) - (delete-matching-lines "^\\(Path\\):\\|^From ") + (delete-matching-lines "^Path:\\|^From ") (widen)) (unwind-protect - (if (gnus-group-read-ephemeral-group - name `(nndoc ,name (nndoc-address ,(get-buffer dig)) - (nndoc-article-type - ,(if force 'digest 'guess))) t) - ;; Make all postings to this group go to the parent group. + (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) + (gnus-newsgroup-ephemeral-ignored-charsets + gnus-newsgroup-ignored-charsets)) + (gnus-group-read-ephemeral-group + name `(nndoc ,name (nndoc-address ,(get-buffer dig)) + (nndoc-article-type + ,(if force 'mbox 'guess))) t)) + ;; Make all postings to this group go to the parent group. (nconc (gnus-info-params (gnus-get-info name)) params) ;; Couldn't select this doc group. @@ -6806,6 +6974,7 @@ Optional argument BACKWARD means do search for backward. (require 'gnus-async) (require 'gnus-art) (let ((gnus-select-article-hook nil) ;Disable hook. + (gnus-article-prepare-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. (gnus-use-article-prefetch nil) (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. @@ -6832,6 +7001,9 @@ Optional argument BACKWARD means do search for backward. (get-buffer-window (current-buffer)) (point)) (forward-line 1) + (set-window-point + (get-buffer-window (current-buffer)) + (point)) (set-buffer sum) (setq point (point))) ;; We didn't find it, so we go to the next article. @@ -6870,11 +7042,18 @@ in the comparisons." (let ((data (if (eq backward 'all) gnus-newsgroup-data (gnus-data-find-list (gnus-summary-article-number) (gnus-data-list backward)))) - (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search (not not-case-fold)) - articles d) - (unless (fboundp (intern (concat "mail-header-" header))) - (error "%s is not a valid header" header)) + articles d func) + (if (consp header) + (if (eq (car header) 'extra) + (setq func + `(lambda (h) + (or (cdr (assq ',(cdr header) (mail-header-extra h))) + ""))) + (error "%s is an invalid header" header)) + (unless (fboundp (intern (concat "mail-header-" header))) + (error "%s is not a valid header" header)) + (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) (while data (setq d (car data)) (and (or (not unread) ; We want all articles... @@ -6976,12 +7155,23 @@ to save in." (defun gnus-summary-show-article (&optional arg) "Force re-fetching of the current article. -If ARG (the prefix) is non-nil, show the raw article without any -article massaging functions being run." +If ARG (the prefix) is a number, show the article with the charset +defined in `gnus-summary-show-article-charset-alist', or the charset +inputed. +If ARG (the prefix) is non-nil and not a number, show the raw article +without any article massaging functions being run." (interactive "P") - (if (not arg) - ;; Select the article the normal way. - (gnus-summary-select-article nil 'force) + (cond + ((numberp arg) + (let ((gnus-newsgroup-charset + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) + (read-coding-system "Charset: "))) + (gnus-newsgroup-ignored-charsets 'gnus-all)) + (gnus-summary-select-article nil 'force))) + ((not arg) + ;; Select the article the normal way. + (gnus-summary-select-article nil 'force)) + (t ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) @@ -6991,14 +7181,13 @@ article massaging functions being run." gnus-article-prepare-hook gnus-article-decode-hook gnus-display-mime-function - gnus-break-pages - gnus-visual) + gnus-break-pages) ;; Destroy any MIME parts. (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) (mm-destroy-parts gnus-article-mime-handles))) - (gnus-summary-select-article nil 'force))) + (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -7026,9 +7215,12 @@ If ARG is a negative number, hide the unwanted header lines." (let* ((buffer-read-only nil) (inhibit-point-motion-hooks t) hidden e) - (save-restriction - (message-narrow-to-head) - (setq hidden (gnus-article-hidden-text-p 'headers))) + (setq hidden + (if (numberp arg) + (>= arg 0) + (save-restriction + (article-narrow-to-head) + (gnus-article-hidden-text-p 'headers)))) (goto-char (point-min)) (when (search-forward "\n\n" nil t) (delete-region (point-min) (1- (point)))) @@ -7041,8 +7233,7 @@ If ARG is a negative number, hide the unwanted header lines." (save-restriction (narrow-to-region (point-min) (point)) (article-decode-encoded-words) - (if (or hidden - (and (numberp arg) (< arg 0))) + (if hidden (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) (gnus-treat-article 'head)) @@ -7093,7 +7284,9 @@ re-spool using this method. For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' -and `request-accept' functions." +and `request-accept' functions. + +ACTION can be either `move' (the default), `crosspost' or `copy'." (interactive "P") (unless action (setq action 'move)) @@ -7156,7 +7349,7 @@ and `request-accept' functions." gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article to-newsgroup (list 'quote select-method) - (not articles) t) ; Accept form + (not articles) t) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. ((eq action 'copy) @@ -7197,8 +7390,9 @@ and `request-accept' functions." art-group)))))) (cond ((not art-group) - (gnus-message 1 "Couldn't %s article %s" - (cadr (assq action names)) article)) + (gnus-message 1 "Couldn't %s article %s: %s" + (cadr (assq action names)) article + (nnheader-get-report (car to-method)))) ((and (eq art-group 'junk) (eq action 'move)) (gnus-summary-mark-article article gnus-canceled-mark) @@ -7209,7 +7403,8 @@ and `request-accept' functions." (entry (gnus-gethash pto-group gnus-newsrc-hashtb)) (info (nth 2 entry)) - (to-group (gnus-info-group info))) + (to-group (gnus-info-group info)) + to-marks) ;; Update the group that has been moved to. (when (and info (memq action '(move copy))) @@ -7217,49 +7412,54 @@ and `request-accept' functions." (push to-group to-groups)) (unless (memq article gnus-newsgroup-unreads) + (push 'read to-marks) (gnus-info-set-read info (gnus-add-to-range (gnus-info-read info) (list (cdr art-group))))) - ;; Copy any marks over to the new group. + ;; See whether the article is to be put in the cache. (let ((marks gnus-article-mark-lists) (to-article (cdr art-group))) - ;; See whether the article is to be put in the cache. + ;; Enter the article into the cache in the new group, + ;; if that is required. (when gnus-use-cache (gnus-cache-possibly-enter-article to-group to-article - (let ((header (copy-sequence - (gnus-summary-article-header article)))) - (mail-header-set-number header to-article) - header) (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) - (when (and (equal to-group gnus-newsgroup-name) - (not (memq article gnus-newsgroup-unreads))) - ;; Mark this article as read in this group. - (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) - (setcdr (gnus-active to-group) to-article) - (setcdr gnus-newsgroup-active to-article)) - - (while marks - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - ;; If the other group is the same as this group, - ;; then we have to add the mark to the list. - (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) - (cons to-article - (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))))) - ;; Copy the marks to other group. - (gnus-add-marked-articles - to-group (cdar marks) (list to-article) info)) - (setq marks (cdr marks))) + (when gnus-preserve-marks + ;; Copy any marks over to the new group. + (when (and (equal to-group gnus-newsgroup-name) + (not (memq article gnus-newsgroup-unreads))) + ;; Mark this article as read in this group. + (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) + (setcdr (gnus-active to-group) to-article) + (setcdr gnus-newsgroup-active to-article)) + + (while marks + (when (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))) + (push (cdar marks) to-marks) + ;; If the other group is the same as this group, + ;; then we have to add the mark to the list. + (when (equal to-group gnus-newsgroup-name) + (set (intern (format "gnus-newsgroup-%s" (caar marks))) + (cons to-article + (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))))) + ;; Copy the marks to other group. + (gnus-add-marked-articles + to-group (cdar marks) (list to-article) info)) + (setq marks (cdr marks))) + + (gnus-request-set-mark to-group (list (list (list to-article) + 'set + to-marks)))) (gnus-dribble-enter (concat "(gnus-group-set-info '" @@ -7390,12 +7590,11 @@ latter case, they will be copied into the relevant groups." (kill-buffer (current-buffer))))) (defun gnus-summary-article-posted-p () - "Say whether the current (mail) article is available from `gnus-select-method' as well. + "Say whether the current (mail) article is available from news as well. This will be the case if the article has both been mailed and posted." (interactive) (let ((id (mail-header-references (gnus-summary-article-header))) - (gnus-override-method - (or gnus-refer-article-method gnus-select-method))) + (gnus-override-method (car (gnus-refer-article-methods)))) (if (gnus-request-head id "") (gnus-message 2 "The current message was found on %s" gnus-override-method) @@ -7509,9 +7708,10 @@ This will have permanent effect only in mail groups. If FORCE is non-nil, allow editing of articles even in read-only groups." (interactive "P") - (let ((mail-parse-charset gnus-newsgroup-charset)) - (save-excursion - (set-buffer gnus-summary-buffer) + (save-excursion + (set-buffer gnus-summary-buffer) + (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) (gnus-set-global-variables) (when (and (not force) (gnus-group-read-only-p)) @@ -7520,7 +7720,9 @@ groups." (gnus-article-edit-article 'mime-to-mml `(lambda (no-highlight) - (let ((mail-parse-charset ',gnus-newsgroup-charset)) + (let ((mail-parse-charset ',gnus-newsgroup-charset) + (mail-parse-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) (mml-to-mime) (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") @@ -7821,7 +8023,8 @@ the actual number of articles marked is returned." "Mark N articles as read forwards. If N is negative, mark backwards instead. Mark with MARK, ?r by default. The difference between N and the actual number of articles marked is -returned." +returned. +Iff NO-EXPIRE, auto-expiry will be inhibited." (interactive "p") (gnus-summary-show-thread) (let ((backward (< n 0)) @@ -7900,7 +8103,6 @@ returned." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article - (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -7914,7 +8116,8 @@ Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' (dormant) and `?E' (expirable). If MARK is nil, then the default character `?r' is used. If ARTICLE is nil, then the article on the current line will be -marked." +marked. +Iff NO-EXPIRE, auto-expiry will be inhibited." ;; The mark might be a string. (when (stringp mark) (setq mark (aref mark 0))) @@ -7946,7 +8149,6 @@ marked." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article - (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -8260,7 +8462,7 @@ If ALL is non-nil, also mark ticked and dormant articles as read." (gnus-summary-catchup t quietly)) (defun gnus-summary-catchup-and-exit (&optional all quietly) - "Mark all articles not marked as unread in this newsgroup as read, then exit. + "Mark all unread articles in this group as read, then exit. If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (when (gnus-summary-catchup all quietly nil 'fast) @@ -8275,7 +8477,6 @@ If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (gnus-summary-catchup-and-exit t quietly)) -;; Suggested by "Arne Eofsson" . (defun gnus-summary-catchup-and-goto-next-group (&optional all) "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as @@ -8283,7 +8484,7 @@ read." (interactive "P") (save-excursion (gnus-summary-catchup all)) - (gnus-summary-next-article t nil nil t)) + (gnus-summary-next-group)) ;; Thread-based commands. @@ -8445,9 +8646,7 @@ Returns nil if no threads were there to be hidden." (subst-char-in-region start (point) ?\n ?\^M) (gnus-summary-goto-subject article)) (goto-char start) - nil) - ;;(gnus-summary-position-point) - )))) + nil))))) (defun gnus-summary-go-to-next-thread (&optional previous) "Go to the same level (or less) next thread. @@ -8789,11 +8988,8 @@ save those articles instead." (and (boundp group) (symbol-name group) (symbol-value group) - (memq 'respool - (assoc (symbol-name - (car (gnus-find-method-for-group - (symbol-name group)))) - gnus-valid-select-methods)))) + (gnus-get-function (gnus-find-method-for-group + (symbol-name group)) 'request-accept-article t))) (defun gnus-read-move-group-name (prompt default articles prefix) "Read a group name." @@ -8837,13 +9033,49 @@ save those articles instead." to-newsgroup)) (or (and (gnus-request-create-group to-newsgroup (gnus-group-name-to-method to-newsgroup)) - (gnus-activate-group to-newsgroup nil nil - (gnus-group-name-to-method - to-newsgroup))) + (gnus-activate-group + to-newsgroup nil nil + (gnus-group-name-to-method to-newsgroup)) + (gnus-subscribe-group to-newsgroup)) (error "Couldn't create group %s" to-newsgroup))) (error "No such group: %s" to-newsgroup))) to-newsgroup)) +(defun gnus-summary-save-parts (type dir n reverse) + "Save parts matching TYPE to DIR. +If REVERSE, save parts that do not match TYPE." + (interactive + (list (read-string "Save parts of type: " "image/.*") + (read-file-name "Save to directory: " t nil t) + current-prefix-arg)) + (gnus-summary-iterate n + (let ((gnus-display-mime-function nil) + (gnus-inhibit-treatment t)) + (gnus-summary-select-article)) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect)))) + (when handles + (gnus-summary-save-parts-1 type dir handles reverse) + (mm-destroy-parts handles)))))) + +(defun gnus-summary-save-parts-1 (type dir handle reverse) + (if (stringp (car handle)) + (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse)) + (cdr handle)) + (when (if reverse + (not (string-match type (mm-handle-media-type handle))) + (string-match type (mm-handle-media-type handle))) + (let ((file (expand-file-name + (file-name-nondirectory + (or + (mail-content-type-get + (mm-handle-disposition handle) 'filename) + (concat gnus-newsgroup-name "." gnus-current-article))) + dir))) + (unless (file-exists-p file) + (mm-save-part-to-file handle file)))))) + ;; Summary extract commands (defun gnus-summary-insert-pseudos (pslist &optional not-view) @@ -8956,8 +9188,10 @@ save those articles instead." "Read the headers of article ID and enter them into the Gnus system." (let ((group gnus-newsgroup-name) (gnus-override-method - (and (gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method)) + (or + gnus-override-method + (and (gnus-news-group-p gnus-newsgroup-name) + (car (gnus-refer-article-methods))))) where) ;; First we check to see whether the header in question is already ;; fetched. @@ -9134,16 +9368,16 @@ save those articles instead." (gnus-info-set-read ',info ',(gnus-info-read info)) (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) - ;; Propagate the read marks to the backend. - (if (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)))) - (when (or add del) - (unless (gnus-check-group group) - (error "Can't open server for %s" group)) - (gnus-request-set-mark - group (delq nil (list (if add (list add 'add '(read))) - (if del (list del 'del '(read))))))))) + ;; Propagate the read marks to the backend. + (if (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)))) + (when (or add del) + (unless (gnus-check-group group) + (error "Can't open server for %s" group)) + (gnus-request-set-mark + group (delq nil (list (if add (list add 'add '(read))) + (if del (list del 'del '(read))))))))) ;; Enter this list into the group info. (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. @@ -9180,21 +9414,40 @@ save those articles instead." (defun gnus-summary-setup-default-charset () "Setup newsgroup default charset." - (let ((name (and gnus-newsgroup-name - (gnus-group-real-name gnus-newsgroup-name)))) - (setq gnus-newsgroup-charset - (or (and gnus-newsgroup-name - (or (gnus-group-find-parameter gnus-newsgroup-name - 'charset) - (let ((alist gnus-group-charset-alist) - elem (charset nil)) - (while (setq elem (pop alist)) - (when (and name - (string-match (car elem) name)) - (setq alist nil - charset (cadr elem)))) - charset))) - gnus-default-charset)))) + (if (equal gnus-newsgroup-name "nndraft:drafts") + (setq gnus-newsgroup-charset nil) + (let* ((name (and gnus-newsgroup-name + (gnus-group-real-name gnus-newsgroup-name))) + (ignored-charsets + (or gnus-newsgroup-ephemeral-ignored-charsets + (append + (and gnus-newsgroup-name + (or (gnus-group-find-parameter gnus-newsgroup-name + 'ignored-charsets t) + (let ((alist gnus-group-ignored-charsets-alist) + elem (charsets nil)) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + charsets (cdr elem)))) + charsets))) + gnus-newsgroup-ignored-charsets)))) + (setq gnus-newsgroup-charset + (or gnus-newsgroup-ephemeral-charset + (and gnus-newsgroup-name + (or (gnus-group-find-parameter gnus-newsgroup-name 'charset) + (let ((alist gnus-group-charset-alist) + elem charset) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + charset (cadr elem)))) + charset))) + gnus-default-charset)) + (set (make-local-variable 'gnus-newsgroup-ignored-charsets) + ignored-charsets)))) ;;; ;;; Mime Commands