X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=952b901e5fd4ff6628f547a86ed4bb5eef7a09a6;hb=09a6c5997ca53642d041233d6a11f5550e1b2943;hp=f291d865f3413329a3696994e86b4f88b66d847c;hpb=7198cf32adbd5d8b07d9bd0a559aeb02d87b39b7;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index f291d86..952b901 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -51,10 +51,12 @@ (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) (autoload 'gnus-cache-write-active "gnus-cache") -(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t) (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) (autoload 'mm-uu-dissect "mm-uu") +(autoload 'gnus-article-outlook-deuglify-article "deuglify" + "Deuglify broken Outlook (Express) articles and redisplay." + t) (defcustom gnus-kill-summary-on-exit t "*If non-nil, kill the summary buffer when you exit from it. @@ -145,8 +147,9 @@ comparing subjects." "List of functions taking a string argument that simplify subjects. The functions are applied recursively. -Useful functions to put in this list include: `gnus-simplify-subject-re', -`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'." +Useful functions to put in this list include: +`gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy', +`gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'." :group 'gnus-thread :type '(repeat function)) @@ -193,7 +196,7 @@ This applies to marking commands as well as other commands that the end of an article. If nil, the marking commands do NOT go to the next unread article -(they go to the next article instead). If `never', commands that +\(they go to the next article instead). If `never', commands that usually go to the next unread article, will go to the next article, whether it is read or not." :group 'gnus-summary-marks @@ -310,13 +313,13 @@ higest-scored article), `unseen' (place point on the subject line of the first unseen article), 'unseen-or-unread' (place point on the subject line of the first unseen article or, if all article have been seen, on the subject line of the first unread article), or a function to be called to -place point on some subject line.." +place point on some subject line." :group 'gnus-group-select :type '(choice (const best) (const unread) (const first) (const unseen) - (const unseen-or-unread))) + (const unseen-or-unread))) (defcustom gnus-dont-select-after-jump-to-other-group nil "If non-nil, don't select the first unread article after entering the @@ -444,6 +447,11 @@ this variable specifies group names." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-spam-mark ?H + "*Mark used for spam articles." + :group 'gnus-summary-marks + :type 'character) + (defcustom gnus-souped-mark ?F "*Mark used for souped articles." :group 'gnus-summary-marks @@ -604,7 +612,7 @@ with some simple extensions. %S The subject General format specifiers can also be used. -See (gnus)Formatting Variables." +See `(gnus)Formatting Variables'." :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-threading :type 'string) @@ -663,7 +671,8 @@ was sent, sorting by number means sorting by arrival time.) Ready-made functions include `gnus-article-sort-by-number', `gnus-article-sort-by-author', `gnus-article-sort-by-subject', -`gnus-article-sort-by-date' and `gnus-article-sort-by-score'. +`gnus-article-sort-by-date', `gnus-article-sort-by-random' +and `gnus-article-sort-by-score'. When threading is turned on, the variable `gnus-thread-sort-functions' controls how articles are sorted." @@ -673,6 +682,7 @@ controls how articles are sorted." (function-item gnus-article-sort-by-subject) (function-item gnus-article-sort-by-date) (function-item gnus-article-sort-by-score) + (function-item gnus-article-sort-by-random) (function :tag "other")))) (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) @@ -692,7 +702,8 @@ Ready-made functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', `gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number', -`gnus-thread-sort-by-most-recent-date', and +`gnus-thread-sort-by-most-recent-date', +`gnus-thread-sort-by-random', and `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). When threading is turned off, the variable @@ -704,6 +715,7 @@ When threading is turned off, the variable (function-item gnus-thread-sort-by-date) (function-item gnus-thread-sort-by-score) (function-item gnus-thread-sort-by-total-score) + (function-item gnus-thread-sort-by-random) (function :tag "other")))) (defcustom gnus-thread-score-function '+ @@ -808,7 +820,7 @@ is not run if `gnus-visual' is nil." :group 'gnus-summary-visual :type 'hook) -(defcustom gnus-parse-headers-hook '(gnus-set-summary-default-charset) +(defcustom gnus-parse-headers-hook '(gnus-summary-inherit-default-charset) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) @@ -861,30 +873,32 @@ automatically when it is selected." :type 'face) (defcustom gnus-summary-highlight - '(((= mark gnus-canceled-mark) + '(((eq mark gnus-canceled-mark) . gnus-summary-cancelled-face) ((and (> score default-high) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) + (or (eq mark gnus-dormant-mark) + (eq mark gnus-ticked-mark))) . gnus-summary-high-ticked-face) ((and (< score default-low) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) + (or (eq mark gnus-dormant-mark) + (eq mark gnus-ticked-mark))) . gnus-summary-low-ticked-face) - ((or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark)) + ((or (eq mark gnus-dormant-mark) + (eq mark gnus-ticked-mark)) . gnus-summary-normal-ticked-face) - ((and (> score default-high) (= mark gnus-ancient-mark)) + ((and (> score default-high) (eq mark gnus-ancient-mark)) . gnus-summary-high-ancient-face) - ((and (< score default-low) (= mark gnus-ancient-mark)) + ((and (< score default-low) (eq mark gnus-ancient-mark)) . gnus-summary-low-ancient-face) - ((= mark gnus-ancient-mark) + ((eq mark gnus-ancient-mark) . gnus-summary-normal-ancient-face) - ((and (> score default-high) (= mark gnus-unread-mark)) + (downloaded + . gnus-agent-downloaded-article-face) + ((and (> score default-high) (eq mark gnus-unread-mark)) . gnus-summary-high-unread-face) - ((and (< score default-low) (= mark gnus-unread-mark)) + ((and (< score default-low) (eq mark gnus-unread-mark)) . gnus-summary-low-unread-face) - ((= mark gnus-unread-mark) + ((eq mark gnus-unread-mark) . gnus-summary-normal-unread-face) ((and (> score default-high) (memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))) @@ -1042,14 +1056,6 @@ when prompting the user for which type of files to save." :group 'gnus-summary :type 'regexp) - -(defcustom gnus-summary-save-parts-default-mime "image/.*" - "*A regexp to match MIME parts when saving multiple parts of a message -with gnus-summary-save-parts (X m). This regexp will be used by default -when prompting the user for which type of files to save." - :group 'gnus-summary - :type 'regexp) - (defcustom gnus-read-all-available-headers nil "Whether Gnus should parse all headers made available to it. This is mostly relevant for slow backends where the user may @@ -1060,9 +1066,20 @@ that were fetched. Say, for nnultimate groups." (defcustom gnus-summary-muttprint-program "muttprint" "Command (and optional arguments) used to run Muttprint." + :version "21.3" :group 'gnus-summary :type 'string) +(defcustom gnus-article-loose-mime nil + "If non-nil, don't require MIME-Version header. +Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not +supply the MIME-Version header or deliberately strip it From the mail. +Set it to non-nil, Gnus will treat some articles as MIME even if +the MIME-Version header is missed." + :version "21.3" + :type 'boolean + :group 'gnus-article) + ;;; Internal variables (defvar gnus-summary-display-cache nil) @@ -1086,9 +1103,6 @@ that were fetched. Say, for nnultimate groups." (defvar gnus-summary-save-parts-type-history nil) (defvar gnus-summary-save-parts-last-directory nil) -(defvar gnus-summary-save-parts-type-history nil) -(defvar gnus-summary-save-parts-last-directory nil) - ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) (defvar gnus-newsgroup-selected-overlay nil) @@ -1124,6 +1138,7 @@ that were fetched. Say, for nnultimate groups." (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) (?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) (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) @@ -1172,6 +1187,7 @@ the type of the variable (string, integer, character, etc).") (?u gnus-tmp-user-defined ?s) (?d (length gnus-newsgroup-dormant) ?d) (?t (length gnus-newsgroup-marked) ?d) + (?h (length gnus-newsgroup-spam-marked) ?d) (?r (length gnus-newsgroup-reads) ?d) (?z (gnus-summary-article-score gnus-tmp-article-number) ?d) (?E gnus-newsgroup-expunged-tally ?d) @@ -1203,10 +1219,10 @@ end position and text.") (defvar gnus-newsgroup-limits nil) (defvar gnus-newsgroup-unreads nil - "List of unread articles in the current newsgroup.") + "Sorted list of unread articles in the current newsgroup.") (defvar gnus-newsgroup-unselected nil - "List of unselected unread articles in the current newsgroup.") + "Sorted list of unselected unread articles in the current newsgroup.") (defvar gnus-newsgroup-reads nil "Alist of read articles and article marks in the current newsgroup.") @@ -1214,13 +1230,16 @@ end position and text.") (defvar gnus-newsgroup-expunged-tally nil) (defvar gnus-newsgroup-marked nil - "List of ticked articles in the current newsgroup (a subset of unread art).") + "Sorted list of ticked articles in the current newsgroup (a subset of unread art).") + +(defvar gnus-newsgroup-spam-marked nil + "List of ranges of articles that have been marked as spam.") (defvar gnus-newsgroup-killed nil "List of ranges of articles that have been through the scoring process.") (defvar gnus-newsgroup-cached nil - "List of articles that come from the article cache.") + "Sorted list of articles that come from the article cache.") (defvar gnus-newsgroup-saved nil "List of articles that have been saved.") @@ -1237,13 +1256,13 @@ end position and text.") "List of articles that have are recent in the current newsgroup.") (defvar gnus-newsgroup-expirable nil - "List of articles in the current newsgroup that can be expired.") + "Sorted list of articles in the current newsgroup that can be expired.") (defvar gnus-newsgroup-processable nil "List of articles in the current newsgroup that can be processed.") (defvar gnus-newsgroup-downloadable nil - "List of articles in the current newsgroup that can be processed.") + "Sorted list of articles in the current newsgroup that can be processed.") (defvar gnus-newsgroup-undownloaded nil "List of articles in the current newsgroup that haven't been downloaded..") @@ -1255,7 +1274,7 @@ end position and text.") "List of articles in the current newsgroup that have bookmarks.") (defvar gnus-newsgroup-dormant nil - "List of dormant articles in the current newsgroup.") + "Sorted list of dormant articles in the current newsgroup.") (defvar gnus-newsgroup-unseen nil "List of unseen articles in the current newsgroup.") @@ -1304,6 +1323,7 @@ end position and text.") gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked + gnus-newsgroup-spam-marked gnus-newsgroup-reads gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-forwarded gnus-newsgroup-recent @@ -1373,6 +1393,13 @@ buffers. For example: (setq mystr (substring mystr 0 (match-beginning 0)))) mystr)) +(defun gnus-simplify-all-whitespace (str) + "Remove all whitespace from STR." + (let ((mystr str)) + (while (string-match "[ \t\n]+" mystr) + (setq mystr (replace-match "" nil nil mystr))) + mystr)) + (defsubst gnus-simplify-subject-re (subject) "Remove \"Re:\" from subject lines." (if (string-match message-subject-re-regexp subject) @@ -1555,6 +1582,7 @@ increase the score of each group you read." "\C-c\C-s\C-d" gnus-summary-sort-by-date "\C-c\C-s\C-i" gnus-summary-sort-by-score "\C-c\C-s\C-o" gnus-summary-sort-by-original + "\C-c\C-s\C-r" gnus-summary-sort-by-random "=" gnus-summary-expand-window "\C-x\C-s" gnus-summary-reselect-current-group "\M-g" gnus-summary-rescan-group @@ -1583,7 +1611,7 @@ increase the score of each group you read." "i" gnus-summary-news-other-window "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article - "t" gnus-article-toggle-headers + "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article "v" gnus-summary-preview-mime-message @@ -1652,6 +1680,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 + "." gnus-summary-limit-to-unseen "x" gnus-summary-limit-to-extra "p" gnus-summary-limit-to-display-predicate "E" gnus-summary-limit-include-expunged @@ -1747,20 +1776,23 @@ increase the score of each group you read." "c" gnus-article-remove-cr "Z" gnus-article-decode-HZ "h" gnus-article-wash-html + "u" gnus-article-unsplit-urls "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message - "t" gnus-article-toggle-headers + "m" gnus-summary-morse-message + "t" gnus-summary-toggle-header "g" gnus-treat-smiley "v" gnus-summary-verbose-headers "m" gnus-summary-toggle-mime "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive "p" gnus-article-verify-x-pgp-sig - "d" gnus-article-treat-dumbquotes) + "d" gnus-article-treat-dumbquotes + "k" gnus-article-outlook-deuglify-article) (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) "a" gnus-article-hide - "h" gnus-article-toggle-headers + "h" gnus-article-hide-headers "b" gnus-article-hide-boring-headers "s" gnus-article-hide-signature "c" gnus-article-hide-citation @@ -1815,7 +1847,9 @@ increase the score of each group you read." "f" gnus-summary-fetch-faq "d" gnus-summary-describe-group "h" gnus-summary-describe-briefly - "i" gnus-info-find-node) + "i" gnus-info-find-node + "c" gnus-group-fetch-charter + "C" gnus-group-fetch-control) (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) "e" gnus-summary-expire-articles @@ -1854,13 +1888,84 @@ increase the score of each group you read." "o" gnus-article-save-part "c" gnus-article-copy-part "C" gnus-article-view-part-as-charset - "e" gnus-article-externalize-part + "e" gnus-article-view-part-externally "E" gnus-article-encrypt-body "i" gnus-article-inline-part - "|" gnus-article-pipe-part)) + "|" gnus-article-pipe-part) + + (gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map) + "p" gnus-summary-mark-as-processable + "u" gnus-summary-unmark-as-processable + "U" gnus-summary-unmark-all-processable + "v" gnus-uu-mark-over + "s" gnus-uu-mark-series + "r" gnus-uu-mark-region + "g" gnus-uu-unmark-region + "R" gnus-uu-mark-by-regexp + "G" gnus-uu-unmark-by-regexp + "t" gnus-uu-mark-thread + "T" gnus-uu-unmark-thread + "a" gnus-uu-mark-all + "b" gnus-uu-mark-buffer + "S" gnus-uu-mark-sparse + "k" gnus-summary-kill-process-mark + "y" gnus-summary-yank-process-mark + "w" gnus-summary-save-process-mark + "i" gnus-uu-invert-processable) + + (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) + ;;"x" gnus-uu-extract-any + "m" gnus-summary-save-parts + "u" gnus-uu-decode-uu + "U" gnus-uu-decode-uu-and-save + "s" gnus-uu-decode-unshar + "S" gnus-uu-decode-unshar-and-save + "o" gnus-uu-decode-save + "O" gnus-uu-decode-save + "b" gnus-uu-decode-binhex + "B" gnus-uu-decode-binhex + "p" gnus-uu-decode-postscript + "P" gnus-uu-decode-postscript-and-save) + + (gnus-define-keys + (gnus-uu-extract-view-map "v" gnus-uu-extract-map) + "u" gnus-uu-decode-uu-view + "U" gnus-uu-decode-uu-and-save-view + "s" gnus-uu-decode-unshar-view + "S" gnus-uu-decode-unshar-and-save-view + "o" gnus-uu-decode-save-view + "O" gnus-uu-decode-save-view + "b" gnus-uu-decode-binhex-view + "B" gnus-uu-decode-binhex-view + "p" gnus-uu-decode-postscript-view + "P" gnus-uu-decode-postscript-and-save-view)) (defvar gnus-article-post-menu nil) +(defconst gnus-summary-menu-maxlen 20) + +(defun gnus-summary-menu-split (menu) + ;; If we have lots of elements, divide them into groups of 20 + ;; and make a pane (or submenu) for each one. + (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2)) + (let ((menu menu) sublists next + (i 1)) + (while menu + ;; Pull off the next gnus-summary-menu-maxlen elements + ;; and make them the next element of sublist. + (setq next (nthcdr gnus-summary-menu-maxlen menu)) + (if next + (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu) + nil)) + (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0) + (aref (car (last menu)) 0)) menu) + sublists)) + (setq i (1+ i)) + (setq menu next)) + (nreverse sublists)) + ;; Few elements--put them all in one pane. + menu)) + (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1899,7 +2004,7 @@ increase the score of each group you read." (let ((innards `(("Hide" ["All" gnus-article-hide t] - ["Headers" gnus-article-toggle-headers t] + ["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] @@ -1924,7 +2029,28 @@ increase the score of each group you read." ["Show X-Face" gnus-article-display-x-face t] ["Show picons in From" gnus-treat-from-picon t] ["Show picons in mail headers" gnus-treat-mail-picon t] - ["Show picons in news headers" gnus-treat-newsgroups-picon t]) + ["Show picons in news headers" gnus-treat-newsgroups-picon t] + ("View as different encoding" + ,@(gnus-summary-menu-split + (mapcar + (lambda (cs) + ;; Since easymenu under FSF Emacs doesn't allow lambda + ;; forms for menu commands, we should provide intern'ed + ;; function symbols. + (let ((command (intern (format "\ +gnus-summary-show-article-from-menu-as-charset-%s" cs)))) + (fset command + `(lambda () + (interactive) + (let ((gnus-summary-show-article-charset-alist + '((1 . ,cs)))) + (gnus-summary-show-article 1)))) + `[,(symbol-name cs) ,command t])) + (sort (if (fboundp 'coding-system-list) + (coding-system-list) + ;;(mapcar 'car mm-mime-mule-charset-alist) + ) + 'string<))))) ("Washing" ("Remove Blanks" ["Leading" gnus-article-strip-leading-blank-lines t] @@ -1946,7 +2072,8 @@ increase the score of each group you read." ["Rot 13" gnus-summary-caesar-message ,@(if (featurep 'xemacs) '(t) '(:help "\"Caesar rotate\" article by 13"))] - ["Unix pipe" gnus-summary-pipe-message t] + ["Morse decode" gnus-summary-morse-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] @@ -1956,8 +2083,11 @@ increase the score of each group you read." ["Unfold headers" gnus-article-treat-unfold-headers t] ["Fold newsgroups" gnus-article-treat-fold-newsgroups t] ["Html" gnus-article-wash-html t] + ["URLs" gnus-article-unsplit-urls t] ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] - ["HZ" gnus-article-decode-HZ t]) + ["HZ" gnus-article-decode-HZ t] + ["OutlooK deuglify" gnus-article-outlook-deuglify-article t] + ) ("Output" ["Save in default format" gnus-summary-save-article ,@(if (featurep 'xemacs) '(t) @@ -2085,6 +2215,7 @@ increase the score of each group you read." ["Digest and mail" gnus-summary-digest-mail-forward t] ["Digest and post" gnus-summary-digest-post-forward t] ["Resend message" gnus-summary-resend-message t] + ["Resend message edit" gnus-summary-resend-message-edit t] ["Send bounced mail" gnus-summary-resend-bounced-mail t] ["Send a mail" gnus-summary-mail-other-window t] ["Create a local message" gnus-summary-news-other-window t] @@ -2138,9 +2269,10 @@ increase the score of each group you read." ["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] + ["Score..." gnus-summary-limit-to-score t] ["Display Predicate" gnus-summary-limit-to-display-predicate t] ["Unread" gnus-summary-limit-to-unread t] + ["Unseen" gnus-summary-limit-to-unseen t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] ["Articles" gnus-summary-limit-to-articles t] ["Pop limit" gnus-summary-pop-limit t] @@ -2201,10 +2333,17 @@ increase the score of each group you read." ["Sort by score" gnus-summary-sort-by-score t] ["Sort by lines" gnus-summary-sort-by-lines t] ["Sort by characters" gnus-summary-sort-by-chars t] + ["Randomize" gnus-summary-sort-by-random t] ["Original sort" gnus-summary-sort-by-original t]) ("Help" ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] + ["Fetch charter" gnus-group-fetch-charter + ,@(if (featurep 'xemacs) nil + '(:help "Display the charter of the current group"))] + ["Fetch control message" gnus-group-fetch-control + ,@(if (featurep 'xemacs) nil + '(:help "Display the archived control message for the current group"))] ["Read manual" gnus-info-find-node t]) ("Modes" ["Pick and read" gnus-pick-mode t] @@ -2618,6 +2757,7 @@ The following commands are available: (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)))) @@ -2719,10 +2859,11 @@ time; i.e., when generating the summary lines. After that, marks of articles." `(cond ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark) - ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark) +;;;; ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark) ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark) ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark) ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark) + ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark) ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq ,number gnus-newsgroup-reads)) @@ -2863,6 +3004,7 @@ buffer that was in action when the last article was fetched." (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) (marked gnus-newsgroup-marked) + (spam gnus-newsgroup-spam-marked) (unread gnus-newsgroup-unreads) (headers gnus-current-headers) (data gnus-newsgroup-data) @@ -2885,6 +3027,7 @@ buffer that was in action when the last article was fetched." (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name gnus-newsgroup-marked marked + gnus-newsgroup-spam-marked spam gnus-newsgroup-unreads unread gnus-current-headers headers gnus-newsgroup-data data @@ -2956,17 +3099,19 @@ buffer that was in action when the last article was fetched." 0 nil 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) - (- (point) 2))))) + (- (point) (point-min) 1))))) (goto-char (point-min)) (push (cons 'replied (and (search-forward "\201" nil t) - (- (point) 2))) + (- (point) (point-min) 1))) pos) (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) + (push (cons 'score (and (search-forward "\202" nil t) + (- (point) (point-min) 1))) pos) (goto-char (point-min)) (push (cons 'download - (and (search-forward "\203" nil t) (- (point) 2))) + (and (search-forward "\203" nil t) + (- (point) (point-min) 1))) pos))) (setq gnus-summary-mark-positions pos)))) @@ -3126,6 +3271,18 @@ the thread are to be displayed." gnus-empty-thread-mark) number))) +(defsubst gnus-summary-line-message-size (head) + "Return pretty-printed version of message size. +This function is intended to be used in +`gnus-summary-line-format-alist', which see." + (let ((c (or (mail-header-chars head) -1))) + (cond ((< c 0) "n/a") ; chars not available + ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0))) + ((< c (* 1000 100)) (format "%dk" (/ c 1024.0))) + ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024)))) + (t (format "%dM" (/ c (* 1024.0 1024))))))) + + (defun gnus-summary-set-local-parameters (group) "Go through the local params of GROUP and set all variable specs in that list." (let ((params (gnus-group-find-parameter group)) @@ -3558,13 +3715,13 @@ if it was already present. If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs will not be entered in the DEPENDENCIES table. Otherwise duplicate -Message-IDs will be renamed be renamed to a unique Message-ID before -being entered. +Message-IDs will be renamed to a unique Message-ID before being +entered. Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let* ((id (mail-header-id header)) (id-dep (and id (intern id dependencies))) - ref ref-dep ref-header) + parent-id ref ref-dep ref-header replaced) ;; Enter this `header' in the `dependencies' table. (cond ((not id-dep) @@ -3581,7 +3738,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (force-new ;; Overrides an existing entry; ;; just set the header part of the entry. - (setcar (symbol-value id-dep) header)) + (setcar (symbol-value id-dep) header) + (setq replaced t)) ;; Renames the existing `header' to a unique Message-ID. ((not gnus-summary-ignore-duplicates) @@ -3604,9 +3762,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (or (mail-header-xref header) ""))) (setq header nil))) - (when header - ;; First check if that we are not creating a References loop. - (setq ref (gnus-parent-id (mail-header-references header))) + (when (and header (not replaced)) + ;; First check that we are not creating a References loop. + (setq parent-id (gnus-parent-id (mail-header-references header))) + (setq ref parent-id) (while (and ref (setq ref-dep (intern-soft ref dependencies)) (boundp ref-dep) @@ -3616,10 +3775,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; root article. (progn (mail-header-set-references (car (symbol-value id-dep)) "none") - (setq ref nil)) + (setq ref nil) + (setq parent-id nil)) (setq ref (gnus-parent-id (mail-header-references ref-header))))) - (setq ref (gnus-parent-id (mail-header-references header))) - (setq ref-dep (intern (or ref "none") dependencies)) + (setq ref-dep (intern (or parent-id "none") dependencies)) (if (boundp ref-dep) (setcdr (symbol-value ref-dep) (nconc (cdr (symbol-value ref-dep)) @@ -3627,6 +3786,11 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (set ref-dep (list nil (symbol-value id-dep))))) header)) +(defun gnus-extract-message-id-from-in-reply-to (string) + (if (string-match "<[^>]+>" string) + (substring string (match-beginning 0) (match-end 0)) + nil)) + (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) (mail-parse-charset gnus-newsgroup-charset) @@ -3703,7 +3867,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defsubst gnus-nov-parse-line (number dependencies &optional force-new) (let ((eol (gnus-point-at-eol)) (buffer (current-buffer)) - header) + header references in-reply-to) ;; overview: [num subject from date id refs chars lines misc] (unwind-protect @@ -3730,6 +3894,12 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (widen)) + (when (and (string= references "") + (setq in-reply-to (mail-header-extra header)) + (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) + (mail-header-set-references + header (gnus-extract-message-id-from-in-reply-to in-reply-to))) + (when gnus-alter-header-function (funcall gnus-alter-header-function header)) (gnus-dependencies-add-header header dependencies force-new))) @@ -3764,7 +3934,9 @@ the id of the parent article (if any)." (push header gnus-newsgroup-headers) (if (memq number gnus-newsgroup-unselected) (progn - (push number gnus-newsgroup-unreads) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads + number)) (setq gnus-newsgroup-unselected (delq number gnus-newsgroup-unselected))) (push number gnus-newsgroup-ancient))))))) @@ -3790,7 +3962,9 @@ the id of the parent article (if any)." (if (memq (setq article (mail-header-number header)) gnus-newsgroup-unselected) (progn - (push article gnus-newsgroup-unreads) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list + gnus-newsgroup-unreads article)) (setq gnus-newsgroup-unselected (delq article gnus-newsgroup-unselected))) (push article gnus-newsgroup-ancient))) @@ -4112,6 +4286,15 @@ using some other form will lead to serious barfage." (gnus-article-sort-by-number (gnus-thread-header h1) (gnus-thread-header h2))) +(defsubst gnus-article-sort-by-random (h1 h2) + "Sort articles by article number." + (zerop (random 2))) + +(defun gnus-thread-sort-by-random (h1 h2) + "Sort threads by root article number." + (gnus-article-sort-by-random + (gnus-thread-header h1) (gnus-thread-header h2))) + (defsubst gnus-article-sort-by-lines (h1 h2) "Sort articles by article Lines header." (< (mail-header-lines h1) @@ -4264,20 +4447,32 @@ Unscored articles will be counted as having a score of zero." (defvar gnus-tmp-thread-tree-header-string "") -(defvar gnus-sum-thread-tree-root "> " +(defcustom gnus-sum-thread-tree-root "> " "With %B spec, used for the root of a thread. -If nil, use subject instead.") -(defvar gnus-sum-thread-tree-single-indent "" +If nil, use subject instead." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-single-indent "" "With %B spec, used for a thread with just one message. -If nil, use subject instead.") -(defvar gnus-sum-thread-tree-vertical "| " - "With %B spec, used for drawing a vertical line.") -(defvar gnus-sum-thread-tree-indent " " - "With %B spec, used for indenting.") -(defvar gnus-sum-thread-tree-leaf-with-other "+-> " - "With %B spec, used for a leaf with brothers.") -(defvar gnus-sum-thread-tree-single-leaf "\\-> " - "With %B spec, used for a leaf without brothers.") +If nil, use subject instead." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-vertical "| " + "With %B spec, used for drawing a vertical line." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-indent " " + "With %B spec, used for indenting." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-leaf-with-other "+-> " + "With %B spec, used for a leaf with brothers." + :type 'string + :group 'gnus-thread) +(defcustom gnus-sum-thread-tree-single-leaf "\\-> " + "With %B spec, used for a leaf without brothers." + :type 'string + :group 'gnus-thread) (defun gnus-summary-prepare-threads (threads) "Prepare summary buffer from THREADS and indentation LEVEL. @@ -4292,7 +4487,7 @@ or a straight list of headers." (default-score (or gnus-summary-default-score 0)) (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) thread number subject stack state gnus-tmp-gathered beg-match - new-roots gnus-tmp-new-adopts thread-end + new-roots gnus-tmp-new-adopts thread-end simp-subject gnus-tmp-header gnus-tmp-unread gnus-tmp-replied gnus-tmp-subject-or-nil gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score @@ -4381,7 +4576,8 @@ or a straight list of headers." (setq gnus-tmp-level -1))) (setq number (mail-header-number gnus-tmp-header) - subject (mail-header-subject gnus-tmp-header)) + subject (mail-header-subject gnus-tmp-header) + simp-subject (gnus-simplify-subject-fully subject)) (cond ;; If the thread has changed subject, we might want to make @@ -4389,8 +4585,7 @@ or a straight list of headers." ((and (null gnus-thread-ignore-subject) (not (zerop gnus-tmp-level)) gnus-tmp-prev-subject - (not (inline - (gnus-subject-equal gnus-tmp-prev-subject subject)))) + (not (string= gnus-tmp-prev-subject simp-subject))) (setq new-roots (nconc new-roots (list (car thread))) thread-end t gnus-tmp-header nil)) @@ -4421,7 +4616,9 @@ or a straight list of headers." (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) + (setq gnus-newsgroup-expirable + (gnus-add-to-sorted-list + gnus-newsgroup-expirable number)) (push (cons number gnus-low-score-mark) gnus-newsgroup-reads)))) @@ -4449,15 +4646,13 @@ or a straight list of headers." (cond ((and gnus-thread-ignore-subject gnus-tmp-prev-subject - (not (inline (gnus-subject-equal - gnus-tmp-prev-subject subject)))) + (not (string= gnus-tmp-prev-subject simp-subject))) subject) ((zerop gnus-tmp-level) (if (and (eq gnus-summary-make-false-root 'empty) (memq number gnus-tmp-gathered) gnus-tmp-prev-subject - (inline (gnus-subject-equal - gnus-tmp-prev-subject subject))) + (string= gnus-tmp-prev-subject simp-subject)) gnus-summary-same-subject subject)) (t gnus-summary-same-subject))) @@ -4542,7 +4737,7 @@ or a straight list of headers." (gnus-run-hooks 'gnus-summary-update-hook) (forward-line 1)) - (setq gnus-tmp-prev-subject subject))) + (setq gnus-tmp-prev-subject simp-subject))) (when (nth 1 thread) (push (list (max 0 gnus-tmp-level) @@ -4713,8 +4908,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq cached gnus-newsgroup-cached)) (setq gnus-newsgroup-unreads - (gnus-set-difference - (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) + (gnus-sorted-ndifference + (gnus-sorted-ndifference gnus-newsgroup-unreads + gnus-newsgroup-marked) gnus-newsgroup-dormant)) (setq gnus-newsgroup-processable nil) @@ -4724,12 +4920,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Adjust and set lists of article marks. (when info (gnus-adjust-marked-articles info)) - (if (setq articles select-articles) (setq gnus-newsgroup-unselected - (gnus-sorted-intersection - gnus-newsgroup-unreads - (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (gnus-sorted-difference gnus-newsgroup-unreads articles)) (setq articles (gnus-articles-to-read group read-all))) (cond @@ -4743,6 +4936,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-make-hashtable (length articles))) (gnus-set-global-variables) ;; Retrieve the headers and read them in. + (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) ;; Kludge to avoid having cached articles nixed out in virtual groups. @@ -4761,20 +4955,13 @@ If SELECT-ARTICLES, only select those articles from GROUP." gnus-newsgroup-headers)) (setq gnus-newsgroup-articles fetched-articles) (setq gnus-newsgroup-unreads - (gnus-set-sorted-intersection + (gnus-sorted-nintersection gnus-newsgroup-unreads fetched-articles)) - - ;; The `seen' marks are treated specially. - (if (not gnus-newsgroup-seen) - (setq gnus-newsgroup-unseen gnus-newsgroup-articles) - (dolist (article gnus-newsgroup-articles) - (unless (gnus-member-of-range article gnus-newsgroup-seen) - (push article gnus-newsgroup-unseen))) - (setq gnus-newsgroup-unseen (nreverse gnus-newsgroup-unseen))) + (gnus-compute-unseen-list) ;; Removed marked articles that do not exist. (gnus-update-missing-marks - (gnus-sorted-complement fetched-articles articles)) + (gnus-sorted-difference articles fetched-articles)) ;; We might want to build some more threads first. (when (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)) @@ -4803,19 +4990,29 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; GROUP is successfully selected. (or gnus-newsgroup-headers t))))) +(defun gnus-compute-unseen-list () + ;; The `seen' marks are treated specially. + (if (not gnus-newsgroup-seen) + (setq gnus-newsgroup-unseen gnus-newsgroup-articles) + (setq gnus-newsgroup-unseen + (gnus-inverse-list-range-intersection + gnus-newsgroup-articles gnus-newsgroup-seen)))) + (defun gnus-summary-display-make-predicate (display) (require 'gnus-agent) (when (= (length display) 1) (setq display (car display))) (unless gnus-summary-display-cache - (dolist (elem (append (list (cons 'read 'read) - (cons 'unseen 'unseen)) + (dolist (elem (append '((unread . unread) + (read . read) + (unseen . unseen)) gnus-article-mark-lists)) (push (cons (cdr elem) (gnus-byte-compile `(lambda () (gnus-article-marked-p ',(cdr elem))))) gnus-summary-display-cache))) - (let ((gnus-category-predicate-alist gnus-summary-display-cache)) + (let ((gnus-category-predicate-alist gnus-summary-display-cache) + (gnus-category-predicate-cache gnus-summary-display-cache)) (gnus-get-predicate display))) ;; Uses the dynamically bound `number' variable. @@ -4825,6 +5022,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (cond ((eq type 'tick) (memq article gnus-newsgroup-marked)) + ((eq type 'spam) + (memq article gnus-newsgroup-spam-marked)) ((eq type 'unsend) (memq article gnus-newsgroup-unsendable)) ((eq type 'undownload) @@ -4867,7 +5066,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (if (or read-all (and (zerop (length gnus-newsgroup-marked)) (zerop (length gnus-newsgroup-unreads))) - (eq gnus-newsgroup-display 'gnus-not-ignore)) + ;; Fetch all if the predicate is non-nil. + gnus-newsgroup-display) ;; We want to select the headers for all the articles in ;; the group, so we select either all the active ;; articles in the group, or (if that's nil), the @@ -4876,9 +5076,9 @@ 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. - (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked - (copy-sequence gnus-newsgroup-unreads)) - '<))) + (gnus-sorted-nunion + (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked) + gnus-newsgroup-unreads))) (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) (scored (length scored-list)) (number (length articles)) @@ -4888,26 +5088,30 @@ If SELECT-ARTICLES, only select those articles from GROUP." (cond ((numberp read-all) read-all) + ((numberp gnus-newsgroup-display) + gnus-newsgroup-display) (t (condition-case () (cond ((and (or (<= scored marked) (= scored number)) - (natnump gnus-large-newsgroup) + (numberp gnus-large-newsgroup) (> number gnus-large-newsgroup)) (let* ((cursor-in-echo-area nil) + (initial (gnus-parameter-large-newsgroup-initial + gnus-newsgroup-name)) (input - (read-from-minibuffer + (read-string (format - "How many articles from %s (max %d): " + "How many articles from %s (%s %d): " (gnus-limit-string (gnus-group-decoded-name gnus-newsgroup-name) 35) + (if initial "max" "default") number) - (cons (number-to-string gnus-large-newsgroup) - 0)))) - (if (string-match "^[ \t]*$" input) - number - input))) + (if initial + (cons (number-to-string initial) + 0))))) + (if (string-match "^[ \t]*$" input) number input))) ((and (> scored marked) (< scored number) (> (- scored number) 20)) (let ((input @@ -4938,9 +5142,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Select the N most recent articles. (setq articles (nthcdr (- number select) articles)))) (setq gnus-newsgroup-unselected - (gnus-sorted-intersection - gnus-newsgroup-unreads - (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (gnus-sorted-difference gnus-newsgroup-unreads articles)) (when gnus-alter-articles-to-read-function (setq gnus-newsgroup-unreads (sort @@ -5508,29 +5710,24 @@ Return a list of headers that match SEQUENCE (see ;; Allow the user to mangle the headers before parsing them. (gnus-run-hooks 'gnus-parse-headers-hook) (goto-char (point-min)) - (while (not (eobp)) - (condition-case () - (while (and (or sequence allp) - (not (eobp))) - (setq number (read cur)) - (when (not allp) - (while (and sequence - (< (car sequence) number)) - (setq sequence (cdr sequence)))) - (when (and (or allp - (and sequence - (eq number (car sequence)))) - (progn - (setq sequence (cdr sequence)) - (setq header (inline - (gnus-nov-parse-line - number dependencies force-new))))) - (push header headers)) - (forward-line 1)) - (error - (gnus-error 4 "Strange nov line (%d)" - (count-lines (point-min) (point))))) - (forward-line 1)) + (gnus-parse-without-error + (while (and (or sequence allp) + (not (eobp))) + (setq number (read cur)) + (when (not allp) + (while (and sequence + (< (car sequence) number)) + (setq sequence (cdr sequence)))) + (when (and (or allp + (and sequence + (eq number (car sequence)))) + (progn + (setq sequence (cdr sequence)) + (setq header (inline + (gnus-nov-parse-line + number dependencies force-new))))) + (push header headers)) + (forward-line 1))) ;; A common bug in inn is that if you have posted an article and ;; then retrieves the active file, it will answer correctly -- ;; the new article is included. However, a NOV entry for the @@ -5929,13 +6126,13 @@ displayed, no centering will be performed." (marked (gnus-info-marks info)) (active (gnus-active group))) (and info active - (gnus-set-difference - (gnus-sorted-complement - (gnus-uncompress-range active) - (gnus-list-of-unread-articles group)) - (append - (gnus-uncompress-range (cdr (assq 'dormant marked))) - (gnus-uncompress-range (cdr (assq 'tick marked)))))))) + (gnus-list-range-difference + (gnus-list-range-difference + (gnus-sorted-complement + (gnus-uncompress-range active) + (gnus-list-of-unread-articles group)) + (cdr (assq 'dormant marked))) + (cdr (assq 'tick marked)))))) ;; Various summary commands @@ -6012,13 +6209,10 @@ The prefix argument ALL means to select all articles." (when gnus-newsgroup-kill-headers (setq gnus-newsgroup-killed (gnus-compress-sequence - (nconc - (gnus-set-sorted-intersection - (gnus-uncompress-range gnus-newsgroup-killed) - (setq gnus-newsgroup-unselected - (sort gnus-newsgroup-unselected '<))) - (setq gnus-newsgroup-unreads - (sort gnus-newsgroup-unreads '<))) + (gnus-sorted-union + (gnus-list-range-intersection + gnus-newsgroup-unselected gnus-newsgroup-killed) + gnus-newsgroup-unreads) t))) (unless (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) @@ -6028,7 +6222,8 @@ The prefix argument ALL means to select all articles." (set-buffer gnus-group-buffer) (gnus-undo-force-boundary)) (gnus-update-read-articles - group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) + group (gnus-sorted-union + gnus-newsgroup-unreads gnus-newsgroup-unselected)) ;; Set the current article marks. (let ((gnus-newsgroup-scored (if (and (not gnus-save-score) @@ -6369,10 +6564,6 @@ previous group instead." (let ((current-group gnus-newsgroup-name) (current-buffer (current-buffer)) entered) - ;; First we semi-exit this group to update Xrefs and all variables. - ;; We can't do a real exit, because the window conf must remain - ;; the same in case the user is prompted for info, and we don't - ;; want the window conf to change before that... (gnus-summary-exit t) (while (not entered) ;; Then we find what group we are supposed to enter. @@ -6398,10 +6589,20 @@ previous group instead." (let ((unreads (gnus-group-group-unread))) (if (and (or (eq t unreads) (and unreads (not (zerop unreads)))) - (gnus-summary-read-group - target-group nil no-article - (and (buffer-name current-buffer) current-buffer) - nil backward)) + (progn + ;; Now we semi-exit this group to update Xrefs + ;; and all variables. We can't do a real exit, + ;; because the window conf must remain the same + ;; in case the user is prompted for info, and we + ;; don't want the window conf to change before + ;; that... + (when (gnus-buffer-live-p current-buffer) + (set-buffer current-buffer) + (gnus-summary-exit t)) + (gnus-summary-read-group + target-group nil no-article + (and (buffer-name current-buffer) current-buffer) + nil backward))) (setq entered t) (setq current-group target-group target-group nil))))))) @@ -6592,20 +6793,18 @@ be displayed." ;; The requested article is different from the current article. (progn (gnus-summary-display-article article all-headers) -;;; Hidden headers are not hidden text any more. -;; (when (or all-headers gnus-show-all-headers) -;; (gnus-article-show-all-headers)) (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))) article) -;; (when (or all-headers gnus-show-all-headers) -;; (gnus-article-show-all-headers)) 'old)))) (defun gnus-summary-force-verify-and-decrypt () (interactive) (let ((mm-verify-option 'known) - (mm-decrypt-option 'known)) + (mm-decrypt-option 'known) + (gnus-buttonized-mime-types (append (list "multipart/signed" + "multipart/encrypted") + gnus-buttonized-mime-types))) (gnus-summary-select-article nil 'force))) (defun gnus-summary-set-current-mark (&optional current-mark) @@ -7173,7 +7372,7 @@ If ALL is non-nil, limit strictly to unread articles." ;; Concat all the marks that say that an article is read and have ;; those removed. (list gnus-del-mark gnus-read-mark gnus-ancient-mark - gnus-killed-mark gnus-kill-file-mark + gnus-killed-mark gnus-spam-mark gnus-kill-file-mark gnus-low-score-mark gnus-expirable-mark gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark gnus-duplicate-mark gnus-souped-mark) @@ -7181,7 +7380,7 @@ If ALL is non-nil, limit strictly to unread articles." (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) (make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exlude-marks) + 'gnus-summary-limit-exclude-marks) (defun gnus-summary-limit-exclude-marks (marks &optional reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). @@ -7225,6 +7424,13 @@ Returns how many articles were removed." (gnus-summary-limit articles) (gnus-summary-position-point)))) +(defun gnus-summary-limit-to-unseen () + "Limit to unseen articles." + (interactive) + (prog1 + (gnus-summary-limit gnus-newsgroup-unseen) + (gnus-summary-position-point))) + (defun gnus-summary-limit-include-thread (id) "Display all the hidden articles that is in the thread with ID in it. When called interactively, ID is the Message-ID of the current @@ -7295,15 +7501,17 @@ fetched for this group." "Mark all unread excluded articles as read. If ALL, mark even excluded ticked and dormants as read." (interactive "P") - (let ((articles (gnus-sorted-complement + (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<)) + (let ((articles (gnus-sorted-ndifference (sort (mapcar (lambda (h) (mail-header-number h)) gnus-newsgroup-headers) '<) - (sort gnus-newsgroup-limit '<))) + gnus-newsgroup-limit)) article) (setq gnus-newsgroup-unreads - (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-limit)) + (gnus-sorted-intersection gnus-newsgroup-unreads + gnus-newsgroup-limit)) (if all (setq gnus-newsgroup-dormant nil gnus-newsgroup-marked nil @@ -7723,8 +7931,8 @@ to guess what the document format is." (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"))) + (when (setq to-address (or (gnus-fetch-field "reply-to") + (gnus-fetch-field "from"))) (setq params (append (list (cons 'to-address (funcall gnus-decode-encoded-word-function @@ -8102,12 +8310,19 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." ;; We don't want to change current point nor window configuration. (save-excursion (save-window-excursion - (gnus-message 6 "Executing %s..." (key-description command)) - ;; We'd like to execute COMMAND interactively so as to give arguments. - (gnus-execute header regexp - `(call-interactively ',(key-binding command)) - backward) - (gnus-message 6 "Executing %s...done" (key-description command))))) + (let (gnus-visual + gnus-treat-strip-trailing-blank-lines + gnus-treat-strip-leading-blank-lines + gnus-treat-strip-multiple-blank-lines + gnus-treat-hide-boring-headers + gnus-treat-fold-newsgroups + gnus-article-prepare-hook) + (gnus-message 6 "Executing %s..." (key-description command)) + ;; We'd like to execute COMMAND interactively so as to give arguments. + (gnus-execute header regexp + `(call-interactively ',(key-binding command)) + backward) + (gnus-message 6 "Executing %s...done" (key-description command)))))) (defun gnus-summary-beginning-of-article () "Scroll the article back to the beginning." @@ -8164,6 +8379,7 @@ to save in." (copy-to-buffer buffer (point-min) (point-max)) (set-buffer buffer) (gnus-article-delete-invisible-text) + (gnus-remove-text-with-property 'gnus-decoration) (when (gnus-visual-p 'article-highlight 'highlight) ;; Copy-to-buffer doesn't copy overlay. So redo ;; highlight. @@ -8283,36 +8499,38 @@ If ARG is a negative number, turn header display off." If ARG is a positive number, show the entire header. If ARG is a negative number, hide the unwanted header lines." (interactive "P") - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction + (let ((window (and (gnus-buffer-live-p gnus-article-buffer) + (get-buffer-window gnus-article-buffer t)))) + (with-current-buffer gnus-article-buffer + (widen) + (article-narrow-to-head) (let* ((buffer-read-only nil) (inhibit-point-motion-hooks t) - hidden e) - (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)))) - (goto-char (point-min)) - (save-excursion - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) - (insert-buffer-substring gnus-original-article-buffer 1 e) - (save-restriction - (narrow-to-region (point-min) (point)) - (article-decode-encoded-words) - (if hidden - (let ((gnus-treat-hide-headers nil) - (gnus-treat-hide-boring-headers nil)) - (gnus-delete-wash-type 'headers) - (gnus-treat-article 'head)) - (gnus-treat-article 'head))) + (hidden (if (numberp arg) + (>= arg 0) + (gnus-article-hidden-text-p 'headers))) + s e) + (delete-region (point-min) (point-max)) + (with-current-buffer gnus-original-article-buffer + (goto-char (setq s (point-min))) + (setq e (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max)))) + (insert-buffer-substring gnus-original-article-buffer s e) + (article-decode-encoded-words) + (if hidden + (let ((gnus-treat-hide-headers nil) + (gnus-treat-hide-boring-headers nil)) + (gnus-delete-wash-type 'headers) + (gnus-treat-article 'head)) + (gnus-treat-article 'head)) + (widen) + (if window + (set-window-start window (goto-char (point-min)))) + (setq gnus-page-broken + (when gnus-break-pages + (gnus-narrow-to-page) + t)) (gnus-set-mode-line 'article))))) (defun gnus-summary-show-all-headers () @@ -8345,6 +8563,31 @@ forward." (message-caesar-buffer-body arg) (set-window-start (get-buffer-window (current-buffer)) start)))))) +(autoload 'unmorse-region "morse" + "Convert morse coded text in region to ordinary ASCII text." + t) + +(defun gnus-summary-morse-message (&optional arg) + "Morse decode the current article." + (interactive "P") + (gnus-summary-select-article) + (let ((mail-header-separator "")) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-excursion + (save-restriction + (widen) + (let ((pos (window-start)) + buffer-read-only) + (goto-char (point-min)) + (when (message-goto-body) + (gnus-narrow-to-body)) + (goto-char (point-min)) + (while (re-search-forward "ยท" (point-max) t) + (replace-match ".")) + (unmorse-region (point-min) (point-max)) + (widen) + (set-window-start (get-buffer-window (current-buffer)) pos))))))) + (defun gnus-summary-stop-page-breaking () "Stop page breaking in the current article." (interactive) @@ -8368,6 +8611,10 @@ If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but re-spool using this method. +When called interactively with TO-NEWSGROUP being nil, the value of +the variable `gnus-move-split-methods' is used for finding a default +for the target newsgroup. + 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. @@ -8401,16 +8648,21 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." art-group to-method new-xref article to-groups) (unless (assq action names) (error "Unknown action %s" action)) - ;; We have to select an article to give - ;; `gnus-read-move-group-name' an opportunity to suggest an - ;; appropriate default. - (unless (gnus-buffer-live-p gnus-original-article-buffer) - (let ((gnus-display-mime-function nil) - (gnus-article-prepare-hook nil)) - (gnus-summary-select-article nil nil nil (car articles)))) ;; Read the newsgroup name. (when (and (not to-newsgroup) (not select-method)) + (if (and gnus-move-split-methods + (not + (and (memq gnus-current-article articles) + (gnus-buffer-live-p gnus-original-article-buffer)))) + ;; When `gnus-move-split-methods' is non-nil, we have to + ;; select an article to give `gnus-read-move-group-name' an + ;; opportunity to suggest an appropriate default. However, + ;; we needn't render or mark the article. + (let ((gnus-display-mime-function nil) + (gnus-article-prepare-hook nil) + (gnus-mark-article-hook nil)) + (gnus-summary-select-article nil nil nil (car articles)))) (setq to-newsgroup (gnus-read-move-group-name (cadr (assq action names)) @@ -8600,6 +8852,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Move the current article to a different newsgroup. If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. +When called interactively, if TO-NEWSGROUP is nil, use the value of +the variable `gnus-move-split-methods' for finding a default target +newsgroup. If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but re-spool using this method." (interactive "P") @@ -8784,12 +9039,10 @@ This will be the case if the article has both been mailed and posted." ;; really expired articles as nonexistent. (unless (eq es expirable) ;If nothing was expired, we don't mark. (let ((gnus-use-cache nil)) - (while expirable - (unless (memq (car expirable) es) - (when (gnus-data-find (car expirable)) - (gnus-summary-mark-article - (car expirable) gnus-canceled-mark))) - (setq expirable (cdr expirable)))))) + (dolist (article expirable) + (when (and (not (memq article es)) + (gnus-data-find article)) + (gnus-summary-mark-article article gnus-canceled-mark)))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -8820,6 +9073,7 @@ delete these instead." (error "Couldn't open server")) ;; Compute the list of articles to delete. (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) + (nnmail-expiry-target 'delete) not-deleted) (if (and gnus-novice-user (not (gnus-yes-or-no-p @@ -8925,10 +9179,7 @@ groups." (insert ".\n") (let ((nntp-server-buffer (current-buffer))) (setq header (car (gnus-get-newsgroup-headers - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies) - t)))) + nil t)))) (save-excursion (set-buffer gnus-summary-buffer) (gnus-data-set-header @@ -9127,6 +9378,13 @@ the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-forward n gnus-expirable-mark)) +(defun gnus-summary-mark-as-spam (n) + "Mark N articles forward as spam. +If N is negative, mark backward instead. The difference between N and +the actual number of articles marked is returned." + (interactive "p") + (gnus-summary-mark-forward n gnus-spam-mark)) + (defun gnus-summary-mark-article-as-replied (article) "Mark ARTICLE as replied to and update the summary line. ARTICLE can also be a list of articles." @@ -9257,6 +9515,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (let ((article (gnus-summary-article-number))) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. @@ -9288,15 +9547,26 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-error 1 "Can't mark negative article numbers") nil) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (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)) (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) + (setq gnus-newsgroup-marked + (gnus-add-to-sorted-list gnus-newsgroup-marked + article))) + ((= mark gnus-spam-mark) + (setq gnus-newsgroup-spam-marked + (gnus-add-to-sorted-list gnus-newsgroup-spam-marked + article))) ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) + (setq gnus-newsgroup-dormant + (gnus-add-to-sorted-list gnus-newsgroup-dormant + article))) (t - (push article gnus-newsgroup-unreads))) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads + article)))) (gnus-pull article gnus-newsgroup-reads) ;; See whether the article is to be put in the cache. @@ -9341,6 +9611,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (error "No article on current line")) (if (not (if (or (= mark gnus-unread-mark) (= mark gnus-ticked-mark) + (= mark gnus-spam-mark) (= mark gnus-dormant-mark)) (gnus-mark-article-as-unread article mark) (gnus-mark-article-as-read article mark))) @@ -9408,12 +9679,14 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." "Enter ARTICLE in the pertinent lists and remove it from others." ;; Make the article expirable. (let ((mark (or mark gnus-del-mark))) - (if (= mark gnus-expirable-mark) - (push article gnus-newsgroup-expirable) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) + (setq gnus-newsgroup-expirable + (if (= mark gnus-expirable-mark) + (gnus-add-to-sorted-list gnus-newsgroup-expirable article) + (delq article gnus-newsgroup-expirable))) ;; Remove from unread and marked lists. (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. @@ -9429,6 +9702,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-error 1 "Can't mark negative article numbers") nil) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked) + gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked) gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant) gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable) gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) @@ -9438,11 +9712,17 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (gnus-dup-unsuppress-article article)) (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) + (setq gnus-newsgroup-marked + (gnus-add-to-sorted-list gnus-newsgroup-marked article))) + ((= mark gnus-spam-mark) + (setq gnus-newsgroup-spam-marked + (gnus-add-to-sorted-list gnus-newsgroup-spam-marked article))) ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) + (setq gnus-newsgroup-dormant + (gnus-add-to-sorted-list gnus-newsgroup-dormant article))) (t - (push article gnus-newsgroup-unreads))) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads article)))) (gnus-pull article gnus-newsgroup-reads) t))) @@ -9650,6 +9930,7 @@ The number of articles marked as read is returned." (progn (when all (setq gnus-newsgroup-marked nil + gnus-newsgroup-spam-marked nil gnus-newsgroup-dormant nil)) (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable)) ;; We actually mark all articles as canceled, which we @@ -10081,6 +10362,12 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'number reverse)) +(defun gnus-summary-sort-by-random (&optional reverse) + "Randomize the order in the summary buffer. +Argument REVERSE means to randomize in reverse order." + (interactive "P") + (gnus-summary-sort 'random reverse)) + (defun gnus-summary-sort-by-author (&optional reverse) "Sort the summary buffer by author name alphabetically. If `case-fold-search' is non-nil, case of letters is ignored. @@ -10402,7 +10689,8 @@ If REVERSE, save parts that do not match TYPE." (save-excursion (set-buffer gnus-article-buffer) (let ((handles (or gnus-article-mime-handles - (mm-dissect-buffer) (mm-uu-dissect)))) + (mm-dissect-buffer nil gnus-article-loose-mime) + (mm-uu-dissect)))) (when handles (gnus-summary-save-parts-1 type dir handles reverse) (unless gnus-article-mime-handles ;; Don't destroy this case. @@ -10489,7 +10777,9 @@ If REVERSE, save parts that do not match TYPE." (gnus-data-enter after-article gnus-reffed-article-number gnus-unread-mark b (car pslist) 0 (- e b)) - (push gnus-reffed-article-number gnus-newsgroup-unreads) + (setq gnus-newsgroup-unreads + (gnus-add-to-sorted-list gnus-newsgroup-unreads + gnus-reffed-article-number)) (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) (setq pslist (cdr pslist))))))) @@ -10648,43 +10938,71 @@ If REVERSE, save parts that do not match TYPE." (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) 'face gnus-summary-selected-face)))))) +(defvar gnus-summary-highlight-line-cached nil) +(defvar gnus-summary-highlight-line-trigger nil) +(defun gnus-summary-highlight-line-0 () + (if (and (eq gnus-summary-highlight-line-trigger + gnus-summary-highlight) + gnus-summary-highlight-line-cached) + gnus-summary-highlight-line-cached + (setq gnus-summary-highlight-line-trigger gnus-summary-highlight + gnus-summary-highlight-line-cached + (let* ((cond (list 'cond)) + (c cond) + (list gnus-summary-highlight)) + (while list + (setcdr c (cons (list (caar list) (list 'quote (cdar list))) nil)) + (setq c (cdr c) + list (cdr list))) + (gnus-byte-compile (list 'lambda nil cond)))))) + +(defvar gnus-summary-highlight-line-downloaded-alist nil) +(defvar gnus-summary-highlight-line-downloaded-cached nil) + ;; New implementation by Christian Limpach . (defun gnus-summary-highlight-line () "Highlight current line according to `gnus-summary-highlight'." (let* ((list gnus-summary-highlight) - (p (point)) - (end (progn (end-of-line) (point))) - ;; now find out where the line starts and leave point there. - (beg (progn (beginning-of-line) (point))) + (beg (gnus-point-at-bol)) (article (gnus-summary-article-number)) (score (or (cdr (assq (or article gnus-current-article) gnus-newsgroup-scored)) gnus-summary-default-score 0)) (mark (or (gnus-summary-article-mark) gnus-unread-mark)) - (inhibit-read-only t)) - ;; Eval the cars of the lists until we find a match. - (let ((default gnus-summary-default-score) - (default-high gnus-summary-default-high-score) - (default-low gnus-summary-default-low-score)) - (while (and list - (not (eval (caar list)))) - (setq list (cdr list)))) - (let ((face (cdar list))) + (inhibit-read-only t) + (default gnus-summary-default-score) + (default-high gnus-summary-default-high-score) + (default-low gnus-summary-default-low-score) + (downloaded (and (boundp 'gnus-agent-article-alist) + gnus-agent-article-alist + ;; Optimized for when gnus-summary-highlight-line is called multiple times for articles in ascending order (i.e. initial generation of summary buffer). + (progn + (if (and (eq gnus-summary-highlight-line-downloaded-alist gnus-agent-article-alist) + (<= (caar gnus-summary-highlight-line-downloaded-cached) article)) + nil + (setq gnus-summary-highlight-line-downloaded-alist gnus-agent-article-alist + gnus-summary-highlight-line-downloaded-cached gnus-agent-article-alist)) + (let (n) + (while (and (< (caar gnus-summary-highlight-line-downloaded-cached) article) + (setq n (cdr gnus-summary-highlight-line-downloaded-cached))) + (setq gnus-summary-highlight-line-downloaded-cached n))) + (and (eq (caar gnus-summary-highlight-line-downloaded-cached) article) + (cdar gnus-summary-highlight-line-downloaded-cached)))))) + (let ((face (funcall (gnus-summary-highlight-line-0)))) (unless (eq face (get-text-property beg 'face)) (gnus-put-text-property-excluding-characters-with-faces - beg end 'face + beg (gnus-point-at-eol) 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function - (funcall gnus-summary-highlight-line-function article face)))) - (goto-char p))) + (funcall gnus-summary-highlight-line-function article face)))))) (defun gnus-update-read-articles (group unread &optional compute) - "Update the list of read articles in GROUP." + "Update the list of read articles in GROUP. +UNREAD is a sorted list." (let* ((active (or gnus-newsgroup-active (gnus-active group))) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) (prev 1) - (unread (sort (copy-sequence unread) '<)) read) (if (or (not info) (not active)) ;; There is no info on this group if it was, in fact, @@ -10806,46 +11124,29 @@ If REVERSE, save parts that do not match TYPE." ;;; (defun gnus-mime-extract-message/rfc822 (entity situation) - (let (group article num cwin swin cur) - (with-temp-buffer - (mime-insert-entity-content entity) - (setq group (or (cdr (assq 'group situation)) - (completing-read "Group: " - gnus-active-hashtb - nil - (gnus-read-active-file-p) - gnus-newsgroup-name)) - article (gnus-request-accept-article group))) - (when (and (consp article) - (numberp (setq article (cdr article)))) - (setq num (1+ (or (cdr (assq 'number situation)) 0)) - cwin (get-buffer-window (current-buffer) t)) - (save-window-excursion - (if (setq swin (get-buffer-window gnus-summary-buffer t)) - (select-window swin) - (set-buffer gnus-summary-buffer)) - (setq cur gnus-current-article) - (forward-line num) - (let (gnus-show-threads) - (gnus-summary-goto-subject article t)) - (gnus-summary-clear-mark-forward 1) - (gnus-summary-goto-subject cur)) - (when (and cwin (window-frame cwin)) - (select-frame (window-frame cwin))) - (when (boundp 'mime-acting-situation-to-override) - (set-alist 'mime-acting-situation-to-override - 'group - group) - (set-alist 'mime-acting-situation-to-override - 'after-method - `(progn - (save-current-buffer - (set-buffer gnus-group-buffer) - (gnus-activate-group ,group)) - (gnus-summary-goto-article ,cur - gnus-show-all-headers))) - (set-alist 'mime-acting-situation-to-override - 'number num))))) + "Burst a forwarded article." + (save-excursion + (set-buffer gnus-summary-buffer) + (let* ((group (completing-read "Group: " gnus-active-hashtb nil t + gnus-newsgroup-name 'gnus-group-history)) + (gnus-group-marked (list group)) + article info) + (with-temp-buffer + (mime-insert-entity-content entity) + (setq article (gnus-request-accept-article group))) + (when (and (consp article) + (numberp (setq article (cdr article)))) + (setq info (gnus-get-info group)) + (gnus-info-set-read info + (gnus-remove-from-range (gnus-info-read info) + (list article))) + (when (string-equal group gnus-newsgroup-name) + (forward-line 1) + (let (gnus-show-threads) + (gnus-summary-goto-subject article t)) + (gnus-summary-clear-mark-forward 1)) + (set-buffer gnus-group-buffer) + (gnus-group-get-new-news-this-group nil t))))) (mime-add-condition 'action '((type . message)(subtype . rfc822) @@ -10886,20 +11187,52 @@ If REVERSE, save parts that do not match TYPE." ;;; @ end ;;; +(defun gnus-summary-inherit-default-charset () + "Import `default-mime-charset' from summary buffer. +Also take care of `default-mime-charset-unlimited' if the LIMIT version +of FLIM is used." + (if (buffer-live-p gnus-summary-buffer) + (let (d-m-c d-m-c-u) + (with-current-buffer gnus-summary-buffer + (setq d-m-c (if (local-variable-p 'default-mime-charset + gnus-summary-buffer) + default-mime-charset + t) + ;; LIMIT + d-m-c-u (if (local-variable-p 'default-mime-charset-unlimited + gnus-summary-buffer) + (symbol-value 'default-mime-charset-unlimited) + t))) + (if (eq t d-m-c) + (kill-local-variable 'default-mime-charset) + (set (make-local-variable 'default-mime-charset) d-m-c)) + (if (eq t d-m-c-u) + (kill-local-variable 'default-mime-charset-unlimited) + (set (make-local-variable 'default-mime-charset-unlimited) + d-m-c-u))))) + (defun gnus-summary-setup-default-charset () "Setup newsgroup default charset." - (if (equal gnus-newsgroup-name "nndraft:drafts") - (setq gnus-newsgroup-charset nil) - (let* ((ignored-charsets - (or gnus-newsgroup-ephemeral-ignored-charsets - (append - (and gnus-newsgroup-name - (gnus-parameter-ignored-charsets gnus-newsgroup-name)) - gnus-newsgroup-ignored-charsets)))) + (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts")) + (progn + (setq gnus-newsgroup-charset nil) + (set (make-local-variable 'default-mime-charset) nil) + (when (boundp 'default-mime-charset-unlimited);; LIMIT + (set (make-local-variable 'default-mime-charset-unlimited) nil))) + (let ((ignored-charsets + (or gnus-newsgroup-ephemeral-ignored-charsets + (append + (and gnus-newsgroup-name + (gnus-parameter-ignored-charsets gnus-newsgroup-name)) + gnus-newsgroup-ignored-charsets))) + charset) (setq gnus-newsgroup-charset (or gnus-newsgroup-ephemeral-charset - (and gnus-newsgroup-name - (gnus-parameter-charset gnus-newsgroup-name)) + (when (and gnus-newsgroup-name + (setq charset (gnus-parameter-charset + gnus-newsgroup-name))) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) gnus-default-charset)) (set (make-local-variable 'gnus-newsgroup-ignored-charsets) ignored-charsets)))) @@ -11124,9 +11457,10 @@ returned." (defun gnus-summary-insert-articles (articles) (when (setq articles - (gnus-set-difference articles - (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers))) + (gnus-sorted-difference articles + (mapcar (lambda (h) + (mail-header-number h)) + gnus-newsgroup-headers))) (setq gnus-newsgroup-headers (merge 'list gnus-newsgroup-headers @@ -11164,61 +11498,93 @@ If ALL is non-nil, already read articles become readable. If ALL is a number, fetch this number of articles." (interactive "P") (prog1 - (let ((old (mapcar 'car gnus-newsgroup-data)) - (i (car gnus-newsgroup-active)) + (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) older len) - (while (<= i (cdr gnus-newsgroup-active)) - (or (memq i old) (push i older)) - (incf i)) - (setq len (length older)) + (setq older +;;; Some nntp servers lie about their active range. When this happens, the active range can be in the millions. +;;; (gnus-sorted-difference +;;; (gnus-uncompress-range (list gnus-newsgroup-active)) +;;; old) + (gnus-remove-from-range (list gnus-newsgroup-active) old) +) + (setq len (gnus-range-length older)) (cond ((null older) nil) ((numberp all) (if (< all len) - (setq older (subseq older 0 all)))) + (let ((older-range (nreverse older))) + (setq older nil) + + (while (> all 0) + (let* ((r (pop older-range)) + (min (if (numberp r) r (car r))) + (max (if (numberp r) r (cdr r)))) + (while (and (<= min max) + (> all 0)) + (push max older) + (setq all (1- all) + max (1- max)))))) + (setq older (gnus-uncompress-range older)))) (all nil) (t (if (and (numberp gnus-large-newsgroup) (> len gnus-large-newsgroup)) - (let ((input - (read-string - (format - "How many articles from %s (default %d): " - (gnus-limit-string - (gnus-group-decoded-name gnus-newsgroup-name) 35) - len)))) + (let* ((cursor-in-echo-area nil) + (initial (gnus-parameter-large-newsgroup-initial + gnus-newsgroup-name)) + (input + (read-string + (format + "How many articles from %s (%s %d): " + (gnus-limit-string + (gnus-group-decoded-name gnus-newsgroup-name) 35) + (if initial "max" "default") + len) + (if initial + (cons (number-to-string initial) + 0))))) (unless (string-match "^[ \t]*$" input) (setq all (string-to-number input)) (if (< all len) - (setq older (subseq older 0 all)))))))) + (let ((older-range (nreverse older))) + (setq older nil) + + (while (> all 0) + (let* ((r (pop older-range)) + (min (if (numberp r) r (car r))) + (max (if (numberp r) r (cdr r)))) + (while (and (<= min max) + (> all 0)) + (push max older) + (setq all (1- all) + max (1- max)))))) + (setq older (gnus-uncompress-range older)))))))) (if (not older) (message "No old news.") - (let ((gnus-fetch-old-headers t)) - (gnus-summary-insert-articles older)) - (gnus-summary-limit (gnus-union older old)))) + (gnus-summary-insert-articles older) + (gnus-summary-limit (gnus-sorted-nunion old older)))) (gnus-summary-position-point))) (defun gnus-summary-insert-new-articles () "Insert all new articles in this group." (interactive) (prog1 - (let ((old (mapcar 'car gnus-newsgroup-data)) + (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) (old-active gnus-newsgroup-active) (nnmail-fetched-sources (list t)) i new) (setq gnus-newsgroup-active (gnus-activate-group gnus-newsgroup-name 'scan)) - (setq i (1+ (cdr old-active))) - (while (<= i (cdr gnus-newsgroup-active)) + (setq i (cdr gnus-newsgroup-active)) + (while (> i (cdr old-active)) (push i new) - (incf i)) + (decf i)) (if (not new) (message "No gnus is bad news.") - (setq new (nreverse new)) (gnus-summary-insert-articles new) (setq gnus-newsgroup-unreads - (append gnus-newsgroup-unreads new)) - (gnus-summary-limit (gnus-union old new)))) + (gnus-sorted-nunion gnus-newsgroup-unreads new)) + (gnus-summary-limit (gnus-sorted-nunion old new)))) (gnus-summary-position-point))) (gnus-summary-make-all-marking-commands)