X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=dd18ff81eb29529f8b58fcb151e1fa35056b022f;hb=f8dd47a59e3ac85b7e14ff87732f1c597de84254;hp=b14d2b0d3a05f415accc22a1a5d16046d4b6a0b5;hpb=f2be2e1577b74a59603a31c49c2f4d32e50b5592;p=gnus diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index b14d2b0d3..dd18ff81e 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,5 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -36,14 +36,16 @@ (require 'gnus-undo) (require 'gnus-util) (require 'mm-decode) -;; Recursive :-(. -;; (require 'gnus-art) (require 'nnoo) + (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) (autoload 'gnus-cache-write-active "gnus-cache") (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. @@ -134,8 +136,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)) @@ -235,6 +238,7 @@ simplification is selected." (defcustom gnus-thread-hide-subtree nil "*If non-nil, hide all threads initially. +This can be a predicate specifier which says which threads to hide. If threads are hidden, you have to run the command `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' to expose hidden threads." @@ -278,25 +282,33 @@ equal will be included." :type 'boolean) (defcustom gnus-auto-select-first t - "*If nil, don't select the first unread article when entering a group. -If this variable is `best', select the highest-scored unread article -in the group. If t, select the first unread article. - -This variable can also be a function to place point on a likely -subject line. Useful values include `gnus-summary-first-unread-subject', -`gnus-summary-first-unread-article' and -`gnus-summary-best-unread-article'. - -If you want to prevent automatic selection of the first unread article -in some newsgroups, set the variable to nil in -`gnus-select-group-hook'." + "*If non-nil, select the article under point. +Which article this is is controlled by the `gnus-auto-select-subject' +variable. + +If you want to prevent automatic selection of articles in some +newsgroups, set the variable to nil in `gnus-select-group-hook'." :group 'gnus-group-select :type '(choice (const :tag "none" nil) - (const best) - (sexp :menu-tag "first" t) - (function-item gnus-summary-first-unread-subject) - (function-item gnus-summary-first-unread-article) - (function-item gnus-summary-best-unread-article))) + (sexp :menu-tag "first" t))) + +(defcustom gnus-auto-select-subject 'unread + "*Says what subject to place under point when entering a group. + +This variable can either be the symbols `first' (place point on the +first subject), `unread' (place point on the subject line of the first +unread article), `best' (place point on the subject line of the +higest-scored article), `unseen' (place point on the subject line of +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." + :group 'gnus-group-select + :type '(choice (const best) + (const unread) + (const first) + (const unseen) + (const unseen-or-unread))) (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. @@ -409,6 +421,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 @@ -525,7 +542,7 @@ this variable specifies group names." :type 'boolean) (defcustom gnus-auto-expirable-marks - (list gnus-killed-mark gnus-del-mark gnus-catchup-mark + (list gnus-spam-mark gnus-killed-mark gnus-del-mark gnus-catchup-mark gnus-low-score-mark gnus-ancient-mark gnus-read-mark gnus-souped-mark gnus-duplicate-mark) "*The list of marks converted into expiration if a group is auto-expirable." @@ -566,7 +583,11 @@ list of parameters to that command." It works along the same lines as a normal formatting string, with some simple extensions. -%S The subject" +%S The subject + +General format specifiers can also be used. +See `(gnus)Formatting Variables'." + :link '(custom-manual "(gnus)Formatting Variables") :group 'gnus-threading :type 'string) @@ -651,7 +672,9 @@ was sent, sorting by number means sorting by arrival time.) 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' and +`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-total-score' (see `gnus-thread-score-function'). When threading is turned off, the variable @@ -743,15 +766,14 @@ If you'd like to simplify subjects like the `gnus-summary-next-same-subject' command does, you can use the following hook: - (setq gnus-select-group-hook - (list - (lambda () - (mapcar (lambda (header) - (mail-header-set-subject - header - (gnus-simplify-subject - (mail-header-subject header) 're-only))) - gnus-newsgroup-headers))))" + (add-hook gnus-select-group-hook + (lambda () + (mapcar (lambda (header) + (mail-header-set-subject + header + (gnus-simplify-subject + (mail-header-subject header) 're-only))) + gnus-newsgroup-headers)))" :group 'gnus-group-select :type 'hook) @@ -821,30 +843,30 @@ 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)) + ((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))) @@ -890,7 +912,7 @@ which it may alter in any way.") (defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string "Variable that says which function should be used to decode a string with encoded words.") -(defcustom gnus-extra-headers nil +(defcustom gnus-extra-headers '(To Newsgroups) "*Extra headers to parse." :version "21.1" :group 'gnus-summary @@ -975,14 +997,6 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :type '(choice (const nil) integer)) -(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-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 @@ -998,6 +1012,22 @@ that were fetched. Say, for nnultimate groups." :group 'gnus-summary :type '(choice boolean regexp)) +(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) @@ -1021,9 +1051,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) @@ -1082,7 +1109,7 @@ that were fetched. Say, for nnultimate groups." (?u gnus-tmp-user-defined ?s) (?P (gnus-pick-line-number) ?d) (?B gnus-tmp-thread-tree-header-string ?s) - (user-date (gnus-user-date + (user-date (gnus-user-date ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s)) "An alist of format specifications that can appear in summary lines. These are paired with what variables they correspond with, along with @@ -1132,10 +1159,10 @@ the type of the variable (string, integer, character, etc).") (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.") @@ -1143,13 +1170,13 @@ the type of the variable (string, integer, character, etc).") (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-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.") @@ -1166,13 +1193,13 @@ the type of the variable (string, integer, character, etc).") "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..") @@ -1184,7 +1211,7 @@ the type of the variable (string, integer, character, etc).") "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.") @@ -1263,7 +1290,19 @@ the type of the variable (string, integer, character, etc).") "Variables that are buffer-local to the summary buffers.") (defvar gnus-newsgroup-variables nil - "Variables that have separate values in the newsgroups.") + "A list of variables that have separate values in different newsgroups. +A list of newsgroup (summary buffer) local variables, or cons of +variables and their default values (when the default values are not +nil), that should be made global while the summary buffer is active. +These variables can be used to set variables in the group parameters +while still allowing them to affect operations done in other +buffers. For example: + +\(setq gnus-newsgroup-variables + '(message-use-followup-to + (gnus-visible-headers . + \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\"))) +") ;; Byte-compiler warning. (eval-when-compile (defvar gnus-article-mode-map)) @@ -1274,13 +1313,13 @@ the type of the 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 -(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups +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. For example: -((\"chinese\" . gnus-decode-encoded-word-string-by-guess) +\((\"chinese\" . gnus-decode-encoded-word-string-by-guess) mail-decode-encoded-word-string (\"chinese\" . rfc1843-decode-string))") @@ -1324,6 +1363,13 @@ 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) @@ -1530,6 +1576,7 @@ increase the score of each group you read." gnus-mouse-2 gnus-mouse-pick-article "m" gnus-summary-mail-other-window "a" gnus-summary-post-news + "i" gnus-summary-news-other-window "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article "t" gnus-summary-toggle-header @@ -1698,16 +1745,18 @@ increase the score of each group you read." "6" gnus-article-de-base64-unreadable "Z" gnus-article-decode-HZ "h" gnus-article-wash-html + "u" gnus-article-unsplit-urls "s" gnus-summary-force-verify-and-decrypt "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message "t" gnus-summary-toggle-header - "g" gnus-summary-toggle-smiley + "g" gnus-treat-smiley "v" gnus-summary-verbose-headers "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 @@ -1728,6 +1777,19 @@ increase the score of each group you read." "c" gnus-article-highlight-citation "s" gnus-article-highlight-signature) + (gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map) + "f" gnus-article-treat-fold-headers + "u" gnus-article-treat-unfold-headers + "n" gnus-article-treat-fold-newsgroups) + + (gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map) + "x" gnus-article-display-x-face + "s" gnus-treat-smiley + "D" gnus-article-remove-images + "f" gnus-treat-from-picon + "m" gnus-treat-mail-picon + "n" gnus-treat-newsgroups-picon) + (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) "w" gnus-article-decode-mime-words "c" gnus-article-decode-charset @@ -1788,6 +1850,7 @@ increase the score of each group you read." "h" gnus-summary-save-article-folder "v" gnus-summary-save-article-vm "p" gnus-summary-pipe-output + "P" gnus-summary-muttprint "s" gnus-soup-add-article) (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) @@ -1797,10 +1860,57 @@ 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) @@ -1836,8 +1946,9 @@ increase the score of each group you read." ["Increase score..." gnus-summary-increase-score t] ["Lower score..." gnus-summary-lower-score t])))) -;; Define both the Article menu in the summary buffer and the equivalent - ;; Commands menu in the article buffer here for consistency. + ;; Define both the Article menu in the summary buffer and the + ;; equivalent Commands menu in the article buffer here for + ;; consistency. (let ((innards `(("Hide" ["All" gnus-article-hide t] @@ -1860,7 +1971,8 @@ increase the score of each group you read." ["Base64" gnus-article-de-base64-unreadable t] ["View all" gnus-mime-view-all-parts t] ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] - ["Encrypt body" gnus-article-encrypt-body t]) + ["Encrypt body" gnus-article-encrypt-body t] + ["Extract all parts" gnus-summary-save-parts t]) ("Date" ["Local" gnus-article-date-local t] ["ISO8601" gnus-article-date-iso8601 t] @@ -1868,6 +1980,34 @@ increase the score of each group you read." ["Original" gnus-article-date-original t] ["Lapsed" gnus-article-date-lapsed t] ["User-defined" gnus-article-date-user t]) + ("Display" + ["Remove images" gnus-article-remove-images t] + ["Toggle smiley" gnus-treat-smiley t] + ["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] + ("View as different encoding" + ,@(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)) + (lambda (a b) + (string< (symbol-name a) + (symbol-name b))))))) ("Washing" ("Remove Blanks" ["Leading" gnus-article-strip-leading-blank-lines t] @@ -1886,7 +2026,6 @@ increase the score of each group you read." ["Fill long lines" gnus-article-fill-long-lines t] ["Capitalize sentences" gnus-article-capitalize-sentences t] ["CR" gnus-article-remove-cr t] - ["Show X-Face" gnus-article-display-x-face t] ["Quoted-Printable" gnus-article-de-quoted-unreadable t] ["Base64" gnus-article-de-base64-unreadable t] ["Rot 13" gnus-summary-caesar-message @@ -1898,10 +2037,14 @@ increase the score of each group you read." ["Stop page breaking" gnus-summary-stop-page-breaking t] ["Verbose header" gnus-summary-verbose-headers t] ["Toggle header" gnus-summary-toggle-header t] - ["Toggle smiley" gnus-summary-toggle-smiley t] + ["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) @@ -1916,6 +2059,7 @@ increase the score of each group you read." ["Save body in file" gnus-summary-save-article-body-file t] ["Pipe through a filter" gnus-summary-pipe-output t] ["Add to SOUP packet" gnus-soup-add-article t] + ["Print with Muttprint" gnus-summary-muttprint t] ["Print" gnus-summary-print-article t]) ("Backend" ["Respool article..." gnus-summary-respool-article t] @@ -1948,7 +2092,8 @@ increase the score of each group you read." ["Unshar and save" gnus-uu-decode-unshar-and-save t] ["Save" gnus-uu-decode-save t] ["Binhex" gnus-uu-decode-binhex t] - ["Postscript" gnus-uu-decode-postscript t]) + ["Postscript" gnus-uu-decode-postscript t] + ["All MIME parts" gnus-summary-save-parts t]) ("Cache" ["Enter article" gnus-cache-enter-article t] ["Remove article" gnus-cache-remove-article t]) @@ -1964,7 +2109,7 @@ increase the score of each group you read." ["Fetch article with id..." gnus-summary-refer-article t] ["Setup Mailing List Params" gnus-mailing-list-insinuate t] ["Redisplay" gnus-summary-show-article t] - ["Raw article" gnus-summary-show-raw-article t]))) + ["Raw article" gnus-summary-show-raw-article :keys "C-u g"]))) (easy-menu-define gnus-summary-article-menu gnus-summary-mode-map "" (cons "Article" innards)) @@ -2000,7 +2145,7 @@ increase the score of each group you read." (easy-menu-define gnus-summary-post-menu gnus-summary-mode-map "" `("Post" - ["Post an article" gnus-summary-post-news + ["Send a message (mail or news)" gnus-summary-post-news ,@(if (featurep 'xemacs) '(t) '(:help "Post an article"))] ["Followup" gnus-summary-followup @@ -2019,13 +2164,19 @@ increase the score of each group you read." ["Wide reply and yank" gnus-summary-wide-reply-with-original ,@(if (featurep 'xemacs) '(t) '(:help "Mail a reply, quoting this article"))] + ["Very wide reply" gnus-summary-very-wide-reply t] + ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original + ,@(if (featurep 'xemacs) '(t) + '(:help "Mail a very wide reply, quoting this article"))] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] ["Digest and mail" gnus-uu-digest-mail-forward t] ["Digest and post" gnus-uu-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] ["Uuencode and post" gnus-uu-post-news ,@(if (featurep 'xemacs) '(t) '(:help "Post a uuencoded article"))] @@ -2070,14 +2221,14 @@ increase the score of each group you read." ["Set expirable mark" gnus-summary-mark-as-expirable t] ["Set bookmark" gnus-summary-set-bookmark t] ["Remove bookmark" gnus-summary-remove-bookmark t]) - ("Mark Limit" + ("Limit to" ["Marks..." gnus-summary-limit-to-marks t] ["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] - ["Score" gnus-summary-limit-to-display-predicate t] + ["Display Predicate" gnus-summary-limit-to-display-predicate t] ["Unread" gnus-summary-limit-to-unread t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] ["Articles" gnus-summary-limit-to-articles t] @@ -2367,7 +2518,7 @@ The following commands are available: (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) (gnus-run-hooks 'gnus-summary-mode-hook) (turn-on-gnus-mailing-list-mode) - (mm-enable-multibyte-mule4) + (mm-enable-multibyte) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions)) @@ -2666,9 +2817,6 @@ marks of articles." ;; Saving hidden threads. -(put 'gnus-save-hidden-threads 'lisp-indent-function 0) -(put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) - (defmacro gnus-save-hidden-threads (&rest forms) "Save hidden threads, eval FORMS, and restore the hidden threads." (let ((config (make-symbol "config"))) @@ -2677,6 +2825,8 @@ marks of articles." (save-excursion ,@forms) (gnus-restore-hidden-threads-configuration ,config))))) +(put 'gnus-save-hidden-threads 'lisp-indent-function 0) +(put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) (defun gnus-data-compute-positions () "Compute the positions of all articles." @@ -2763,11 +2913,16 @@ display only a single character." (defun gnus-summary-buffer-name (group) "Return the summary buffer name of GROUP." - (concat "*Summary " group "*")) + (concat "*Summary " (gnus-group-decoded-name group) "*")) (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." - (let ((buffer (gnus-summary-buffer-name group))) + (let ((buffer (gnus-summary-buffer-name group)) + (dead-name (concat "*Dead Summary " + (gnus-group-decoded-name group) "*"))) + ;; If a dead summary buffer exists, we kill it. + (when (gnus-buffer-live-p dead-name) + (gnus-kill-buffer dead-name)) (if (get-buffer buffer) (progn (set-buffer buffer) @@ -2886,17 +3041,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)))) @@ -2927,11 +3084,12 @@ buffer that was in action when the last article was fetched." (cond ((setq to (cdr (assq 'To extra-headers))) (concat "-> " - (gnus-summary-extract-address-component - (funcall gnus-decode-encoded-word-function to)))) + (inline + (gnus-summary-extract-address-component + (funcall gnus-decode-encoded-word-function to))))) ((setq newsgroups (cdr (assq 'Newsgroups extra-headers))) (concat "=> " newsgroups))))) - (gnus-summary-extract-address-component gnus-tmp-from)))) + (inline (gnus-summary-extract-address-component gnus-tmp-from))))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current @@ -3224,11 +3382,10 @@ If NO-DISPLAY, don't generate a summary buffer." ;; Hide conversation thread subtrees. We cannot do this in ;; gnus-summary-prepare-hook since kill processing may not ;; work with hidden articles. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) + (gnus-summary-maybe-hide-threads) (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) + (gnus-summary-auto-select-subject) ;; Show first unread article if requested. (if (and (not no-article) (not no-display) @@ -3236,16 +3393,11 @@ If NO-DISPLAY, don't generate a summary buffer." gnus-auto-select-first) (progn (gnus-configure-windows 'summary) - (cond - ((eq gnus-auto-select-first 'best) - (gnus-summary-best-unread-article)) - ((eq gnus-auto-select-first t) - (gnus-summary-first-unread-article)) - ((gnus-functionp gnus-auto-select-first) - (funcall gnus-auto-select-first)))) - ;; Don't select any articles, just move point to the first - ;; article in the group. - (goto-char (point-min)) + (let ((art (gnus-summary-article-number))) + (unless (or (memq art gnus-newsgroup-undownloaded) + (memq art gnus-newsgroup-downloadable)) + (gnus-summary-goto-article art)))) + ;; Don't select any articles. (gnus-summary-position-point) (gnus-configure-windows 'summary 'force) (gnus-set-mode-line 'summary)) @@ -3262,6 +3414,24 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-run-hooks 'gnus-summary-prepared-hook) t))))) +(defun gnus-summary-auto-select-subject () + "Select the subject line on initial group entry." + (goto-char (point-min)) + (cond + ((eq gnus-auto-select-subject 'best) + (gnus-summary-best-unread-subject)) + ((eq gnus-auto-select-subject 'unread) + (gnus-summary-first-unread-subject)) + ((eq gnus-auto-select-subject 'unseen) + (gnus-summary-first-unseen-subject)) + ((eq gnus-auto-select-subject 'unseen-or-unread) + (gnus-summary-first-unseen-or-unread-subject)) + ((eq gnus-auto-select-subject 'first) + ;; Do nothing. + ) + ((gnus-functionp gnus-auto-select-subject) + (funcall gnus-auto-select-subject)))) + (defun gnus-summary-prepare () "Generate the summary buffer." (interactive) @@ -3357,7 +3527,7 @@ If NO-DISPLAY, don't generate a summary buffer." (while threads (when (setq references (mail-header-references (caar threads))) (setq id (mail-header-id (caar threads)) - ids (gnus-split-references references) + ids (inline (gnus-split-references references)) entered nil) (while (setq ref (pop ids)) (setq ids (delete ref ids)) @@ -3441,8 +3611,8 @@ If NO-DISPLAY, don't generate a summary buffer." (setq threads nil) (throw 'infloop t)) (unless (car (symbol-value refs)) - ;; These threads do not refer back to any other articles, - ;; so they're roots. + ;; These threads do not refer back to any other + ;; articles, so they're roots. (setq threads (append (cdr (symbol-value refs)) threads)))) gnus-newsgroup-dependencies))) threads)) @@ -3456,13 +3626,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) + ref ref-dep ref-header replaced) ;; Enter this `header' in the `dependencies' table. (cond ((not id-dep) @@ -3479,7 +3649,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) @@ -3502,8 +3673,8 @@ 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. + (when (and header (not replaced)) + ;; First check that we are not creating a References loop. (setq ref (gnus-parent-id (mail-header-references header))) (while (and ref (setq ref-dep (intern-soft ref dependencies)) @@ -3525,6 +3696,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) @@ -3601,7 +3777,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 @@ -3619,7 +3795,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (nnheader-nov-field)) ; from (nnheader-nov-field) ; date (nnheader-nov-read-message-id) ; id - (nnheader-nov-field) ; refs + (setq references (nnheader-nov-field)) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines (unless (eobp) @@ -3630,6 +3806,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))) @@ -3664,7 +3846,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))))))) @@ -3690,7 +3874,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))) @@ -4093,15 +4279,47 @@ Unscored articles will be counted as having a score of zero." (defun gnus-thread-total-score (thread) ;; This function find the total score of THREAD. - (cond ((null thread) - 0) - ((consp thread) - (if (stringp (car thread)) - (apply gnus-thread-score-function 0 - (mapcar 'gnus-thread-total-score-1 (cdr thread))) - (gnus-thread-total-score-1 thread))) - (t - (gnus-thread-total-score-1 (list thread))))) + (cond + ((null thread) + 0) + ((consp thread) + (if (stringp (car thread)) + (apply gnus-thread-score-function 0 + (mapcar 'gnus-thread-total-score-1 (cdr thread))) + (gnus-thread-total-score-1 thread))) + (t + (gnus-thread-total-score-1 (list thread))))) + +(defun gnus-thread-sort-by-most-recent-number (h1 h2) + "Sort threads such that the thread with the most recently arrived article comes first." + (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2))) + +(defun gnus-thread-highest-number (thread) + "Return the highest article number in THREAD." + (apply 'max (mapcar (lambda (header) + (mail-header-number header)) + (message-flatten-list thread)))) + +(defun gnus-thread-sort-by-most-recent-date (h1 h2) + "Sort threads such that the thread with the most recently dated article comes first." + (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2))) + +(defun gnus-thread-latest-date (thread) + "Return the highest article date in THREAD." + (let ((previous-time 0)) + (apply 'max (mapcar + (lambda (header) + (setq previous-time + (time-to-seconds + (mail-header-parse-date + (condition-case () + (mail-header-date header) + (error previous-time)))))) + (sort + (message-flatten-list thread) + (lambda (h1 h2) + (< (mail-header-number h1) + (mail-header-number h2)))))))) (defun gnus-thread-total-score-1 (root) ;; This function find the total score of the thread below ROOT. @@ -4131,20 +4349,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. @@ -4288,7 +4518,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)))) @@ -4377,20 +4609,20 @@ or a straight list of headers." (1+ (match-beginning 0)) (1- (match-end 0)))) (t gnus-tmp-from)) gnus-tmp-thread-tree-header-string - (cond + (cond ((not gnus-show-threads) "") ((zerop gnus-tmp-level) - (if (cdar thread) + (if (cdar thread) (or gnus-sum-thread-tree-root subject) (or gnus-sum-thread-tree-single-indent subject))) (t (concat (apply 'concat - (mapcar (lambda (item) - (if (= item 1) + (mapcar (lambda (item) + (if (= item 1) gnus-sum-thread-tree-vertical gnus-sum-thread-tree-indent)) (cdr (reverse tree-stack)))) - (if (nth 1 thread) + (if (nth 1 thread) gnus-sum-thread-tree-leaf-with-other gnus-sum-thread-tree-single-leaf))))) (when (string= gnus-tmp-name "") @@ -4540,7 +4772,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq gnus-newsgroup-name group gnus-newsgroup-unselected nil gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) - + (let ((display (gnus-group-find-parameter group 'display))) (setq gnus-newsgroup-display (cond @@ -4552,9 +4784,27 @@ If SELECT-ARTICLES, only select those articles from GROUP." 'gnus-not-ignore) ((arrayp display) (gnus-summary-display-make-predicate (mapcar 'identity display))) + ((numberp display) + ;; The following is probably the "correct" solution, but + ;; it makes Gnus fetch all headers and then limit the + ;; articles (which is slow), so instead we hack the + ;; select-articles parameter instead. -- Simon Josefsson + ;; + ;; + ;; (gnus-byte-compile + ;; `(lambda () (> number ,(- (cdr (gnus-active group)) + ;; display))))) + (setq select-articles + (gnus-uncompress-range + (cons (let ((tmp (- (cdr (gnus-active group)) display))) + (if (> tmp 0) + tmp + 1)) + (cdr (gnus-active group))))) + nil) (t nil)))) - + (gnus-summary-setup-default-charset) ;; Kludge to avoid having cached articles nixed out in virtual groups. @@ -4562,8 +4812,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) @@ -4573,12 +4824,10 @@ 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 @@ -4610,20 +4859,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)) - - (let ((marks (assq 'seen (gnus-info-marks info)))) - ;; The `seen' marks are treated specially. - (when (setq gnus-newsgroup-seen (cdr marks)) - (dolist (article gnus-newsgroup-articles) - (unless (gnus-member-of-range - article gnus-newsgroup-seen) - (push article 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)) @@ -4652,19 +4894,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. @@ -4716,7 +4968,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 @@ -4725,9 +4978,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)) @@ -4737,20 +4990,29 @@ 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)) (numberp gnus-large-newsgroup) (> number 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) - number)))) + (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") + number) + (if initial + (cons (number-to-string initial) + 0))))) (if (string-match "^[ \t]*$" input) number input))) ((and (> scored marked) (< scored number) (> (- scored number) 20)) @@ -4782,9 +5044,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 @@ -4857,9 +5117,22 @@ If SELECT-ARTICLES, only select those articles from GROUP." (< (car article) min) (> (car article) max)) (set var (delq article (symbol-value var)))))) + ;; Adjust ranges (sloppily). ((eq mark-type 'range) (cond - ((eq mark 'seen)))))))) + ((eq mark 'seen) + ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2). + ;; It should be (seen (NUM1 . NUM2)). + (when (numberp (cddr marks)) + (setcdr marks (list (cdr marks)))) + (setq articles (cdr marks)) + (while (and articles + (or (and (consp (car articles)) + (> min (cdar articles))) + (and (numberp (car articles)) + (> min (car articles))))) + (pop articles)) + (set var articles)))))))) (defun gnus-update-missing-marks (missing) "Go through the list of MISSING articles and remove them from the mark lists." @@ -4906,10 +5179,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq list (cdr all))))) (when (eq (cdr type) 'seen) - (setq list - (if list - (gnus-add-to-range list gnus-newsgroup-unseen) - (gnus-compress-sequence gnus-newsgroup-articles)))) + (setq list (gnus-range-add list gnus-newsgroup-unseen))) (when (eq (gnus-article-mark-to-type (cdr type)) 'list) (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) @@ -5128,7 +5398,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (gnus-info-set-marks ',info ',(gnus-info-marks info) t) (gnus-info-set-read ',info ',(gnus-info-read info)) (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-request-set-mark group (list (list ',range 'del '(read)))) + (gnus-request-set-mark ,group (list (list ',range 'del '(read)))) (gnus-group-update-group ,group t)))) ;; Add the read articles to the range. (gnus-info-set-read info range) @@ -5225,11 +5495,11 @@ The resulting hash table is returned, or nil if no Xrefs were found." (goto-char p) (setq id (if (re-search-forward "^message-id: *\\(<[^\n\t> ]+>\\)" nil t) - ;; We do it this way to make sure the Message-ID + ;; We do it this way to make sure the Message-ID ;; is (somewhat) syntactically valid. (buffer-substring (match-beginning 1) (match-end 1)) - ;; If there was no message-id, we just fake one + ;; If there was no message-id, we just fake one ;; to make subsequent routines simpler. (nnheader-generate-fake-message-id)))) ;; References. @@ -5249,7 +5519,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (search-backward "<" end t) (point)))))) - ;; Get the references from the in-reply-to header if there + ;; Get the references from the in-reply-to header if there ;; were no references and the in-reply-to header looks ;; promising. (if (and (search-forward "\nin-reply-to:" nil t) @@ -5340,29 +5610,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 @@ -5761,13 +6026,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 @@ -5841,13 +6106,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))) @@ -5857,7 +6119,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) @@ -6077,10 +6340,11 @@ The state which existed when entering the ephemeral is reset." (suppress-keymap gnus-dead-summary-mode-map) (substitute-key-definition 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) - (let ((keys '("\C-d" "\r" "\177" [delete]))) - (while keys - (define-key gnus-dead-summary-mode-map - (pop keys) 'gnus-summary-wake-up-the-dead)))) + (dolist (key '("\C-d" "\r" "\177" [delete])) + (define-key gnus-dead-summary-mode-map + key 'gnus-summary-wake-up-the-dead)) + (dolist (key '("q" "Q")) + (define-key gnus-dead-summary-mode-map key 'bury-buffer))) (defvar gnus-dead-summary-mode nil "Minor mode for Gnus summary buffers.") @@ -6126,17 +6390,20 @@ The state which existed when entering the ephemeral is reset." (set-buffer buffer) (gnus-kill-buffer gnus-article-buffer) (gnus-kill-buffer gnus-original-article-buffer))) - (cond (gnus-kill-summary-on-exit - (when (and gnus-use-trees - (gnus-buffer-exists-p buffer)) - (save-excursion - (set-buffer buffer) - (gnus-tree-close gnus-newsgroup-name))) - (gnus-kill-buffer buffer)) - ((gnus-buffer-exists-p buffer) - (save-excursion - (set-buffer buffer) - (gnus-deaden-summary)))))) + (cond + ;; Kill the buffer. + (gnus-kill-summary-on-exit + (when (and gnus-use-trees + (gnus-buffer-exists-p buffer)) + (save-excursion + (set-buffer buffer) + (gnus-tree-close gnus-newsgroup-name))) + (gnus-kill-buffer buffer)) + ;; Deaden the buffer. + ((gnus-buffer-exists-p buffer) + (save-excursion + (set-buffer buffer) + (gnus-deaden-summary)))))) (defun gnus-summary-wake-up-the-dead (&rest args) "Wake up the dead summary buffer." @@ -6236,7 +6503,7 @@ If prefix argument NO-ARTICLE is non-nil, no article is selected initially." ;; Walking around summary lines. -(defun gnus-summary-first-subject (&optional unread undownloaded) +(defun gnus-summary-first-subject (&optional unread undownloaded unseen) "Go to the first unread subject. If UNREAD is non-nil, go to the first unread article. Returns the article selected or nil if there are no unread articles." @@ -6262,7 +6529,12 @@ Returns the article selected or nil if there are no unread articles." (and (not (and undownloaded (eq gnus-undownloaded-mark (gnus-data-mark (car data))))) - (not (gnus-data-unread-p (car data))))) + (if unseen + (or (not (memq + (gnus-data-number (car data)) + gnus-newsgroup-unseen)) + (not (gnus-data-unread-p (car data)))) + (not (gnus-data-unread-p (car data)))))) (setq data (cdr data))) (when data (goto-char (gnus-data-pos (car data))) @@ -6312,6 +6584,8 @@ If optional argument UNREAD is non-nil, only unread article is selected." "Go the subject line of ARTICLE. If FORCE, also allow jumping to articles not currently shown." (interactive "nArticle number: ") + (unless (numberp article) + (error "Article %s is not a number" article)) (let ((b (point)) (data (gnus-data-find article))) ;; We read in the article if we have to. @@ -6348,13 +6622,13 @@ Given a prefix, will force an `article' buffer configuration." "Display ARTICLE in article buffer." (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer - (mm-enable-multibyte-mule4))) + (mm-enable-multibyte))) (gnus-set-global-variables) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer (setq gnus-article-charset gnus-newsgroup-charset) (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) - (mm-enable-multibyte-mule4))) + (mm-enable-multibyte))) (if (null article) nil (prog1 @@ -6383,7 +6657,7 @@ be displayed." (unless (eq major-mode 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (let ((article (or article (gnus-summary-article-number))) - (all-headers (not (not all-headers))) ;Must be T or NIL. + (all-headers (not (not all-headers))) ;Must be t or nil. gnus-summary-display-article-function) (and (not pseudo) (gnus-summary-article-pseudo-p article) @@ -6401,26 +6675,25 @@ be displayed." (or (null gnus-current-article) (not (eq gnus-current-article article)))) force) - ;; The requested article is different from the current article. + ;; The requested article is different from the current article. (progn (gnus-summary-display-article article all-headers) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer (if (not gnus-article-decoded-p) ;; a local variable - (mm-disable-multibyte-mule4)))) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers)) + (mm-disable-multibyte)))) (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) @@ -6703,6 +6976,29 @@ Return nil if there are no unread articles." (gnus-summary-first-subject t)) (gnus-summary-position-point))) +(defun gnus-summary-first-unseen-subject () + "Place the point on the subject line of the first unseen article. +Return nil if there are no unseen articles." + (interactive) + (prog1 + (when (gnus-summary-first-subject t t t) + (gnus-summary-show-thread) + (gnus-summary-first-subject t t t)) + (gnus-summary-position-point))) + +(defun gnus-summary-first-unseen-or-unread-subject () + "Place the point on the subject line of the first unseen article. +Return nil if there are no unseen articles." + (interactive) + (prog1 + (unless (when (gnus-summary-first-subject t t t) + (gnus-summary-show-thread) + (gnus-summary-first-subject t t t)) + (when (gnus-summary-first-subject t) + (gnus-summary-show-thread) + (gnus-summary-first-subject t))) + (gnus-summary-position-point))) + (defun gnus-summary-first-article () "Select the first article. Return nil if there are no articles." @@ -6714,8 +7010,20 @@ Return nil if there are no articles." (gnus-summary-display-article (gnus-summary-article-number))) (gnus-summary-position-point))) -(defun gnus-summary-best-unread-article () - "Select the unread article with the highest score." +(defun gnus-summary-best-unread-article (&optional arg) + "Select the unread article with the highest score. +If given a prefix argument, select the next unread article that has a +score higher than the default score." + (interactive "P") + (let ((article (if arg + (gnus-summary-better-unread-subject) + (gnus-summary-best-unread-subject)))) + (if article + (gnus-summary-goto-article article) + (error "No unread articles")))) + +(defun gnus-summary-best-unread-subject () + "Select the unread subject with the highest score." (interactive) (let ((best -1000000) (data gnus-newsgroup-data) @@ -6728,11 +7036,25 @@ Return nil if there are no articles." (setq best score article (gnus-data-number (car data)))) (setq data (cdr data))) - (prog1 - (if article - (gnus-summary-goto-article article) - (error "No unread articles")) - (gnus-summary-position-point)))) + (when article + (gnus-summary-goto-subject article)) + (gnus-summary-position-point) + article)) + +(defun gnus-summary-better-unread-subject () + "Select the first unread subject that has a score over the default score." + (interactive) + (let ((data gnus-newsgroup-data) + article score) + (while (and (setq article (gnus-data-number (car data))) + (or (gnus-data-read-p (car data)) + (not (> (gnus-summary-article-score article) + gnus-summary-default-score)))) + (setq data (cdr data))) + (when article + (gnus-summary-goto-subject article)) + (gnus-summary-position-point) + article)) (defun gnus-summary-last-subject () "Go to the last displayed subject line in the group." @@ -6810,24 +7132,35 @@ If given a prefix, remove all limits." (gnus-summary-limit nil 'pop) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-subject (subject &optional header) - "Limit the summary buffer to articles that have subjects that match a regexp." - (interactive "sLimit to subject (regexp): ") +(defun gnus-summary-limit-to-subject (subject &optional header not-matching) + "Limit the summary buffer to articles that have subjects that match a regexp. +If NOT-MATCHING, excluding articles that have subjects that match a regexp." + (interactive + (list (read-string (if current-prefix-arg + "Exclude subject (regexp): " + "Limit to subject (regexp): ")) + nil current-prefix-arg)) (unless header (setq header "subject")) (when (not (equal "" subject)) (prog1 (let ((articles (gnus-summary-find-matching - (or header "subject") subject 'all))) + (or header "subject") subject 'all nil nil + not-matching))) (unless articles (error "Found no matches for \"%s\"" subject)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) -(defun gnus-summary-limit-to-author (from) - "Limit the summary buffer to articles that have authors that match a regexp." - (interactive "sLimit to author (regexp): ") - (gnus-summary-limit-to-subject from "from")) +(defun gnus-summary-limit-to-author (from &optional not-matching) + "Limit the summary buffer to articles that have authors that match a regexp. +If NOT-MATCHING, excluding articles that have authors that match a regexp." + (interactive + (list (read-string (if current-prefix-arg + "Exclude author (regexp): " + "Limit to author (regexp): ")) + current-prefix-arg)) + (gnus-summary-limit-to-subject from "from" not-matching)) (defun gnus-summary-limit-to-age (age &optional younger-p) "Limit the summary buffer to articles that are older than (or equal) AGE days. @@ -6844,7 +7177,12 @@ articles that are younger than AGE days." (when (> (length days) 0) (setq days (read days))) (if (numberp days) - (setq days-got t) + (progn + (setq days-got t) + (if (< days 0) + (progn + (setq younger (not younger)) + (setq days (* days -1))))) (message "Please enter a number.") (sleep-for 1))) (list days younger))) @@ -6867,25 +7205,31 @@ articles that are younger than AGE days." (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-extra (header regexp) +(defun gnus-summary-limit-to-extra (header regexp &optional not-matching) "Limit the summary buffer to articles that match an 'extra' header." (interactive (let ((header (intern - (gnus-completing-read + (gnus-completing-read-with-default (symbol-name (car gnus-extra-headers)) - "Limit extra header:" + (if current-prefix-arg + "Exclude extra header:" + "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))))) + (read-string (format "%s header %s (regexp): " + (if current-prefix-arg "Exclude" "Limit to") + header)) + current-prefix-arg))) (when (not (equal "" regexp)) (prog1 (let ((articles (gnus-summary-find-matching - (cons 'extra header) regexp 'all))) + (cons 'extra header) regexp 'all nil nil + not-matching))) (unless articles (error "Found no matches for \"%s\"" regexp)) (gnus-summary-limit articles)) @@ -6917,7 +7261,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) @@ -6925,7 +7269,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\"). @@ -6955,12 +7299,9 @@ Returns how many articles were removed." (gnus-summary-limit articles)) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-score (&optional score) +(defun gnus-summary-limit-to-score (score) "Limit to articles with score at or above SCORE." - (interactive "P") - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) + (interactive "NLimit to articles with score of at least: ") (let ((data gnus-newsgroup-data) articles) (while data @@ -7042,15 +7383,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 @@ -7080,9 +7423,7 @@ If ALL, mark even excluded ticked and dormants as read." ;; according to the new limit. (gnus-summary-prepare) ;; Hide any threads, possibly. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) + (gnus-summary-maybe-hide-threads) ;; Try to return to the article you were at, or one in the ;; neighborhood. (when data @@ -7472,8 +7813,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 @@ -7495,8 +7836,11 @@ to guess what the document format is." (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. + ,(if force 'mbox 'guess))) + t nil nil nil + `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name + "ADAPT"))))) + ;; 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. @@ -7679,13 +8023,14 @@ fetched headers for, whether they are displayed or not." (nreverse articles))) (defun gnus-summary-find-matching (header regexp &optional backward unread - not-case-fold) + not-case-fold not-matching) "Return a list of all articles that match REGEXP on HEADER. The search stars on the current article and goes forwards unless BACKWARD is non-nil. If BACKWARD is `all', do all articles. If UNREAD is non-nil, only unread articles will be taken into consideration. If NOT-CASE-FOLD, case won't be folded -in the comparisons." +in the comparisons. If NOT-MATCHING, return a list of all articles that +not match REGEXP on HEADER." (let ((case-fold-search (not not-case-fold)) articles d func) (if (consp header) @@ -7706,8 +8051,12 @@ in the comparisons." (when (and (or (not unread) ; We want all articles... (gnus-data-unread-p d)) ; Or just unreads. (vectorp (gnus-data-header d)) ; It's not a pseudo. - (string-match regexp - (funcall func (gnus-data-header d)))) ; Match. + (if not-matching + (not (string-match + regexp + (funcall func (gnus-data-header d)))) + (string-match regexp + (funcall func (gnus-data-header d))))) (push (gnus-data-number d) articles))) ; Success! (nreverse articles))) @@ -7765,6 +8114,13 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (when gnus-page-broken (gnus-narrow-to-page)))) +(defun gnus-summary-print-truncate-and-quote (string &optional len) + "Truncate to LEN and quote all \"(\"'s in STRING." + (gnus-replace-in-string (if (and len (> (length string) len)) + (substring string 0 len) + string) + "[()]" "\\\\\\&")) + (defun gnus-summary-print-article (&optional filename n) "Generate and print a PostScript image of the N next (mail) articles. @@ -7779,45 +8135,54 @@ to save in." (dolist (article (gnus-summary-work-articles n)) (gnus-summary-select-article nil nil 'pseudo article) (gnus-eval-in-buffer-window gnus-article-buffer - (let ((buffer (generate-new-buffer " *print*"))) - (unwind-protect - (progn - (copy-to-buffer buffer (point-min) (point-max)) - (set-buffer buffer) - (gnus-article-delete-invisible-text) - (when (gnus-visual-p 'article-highlight 'highlight) - ;; Copy-to-buffer doesn't copy overlay. So redo - ;; highlight. - (let ((gnus-article-buffer buffer)) - (gnus-article-highlight-citation t) - (gnus-article-highlight-signature))) - (let ((ps-left-header - (list - (concat "(" - (mail-header-subject gnus-current-headers) ")") - (concat "(" - (mail-header-from gnus-current-headers) ")"))) - (ps-right-header - (list - "/pagenumberstring load" - (concat "(" - (mail-header-date gnus-current-headers) ")")))) - (gnus-run-hooks 'gnus-ps-print-hook) - (save-excursion - (if window-system - (ps-spool-buffer-with-faces) - (ps-spool-buffer))))) - (kill-buffer buffer)))) + (gnus-print-buffer)) (gnus-summary-remove-process-mark article)) (ps-despool filename)) +(defun gnus-print-buffer () + (let ((buffer (generate-new-buffer " *print*"))) + (unwind-protect + (progn + (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. + (let ((gnus-article-buffer buffer)) + (gnus-article-highlight-citation t) + (gnus-article-highlight-signature))) + (let ((ps-left-header + (list + (concat "(" + (gnus-summary-print-truncate-and-quote + (mail-header-subject gnus-current-headers) + 66) ")") + (concat "(" + (gnus-summary-print-truncate-and-quote + (mail-header-from gnus-current-headers) + 45) ")"))) + (ps-right-header + (list + "/pagenumberstring load" + (concat "(" + (mail-header-date gnus-current-headers) ")")))) + (gnus-run-hooks 'gnus-ps-print-hook) + (save-excursion + (if window-system + (ps-spool-buffer-with-faces) + (ps-spool-buffer))))) + (kill-buffer buffer)))) + (defun gnus-summary-show-article (&optional arg) - "Force re-fetching of the current article. + "Force redisplaying of the current article. If ARG (the prefix) is a number, show the article with the charset defined in `gnus-summary-show-article-charset-alist', or the charset input. If ARG (the prefix) is non-nil and not a number, show the raw article -without any article massaging functions being run." +without any article massaging functions being run. Normally, the key strokes +are `C-u g'." (interactive "P") (cond ((numberp arg) @@ -7825,26 +8190,29 @@ without any article massaging functions being run." (let ((gnus-newsgroup-charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (mm-read-coding-system - "View as charset: " + "View as charset: " ;; actually it is coding system. (save-excursion (set-buffer gnus-article-buffer) - (let ((coding-systems - (detect-coding-region (point) (point-max)))) - (or (car-safe coding-systems) - coding-systems)))))) + (mm-detect-coding-region (point) (point-max)))))) (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-summary-select-article nil 'force) (let ((deps gnus-newsgroup-dependencies) - head header) + head header lines) (save-excursion (set-buffer gnus-original-article-buffer) (save-restriction (message-narrow-to-head) - (setq head (buffer-string))) + (setq head (buffer-string)) + (goto-char (point-min)) + (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t) + (goto-char (point-max)) + (widen) + (setq lines (1- (count-lines (point) (point-max)))))) (with-temp-buffer (insert (format "211 %d Article retrieved.\n" (cdr gnus-article-current))) (insert head) + (if lines (insert (format "Lines: %d\n" lines))) (insert ".\n") (let ((nntp-server-buffer (current-buffer))) (setq header (car (gnus-get-newsgroup-headers deps t)))))) @@ -7909,30 +8277,27 @@ If ARG is a negative number, hide the unwanted header lines." (save-restriction (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)))) + hidden s e) + (save-restriction + (article-narrow-to-head) + (setq e (point-max) + hidden (if (numberp arg) + (>= arg 0) + (gnus-article-hidden-text-p 'headers)))) + (delete-region (point-min) e) (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) + (with-current-buffer gnus-original-article-buffer + (goto-char (setq s (point-min))) + (setq e (search-forward "\n\n" nil t) + e (if e (1- e) (point-max)))) + (insert-buffer-substring gnus-original-article-buffer s 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)) - (setq gnus-article-wash-types - (delq 'headers gnus-article-wash-types)) + (gnus-delete-wash-type 'headers) (gnus-treat-article 'head)) (gnus-treat-article 'head))) (gnus-set-mode-line 'article))))) @@ -7980,6 +8345,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. @@ -8013,6 +8382,18 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;; 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)) @@ -8062,7 +8443,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (mail-header-xref (gnus-summary-article-header article)) " "))) (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) - ":" article)) + ":" (number-to-string article))) (unless xref (setq xref (list (system-name)))) (setq new-xref @@ -8079,7 +8460,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-request-accept-article to-newsgroup select-method (not articles)))) (setq new-xref (concat new-xref " " (car art-group) - ":" (cdr art-group))) + ":" + (number-to-string (cdr art-group)))) ;; Now we have the new Xrefs header, so we insert ;; it and replace the new article. (nnheader-replace-header "Xref" new-xref) @@ -8195,6 +8577,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") @@ -8233,7 +8618,7 @@ latter case, they will be copied into the relevant groups." (car (gnus-find-method-for-group gnus-newsgroup-name))))) (method - (gnus-completing-read + (gnus-completing-read-with-default methname "What backend do you want to use when respooling?" methods nil t nil 'gnus-mail-method-history)) ms) @@ -8379,12 +8764,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 () @@ -8452,18 +8835,22 @@ groups." (let (force raw current-handles) (cond ((null arg)) - ((eq arg 1) (setq raw t)) - ((eq arg 2) (setq raw t - force t)) - ((eq arg 3) (setq current-handles - (and (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (prog1 - gnus-article-mime-handles - (setq gnus-article-mime-handles nil)))))) - (t (setq force t))) - (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts")) - (error "Can't edit the raw article in group nndraft:drafts")) + ((eq arg 1) + (setq raw t)) + ((eq arg 2) + (setq raw t + force t)) + ((eq arg 3) + (setq current-handles + (and (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (prog1 + gnus-article-mime-handles + (setq gnus-article-mime-handles nil)))))) + (t + (setq force t))) + (when (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts")) + (error "Can't edit the raw article in group nndraft:drafts")) (save-excursion (set-buffer gnus-summary-buffer) (let ((mail-parse-charset gnus-newsgroup-charset) @@ -8475,7 +8862,7 @@ groups." (gnus-summary-show-article t) (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer)) (with-current-buffer gnus-article-buffer - (mm-enable-multibyte-mule4))) + (mm-enable-multibyte))) (if (equal gnus-newsgroup-name "nndraft:drafts") (setq raw t)) (gnus-article-edit-article @@ -8560,10 +8947,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 @@ -8607,15 +8991,6 @@ groups." (execute-kbd-macro (concat (this-command-keys) key)) (gnus-article-edit-done)) - -(defun gnus-summary-toggle-smiley (&optional arg) - "Toggle the display of smilies as small graphical icons." - (interactive "P") - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-smiley-display arg) - )) - ;;; Respooling (defun gnus-summary-respool-query (&optional silent trace) @@ -8771,6 +9146,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." @@ -8936,11 +9318,17 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (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-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. @@ -9050,9 +9438,10 @@ 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)) @@ -9080,11 +9469,14 @@ 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-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))) @@ -9532,18 +9924,49 @@ Returns nil if no thread was there to be shown." (goto-char orig) (gnus-summary-position-point)))) -(defun gnus-summary-hide-all-threads () - "Hide all thread subtrees." +(defun gnus-summary-maybe-hide-threads () + "If requested, hide the threads that should be hidden." + (when (and gnus-show-threads + gnus-thread-hide-subtree) + (gnus-summary-hide-all-threads + (if (or (consp gnus-thread-hide-subtree) + (gnus-functionp gnus-thread-hide-subtree)) + (gnus-make-predicate gnus-thread-hide-subtree) + nil)))) + +;;; Hiding predicates. + +(defun gnus-article-unread-p (header) + (memq (mail-header-number header) gnus-newsgroup-unreads)) + +(defun gnus-article-unseen-p (header) + (memq (mail-header-number header) gnus-newsgroup-unseen)) + +(defun gnus-map-articles (predicate articles) + "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil." + (apply 'gnus-or (mapcar predicate + (mapcar 'gnus-summary-article-header articles)))) + +(defun gnus-summary-hide-all-threads (&optional predicate) + "Hide all thread subtrees. +If PREDICATE is supplied, threads that satisfy this predicate +will not be hidden." (interactive) (save-excursion (goto-char (point-min)) - (gnus-summary-hide-thread) - (while (zerop (gnus-summary-next-thread 1 t)) - (gnus-summary-hide-thread))) + (let ((end nil)) + (while (not end) + (when (or (not predicate) + (gnus-map-articles + predicate (gnus-summary-article-children))) + (gnus-summary-hide-thread)) + (setq end (not (zerop (gnus-summary-next-thread 1 t))))))) (gnus-summary-position-point)) (defun gnus-summary-hide-thread () "Hide thread subtrees. +If PREDICATE is supplied, threads that satisfy this predicate +will not be hidden. Returns nil if no threads were there to be hidden." (interactive) (let ((buffer-read-only nil) @@ -9739,8 +10162,7 @@ Argument REVERSE means reverse order." ;; We do the sorting by regenerating the threads. (gnus-summary-prepare) ;; Hide subthreads if needed. - (when (and gnus-show-threads gnus-thread-hide-subtree) - (gnus-summary-hide-all-threads)))) + (gnus-summary-maybe-hide-threads))) (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." @@ -9763,8 +10185,7 @@ Argument REVERSE means reverse order." ;; We do the sorting by regenerating the threads. (gnus-summary-prepare) ;; Hide subthreads if needed. - (when (and gnus-show-threads gnus-thread-hide-subtree) - (gnus-summary-hide-all-threads)))) + (gnus-summary-maybe-hide-threads))) ;; Summary saving commands. @@ -9790,7 +10211,9 @@ The variable `gnus-default-article-saver' specifies the saver function." (gnus-message 1 "Article %d is unsaveable" article)) ;; This is a real article. (save-window-excursion - (gnus-summary-select-article t nil nil article)) + (let ((gnus-display-mime-function nil) + (gnus-article-prepare-hook nil)) + (gnus-summary-select-article t nil nil article))) (save-excursion (set-buffer save-buffer) (erase-buffer) @@ -9874,6 +10297,17 @@ save those articles instead." (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) (gnus-summary-save-article arg))) +(defun gnus-summary-muttprint (&optional arg) + "Print the current article using Muttprint. +If N is a positive number, save the N next articles. +If N is a negative number, save the N previous articles. +If N is nil and any articles have been marked with the process mark, +save those articles instead." + (interactive "P") + (require 'gnus-art) + (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint)) + (gnus-summary-save-article arg t))) + (defun gnus-summary-pipe-message (program) "Pipe the current article through PROGRAM." (interactive "sProgram: ") @@ -9943,23 +10377,26 @@ save those articles instead." (to-newsgroup (cond ((null split-name) - (gnus-completing-read default prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil prefix - 'gnus-group-history)) + (gnus-completing-read-with-default + default prom + gnus-active-hashtb + 'gnus-valid-move-group-p + nil prefix + 'gnus-group-history)) ((= 1 (length split-name)) - (gnus-completing-read (car split-name) prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil nil - 'gnus-group-history)) + (gnus-completing-read-with-default + (car split-name) prom + gnus-active-hashtb + 'gnus-valid-move-group-p + nil nil + 'gnus-group-history)) (t - (gnus-completing-read nil prom - (mapcar (lambda (el) (list el)) - (nreverse split-name)) - nil nil nil - 'gnus-group-history)))) + (gnus-completing-read-with-default + nil prom + (mapcar (lambda (el) (list el)) + (nreverse split-name)) + nil nil nil + 'gnus-group-history)))) (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) (when to-newsgroup (if (or (string= to-newsgroup "") @@ -9999,7 +10436,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. @@ -10086,7 +10524,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))))))) @@ -10249,39 +10689,35 @@ If REVERSE, save parts that do not match TYPE." (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)) + (inhibit-read-only t) + (default gnus-summary-default-score) + (default-high gnus-summary-default-high-score) + (default-low gnus-summary-default-low-score)) ;; 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)))) + (while (and list + (not (eval (caar list)))) + (setq list (cdr list))) (let ((face (cdar list))) (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, @@ -10510,9 +10946,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 @@ -10550,44 +10987,51 @@ 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 older + (gnus-sorted-difference + (gnus-uncompress-range (list gnus-newsgroup-active)) + old)) (setq len (length older)) (cond ((null older) nil) ((numberp all) (if (< all len) - (setq older (subseq older 0 all)))) + (setq older (last older all)))) (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)))))))) + (setq older (last older all)))))))) (if (not older) (message "No old news.") (gnus-summary-insert-articles older) - (gnus-summary-limit (gnus-union older old)))) + (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) @@ -10602,8 +11046,8 @@ If ALL is a number, fetch this number of articles." (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)