;;; 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 <larsi@gnus.org>
(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.
"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))
(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."
: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.
: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
: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."
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)
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
`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)
: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)))
(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
: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
: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)
(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)
(?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
(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.")
(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.")
"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..")
"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.")
"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))
'(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))")
(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)
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
"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
"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
"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)
"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)
["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]
["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]
["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]
["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
["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)
["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]
["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])
["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))
(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
["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"))]
["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]
(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))
;; 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")))
(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."
(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)
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))))
(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
;; 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)
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))
(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)
(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))
(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))
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)
(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)
(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))
(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)
(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
(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)
(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)))
(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)))))))
(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)))
(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.
(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.
(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))))
(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 "")
(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
nil)
(t
nil))))
-
+
(gnus-summary-setup-default-charset)
;; Kludge to avoid having cached articles nixed out in virtual groups.
(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)
;; 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
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))
;; 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.
(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
(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))
(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))
;; 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
(< (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."
(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)))
(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.
(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)
;; 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
(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
(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)))
(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)
(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.")
(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."
;; 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."
(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)))
"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.
"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
(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)
(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)
(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."
(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)
(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."
(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.
(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)))
(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))
;; 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)
(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\").
"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
;; 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
(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
(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.
(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)
(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)))
(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.
(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)
(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))))))
(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)))))
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.
;; 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))
(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
(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)
(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")
(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)
;; 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 ()
(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)
(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
(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
(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)
(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."
(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.
"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))
(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)))
(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)
;; 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."
;; 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.
(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)
(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: ")
(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 "")
(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.
(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)))))))
(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,
(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
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)
(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)
projects / gnus / blobdiff