;;; gnus-sum.el --- summary mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
- (require 'cl)
- (defvar tool-bar-mode))
+ (require 'cl))
+
+(defvar tool-bar-mode)
+(defvar gnus-tmp-header)
(require 'gnus)
(require 'gnus-group)
:group 'gnus-summary-exit
:type 'boolean)
+(defcustom gnus-summary-next-group-on-exit t
+ "If non-nil, go to the next unread newsgroup on summary exit.
+See `gnus-group-goto-unread'."
+ :link '(custom-manual "(gnus)Group Maneuvering")
+ :group 'gnus-summary-exit
+ :version "23.0" ;; No Gnus
+ :type 'boolean)
+
(defcustom gnus-fetch-old-headers nil
"*Non-nil means that Gnus will try to build threads by grabbing old headers.
If an unread article in the group refers to an older, already
number
(sexp :menu-tag "other" t)))
-(defcustom gnus-refer-thread-limit 200
+(defcustom gnus-refer-thread-limit 500
"*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
If t, fetch all the available old headers."
:group 'gnus-thread
If this variable is `adopt', Gnus will make one of the \"children\"
the parent and mark all the step-children as such.
If this variable is `empty', the \"children\" are printed with empty
-subject fields. (Or rather, they will be printed with a string
+subject fields. (Or rather, they will be printed with a string
given by the `gnus-summary-same-subject' variable.)"
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
:type 'boolean)
(defcustom gnus-auto-select-first t
- "*If non-nil, select the article under point.
-Which article this is is controlled by the `gnus-auto-select-subject'
-variable.
+ "If non-nil, select an article on group entry.
+An article is selected automatically when entering a group
+e.g. with \\<gnus-group-mode-map>\\[gnus-group-read-group], or via `gnus-summary-next-page' or
+`gnus-summary-catchup-and-goto-next-group'.
+
+Which article is selected is controlled by the variable
+`gnus-auto-select-subject'.
If you want to prevent automatic selection of articles in some
newsgroups, set the variable to nil in `gnus-select-group-hook'."
+ ;; Commands include...
+ ;; \\<gnus-group-mode-map>\\[gnus-group-read-group]
+ ;; \\<gnus-summary-mode-map>\\[gnus-summary-next-page]
+ ;; \\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]
:group 'gnus-group-select
:type '(choice (const :tag "none" nil)
(sexp :menu-tag "first" t)))
:group 'gnus-summary-maneuvering
:type 'boolean)
+(defcustom gnus-auto-select-on-ephemeral-exit 'next-noselect
+ "What article should be selected after exiting an ephemeral group.
+Valid values include:
+
+`next'
+ Select the next article.
+`next-unread'
+ Select the next unread article.
+`next-noselect'
+ Move the cursor to the next article. This is the default.
+`next-unread-noselect'
+ Move the cursor to the next unread article.
+
+If it has any other value or there is no next (unread) article, the
+article selected before entering to the ephemeral group will appear."
+ :version "23.0" ;; No Gnus
+ :group 'gnus-summary-maneuvering
+ :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
+ (const next) (const next-unread)
+ (const next-noselect) (const next-unread-noselect)
+ (sexp :tag "other" :value nil)))
+
(defcustom gnus-auto-goto-ignores 'unfetched
"*Says how to handle unfetched articles when maneuvering.
. gnus-summary-normal-read))
"*Controls the highlighting of summary buffer lines.
-A list of (FORM . FACE) pairs. When deciding how a a particular
+A list of (FORM . FACE) pairs. When deciding how a particular
summary line should be displayed, each form is evaluated. The content
of the face field after the first true form is used. You can change
how those summary lines are displayed, by editing the face field.
You can use the following variables in the FORM field.
-score: The article's score
+score: The article's score.
default: The default article score.
default-high: The default score for high scored articles.
default-low: The default score for low scored articles.
:group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
+(put 'gnus-summary-highlight 'risky-local-variable t)
(defcustom gnus-alter-header-function nil
"Function called to allow alteration of article header structures.
:group 'gnus-summary)
(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.")
+ "Function used to decode a string with encoded words.")
+
+(defvar gnus-decode-encoded-address-function
+ 'mail-decode-encoded-address-string
+ "Function used to decode addresses with encoded words.")
(defcustom gnus-extra-headers '(To Newsgroups)
"*Extra headers to parse."
:type '(repeat symbol))
(defcustom gnus-ignored-from-addresses
- (and user-mail-address
+ (and user-mail-address
(not (string= user-mail-address ""))
(regexp-quote user-mail-address))
- "*Regexp of From headers that may be suppressed in favor of To headers."
+ "*From headers that may be suppressed in favor of To headers.
+This can be a regexp or a list of regexps."
:version "21.1"
:group 'gnus-summary
- :type 'regexp)
+ :type '(choice regexp
+ (repeat :tag "Regexp List" regexp)))
+
+(defsubst gnus-ignored-from-addresses ()
+ (gmm-regexp-concat gnus-ignored-from-addresses))
(defcustom gnus-summary-to-prefix "-> "
"*String prefixed to the To field in the summary line when
:type '(repeat symbol)
:group 'gnus-charset)
+(defcustom gnus-newsgroup-maximum-articles nil
+ "The maximum number of articles a newsgroup.
+If this is a number, old articles in a newsgroup exceeding this number
+are silently ignored. If it is nil, no article is ignored. Note that
+setting this variable to a number might prevent you from reading very
+old articles."
+ :group 'gnus-group-select
+ :version "22.2"
+ :type '(choice (const :tag "No limit" nil)
+ integer))
+
(gnus-define-group-parameter
ignored-charsets
:type list
(defvar gnus-newsgroup-last-mail nil)
(defvar gnus-newsgroup-last-folder nil)
(defvar gnus-newsgroup-last-file nil)
+(defvar gnus-newsgroup-last-directory nil)
(defvar gnus-newsgroup-auto-expire nil)
(defvar gnus-newsgroup-active nil)
gnus-newsgroup-begin gnus-newsgroup-end
gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
gnus-newsgroup-last-folder gnus-newsgroup-last-file
+ gnus-newsgroup-last-directory
gnus-newsgroup-auto-expire gnus-newsgroup-unreads
gnus-newsgroup-unselected gnus-newsgroup-marked
gnus-newsgroup-spam-marked
(eq gnus-newsgroup-name
(car gnus-decode-encoded-word-methods-cache)))
(setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
- (mapcar (lambda (x)
- (if (symbolp x)
- (nconc gnus-decode-encoded-word-methods-cache (list x))
- (if (and gnus-newsgroup-name
- (string-match (car x) gnus-newsgroup-name))
- (nconc gnus-decode-encoded-word-methods-cache
- (list (cdr x))))))
- gnus-decode-encoded-word-methods))
- (let ((xlist gnus-decode-encoded-word-methods-cache))
- (pop xlist)
- (while xlist
- (setq string (funcall (pop xlist) string))))
- string)
+ (dolist (method gnus-decode-encoded-word-methods)
+ (if (symbolp method)
+ (nconc gnus-decode-encoded-word-methods-cache (list method))
+ (if (and gnus-newsgroup-name
+ (string-match (car method) gnus-newsgroup-name))
+ (nconc gnus-decode-encoded-word-methods-cache
+ (list (cdr method)))))))
+ (dolist (method (cdr gnus-decode-encoded-word-methods-cache) string)
+ (setq string (funcall method string))))
;; Subject simplification.
(setq modified-tick (buffer-modified-tick))
(cond
((listp gnus-simplify-subject-fuzzy-regexp)
- (mapcar 'gnus-simplify-buffer-fuzzy-step
- gnus-simplify-subject-fuzzy-regexp))
+ (mapc 'gnus-simplify-buffer-fuzzy-step
+ gnus-simplify-subject-fuzzy-regexp))
(gnus-simplify-subject-fuzzy-regexp
(gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
(gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
((eq gnus-summary-gather-subject-limit 'fuzzy)
(gnus-simplify-subject-fuzzy subject))
((numberp gnus-summary-gather-subject-limit)
- (gnus-limit-string (gnus-simplify-subject-re subject)
- gnus-summary-gather-subject-limit))
+ (truncate-string-to-width (gnus-simplify-subject-re subject)
+ gnus-summary-gather-subject-limit))
(t
subject)))
"," gnus-summary-best-unread-article
"\M-s" gnus-summary-search-article-forward
"\M-r" gnus-summary-search-article-backward
+ "\M-S" gnus-summary-repeat-search-article-forward
+ "\M-R" gnus-summary-repeat-search-article-backward
"<" gnus-summary-beginning-of-article
">" gnus-summary-end-of-article
"j" gnus-summary-goto-article
(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
"/" gnus-summary-limit-to-subject
"n" gnus-summary-limit-to-articles
+ "b" gnus-summary-limit-to-bodies
+ "h" gnus-summary-limit-to-headers
"w" gnus-summary-pop-limit
"s" gnus-summary-limit-to-subject
"a" gnus-summary-limit-to-author
"C" gnus-summary-limit-mark-excluded-as-read
"o" gnus-summary-insert-old-articles
"N" gnus-summary-insert-new-articles
+ "S" gnus-summary-limit-to-singletons
"r" gnus-summary-limit-to-replied
- "R" gnus-summary-limit-to-recipient)
+ "R" gnus-summary-limit-to-recipient
+ "A" gnus-summary-limit-to-address)
(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
"n" gnus-summary-next-unread-article
(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
"k" gnus-summary-kill-thread
+ "E" gnus-summary-expire-thread
"l" gnus-summary-lower-thread
"i" gnus-summary-raise-thread
"T" gnus-summary-toggle-threads
"t" gnus-summary-rethread-current
"^" gnus-summary-reparent-thread
+ "\M-^" gnus-summary-reparent-children
"s" gnus-summary-show-thread
"S" gnus-summary-show-all-threads
"h" gnus-summary-hide-thread
(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
"g" gnus-summary-prepare
"c" gnus-summary-insert-cached-articles
- "d" gnus-summary-insert-dormant-articles)
+ "d" gnus-summary-insert-dormant-articles
+ "t" gnus-summary-insert-ticked-articles)
(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
"c" gnus-summary-catchup-and-exit
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
"P" gnus-summary-print-article
+ "S" gnus-sticky-article
"M" gnus-mailing-list-insinuate
"t" gnus-article-babel)
"e" gnus-article-emphasize
"w" gnus-article-fill-cited-article
"Q" gnus-article-fill-long-lines
+ "L" gnus-article-toggle-truncate-lines
"C" gnus-article-capitalize-sentences
"c" gnus-article-remove-cr
"q" gnus-article-de-quoted-unreadable
"r" gnus-summary-save-article-rmail
"f" gnus-summary-save-article-file
"b" gnus-summary-save-article-body-file
+ "B" gnus-summary-write-article-body-file
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
"O" gnus-article-save-part-and-strip
"r" gnus-article-replace-part
"d" gnus-article-delete-part
+ "t" gnus-article-view-part-as-type
"j" gnus-article-jump-to-part
"c" gnus-article-copy-part
"C" gnus-article-view-part-as-charset
"e" gnus-article-view-part-externally
+ "H" gnus-article-browse-html-article
"E" gnus-article-encrypt-body
"i" gnus-article-inline-part
"|" gnus-article-pipe-part)
"O" gnus-uu-decode-save
"b" gnus-uu-decode-binhex
"B" gnus-uu-decode-binhex
+ "Y" gnus-uu-decode-yenc
"p" gnus-uu-decode-postscript
"P" gnus-uu-decode-postscript-and-save)
["Repair multipart" gnus-summary-repair-multipart t]
["Pipe part..." gnus-article-pipe-part t]
["Inline part" gnus-article-inline-part t]
+ ["View part as type..." gnus-article-view-part-as-type t]
["Encrypt body" gnus-article-encrypt-body
:active (not (gnus-group-read-only-p))
,@(if (featurep 'xemacs) nil
'(:help "Encrypt the message body on disk"))]
["View part externally" gnus-article-view-part-externally t]
+ ["View HTML parts in browser" gnus-article-browse-html-article t]
["View part with charset..." gnus-article-view-part-as-charset t]
["Copy part" gnus-article-copy-part t]
["Save part..." gnus-article-save-part t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
["Fill long lines" gnus-article-fill-long-lines t]
+ ["Toggle truncate long lines" gnus-article-toggle-truncate-lines t]
["Capitalize sentences" gnus-article-capitalize-sentences t]
["Remove CR" gnus-article-remove-cr t]
["Quoted-Printable" gnus-article-de-quoted-unreadable t]
["Remove article" gnus-cache-remove-article t])
["Translate" gnus-article-babel t]
["Select article buffer" gnus-summary-select-article-buffer t]
+ ["Make article buffer sticky" gnus-sticky-article t]
["Enter digest buffer" gnus-summary-enter-digest-group t]
["Isearch article..." gnus-summary-isearch-article t]
["Beginning of the article" gnus-summary-beginning-of-article t]
["Go up thread" gnus-summary-up-thread t]
["Top of thread" gnus-summary-top-thread t]
["Mark thread as read" gnus-summary-kill-thread t]
+ ["Mark thread as expired" gnus-summary-expire-thread t]
["Lower thread score" gnus-summary-lower-thread t]
["Raise thread score" gnus-summary-raise-thread t]
["Rethread current" gnus-summary-rethread-current t]))
["Subject..." gnus-summary-limit-to-subject t]
["Author..." gnus-summary-limit-to-author t]
["Recipient..." gnus-summary-limit-to-recipient t]
+ ["Address..." gnus-summary-limit-to-address t]
["Age..." gnus-summary-limit-to-age t]
["Extra..." gnus-summary-limit-to-extra t]
["Score..." gnus-summary-limit-to-score t]
["Display Predicate" gnus-summary-limit-to-display-predicate t]
["Unread" gnus-summary-limit-to-unread t]
["Unseen" gnus-summary-limit-to-unseen t]
+ ["Singletons" gnus-summary-limit-to-singletons t]
["Replied" gnus-summary-limit-to-replied t]
["Non-dormant" gnus-summary-limit-exclude-dormant t]
- ["Next articles" gnus-summary-limit-to-articles t]
+ ["Next or process marked articles" gnus-summary-limit-to-articles t]
["Pop limit" gnus-summary-pop-limit t]
["Show dormant" gnus-summary-limit-include-dormant t]
["Hide childless dormant"
["Regenerate" gnus-summary-prepare t]
["Insert cached articles" gnus-summary-insert-cached-articles t]
["Insert dormant articles" gnus-summary-insert-dormant-articles t]
+ ["Insert ticked articles" gnus-summary-insert-ticked-articles t]
["Toggle threading" gnus-summary-toggle-threads t])
["See old articles" gnus-summary-insert-old-articles t]
["See new articles" gnus-summary-insert-new-articles t]
(with-current-buffer gnus-summary-buffer
(gnus-summary-make-tool-bar))))
-;; The default will be changed when the new icons have been checked in:
-(defcustom gnus-summary-tool-bar 'gnus-summary-tool-bar-retro
+(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome)
+ 'gnus-summary-tool-bar-gnome
+ 'gnus-summary-tool-bar-retro)
"Specifies the Gnus summary tool bar.
It can be either a list or a symbol refering to a list. See
(defcustom gnus-summary-tool-bar-gnome
'((gnus-summary-post-news "mail/compose" nil)
- (gnus-summary-insert-new-articles "mail/inbox")
- ;;
+ (gnus-summary-insert-new-articles "mail/inbox" nil
+ :visible (or (not gnus-agent)
+ gnus-plugged))
(gnus-summary-reply-with-original "mail/reply")
(gnus-summary-reply "mail/reply" nil :visible nil)
(gnus-summary-followup-with-original "mail/reply-all")
(gnus-summary-followup "mail/reply-all" nil :visible nil)
(gnus-summary-mail-forward "mail/forward")
(gnus-summary-save-article "mail/save")
- (gnus-summary-search-article-forward "search")
+ (gnus-summary-search-article-forward "search" nil :visible nil)
(gnus-summary-print-article "print")
- (gnus-summary-mark-as-expirable
- "delete" nil
- :visible (gnus-check-backend-function 'request-expire-articles
- gnus-newsgroup-name))
(gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
- (gnus-summary-mark-as-spam
- "mail/spam" t :visible (spam-group-ham-contents-p gnus-newsgroup-name)
- :help "Mark as spam")
- (gnus-summary-mark-as-read-forward
- "mail/not-spam" nil :visible (spam-group-spam-contents-p gnus-newsgroup-name))
;; Some new commands that may need more suitable icons:
(gnus-summary-save-newsrc "save" nil :visible nil)
;; (gnus-summary-show-article "stock_message-display" nil :visible nil)
- (gnus-summary-prev-article "left-arrow" nil :visible nil) ;; Emacs 22
- (gnus-summary-next-article "right-arrow" nil :visible nil) ;; Emacs 22
- (gnus-summary-prev-unread-article "prev-node") ;; Emacs 22
- (gnus-summary-next-unread-article "next-node") ;; Emacs 22
- (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
+ (gnus-summary-prev-article "left-arrow")
+ (gnus-summary-next-article "right-arrow")
+ (gnus-summary-next-page "next-page")
+ ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
;;
;; Maybe some sort-by-... could be added:
;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil)
;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil)
+ (gnus-summary-mark-as-expirable
+ "delete" nil
+ :visible (gnus-check-backend-function 'request-expire-articles
+ gnus-newsgroup-name))
+ (gnus-summary-mark-as-spam
+ "mail/spam" t
+ :visible (and (fboundp 'spam-group-ham-contents-p)
+ (spam-group-ham-contents-p gnus-newsgroup-name))
+ :help "Mark as spam")
+ (gnus-summary-mark-as-read-forward
+ "mail/not-spam" nil
+ :visible (and (fboundp 'spam-group-spam-contents-p)
+ (spam-group-spam-contents-p gnus-newsgroup-name)))
;;
(gnus-summary-exit "exit")
- ;; (customize-group 'gnus-summary) "preferences"
+ (gmm-customize-mode "preferences" t :help "Edit mode preferences")
(gnus-info-find-node "help"))
"List of functions for the summary tool bar (GNOME style).
:set 'gnus-summary-tool-bar-update
:group 'gnus-summary)
+(defvar image-load-path)
+
(defun gnus-summary-make-tool-bar (&optional force)
"Make a summary mode tool bar from `gnus-summary-tool-bar'.
When FORCE, rebuild the tool bar."
tool-bar-mode
(or (not gnus-summary-tool-bar-map) force))
(let* ((load-path
- (gmm-image-load-path "gnus" "mail/save.xpm" 'load-path))
- (image-load-path
- (gmm-image-load-path "gnus" "mail/save.xpm" 'image-load-path))
+ (gmm-image-load-path-for-library "gnus"
+ "mail/save.xpm"
+ nil t))
+ (image-load-path (cons (car load-path)
+ (when (boundp 'image-load-path)
+ image-load-path)))
(map (gmm-tool-bar-from-list gnus-summary-tool-bar
gnus-summary-tool-bar-zap-list
'gnus-summary-mode-map)))
(setq headers (cdr headers)))
(list (nreverse outh))))))))
+
+(declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ())
+
\f
(defun gnus-summary-mode (&optional group)
(aset table ?\r nil)
;; We keep TAB as well.
(aset table ?\t nil)
- ;; We nix out any glyphs over 126 that are not set already.
- (let ((i 256))
+ ;; We nix out any glyphs 127 through 255, or 127 through 159 in
+ ;; Emacs 23 (unicode), that are not set already.
+ (let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160))
+ 160
+ 256)))
(while (>= (setq i (1- i)) 127)
;; Only modify if the entry is nil.
(unless (aref table i)
(gnus-summary-mode group)
(when gnus-carpal
(gnus-carpal-setup-buffer 'summary))
- (unless gnus-single-article-buffer
- (make-local-variable 'gnus-article-buffer)
- (make-local-variable 'gnus-article-current)
- (make-local-variable 'gnus-original-article-buffer))
+ (when (gnus-group-quit-config group)
+ (set (make-local-variable 'gnus-single-article-buffer) nil))
+ (make-local-variable 'gnus-article-buffer)
+ (make-local-variable 'gnus-article-current)
+ (make-local-variable 'gnus-original-article-buffer)
(setq gnus-newsgroup-name group)
;; Set any local variables in the group parameters.
(gnus-summary-set-local-parameters gnus-newsgroup-name)
t
(not (cdr (gnus-data-find-list article)))))
-(defun gnus-make-thread-indent-array ()
- (let ((n 200))
- (unless (and gnus-thread-indent-array
- (= gnus-thread-indent-level gnus-thread-indent-array-level))
- (setq gnus-thread-indent-array (make-vector 201 "")
- gnus-thread-indent-array-level gnus-thread-indent-level)
- (while (>= n 0)
- (aset gnus-thread-indent-array n
- (make-string (* n gnus-thread-indent-level) ? ))
- (setq n (1- n))))))
+(defun gnus-make-thread-indent-array (&optional n)
+ (when (or n
+ (progn (setq n 200) nil)
+ (null gnus-thread-indent-array)
+ (/= gnus-thread-indent-level gnus-thread-indent-array-level))
+ (setq gnus-thread-indent-array (make-vector (1+ n) "")
+ gnus-thread-indent-array-level gnus-thread-indent-level)
+ (while (>= n 0)
+ (aset gnus-thread-indent-array n
+ (make-string (* n gnus-thread-indent-level) ? ))
+ (setq n (1- n)))))
(defun gnus-update-summary-mark-positions ()
"Compute where the summary marks are to go."
(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
(let ((mail-parse-charset gnus-newsgroup-charset)
+ (ignored-from-addresses (gnus-ignored-from-addresses))
; Is it really necessary to do this next part for each summary line?
; Luckily, doesn't seem to slow things down much.
(mail-parse-ignored-charsets
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-ignored-charsets)))
(or
- (and gnus-ignored-from-addresses
- (string-match gnus-ignored-from-addresses gnus-tmp-from)
+ (and ignored-from-addresses
+ (string-match ignored-from-addresses gnus-tmp-from)
(let ((extra-headers (mail-header-extra header))
to
newsgroups)
(concat gnus-summary-to-prefix
(inline
(gnus-summary-extract-address-component
- (funcall gnus-decode-encoded-word-function to)))))
- ((setq newsgroups (cdr (assq 'Newsgroups extra-headers)))
+ (funcall gnus-decode-encoded-address-function to)))))
+ ((setq newsgroups
+ (or
+ (cdr (assq 'Newsgroups extra-headers))
+ (and
+ (memq 'Newsgroups gnus-extra-headers)
+ (eq (car (gnus-find-method-for-group
+ gnus-newsgroup-name)) 'nntp)
+ (gnus-group-real-name gnus-newsgroup-name))))
(concat gnus-summary-newsgroup-prefix newsgroups)))))
(inline (gnus-summary-extract-address-component gnus-tmp-from)))))
gnus-tmp-expirable gnus-tmp-subject-or-nil
&optional gnus-tmp-dummy gnus-tmp-score
gnus-tmp-process)
+ (if (>= gnus-tmp-level (length gnus-thread-indent-array))
+ (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array))
+ gnus-tmp-level)))
(let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
(gnus-tmp-lines (mail-header-lines gnus-tmp-header))
(gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
"Query where the respool algorithm would put this article."
(interactive)
(gnus-summary-select-article)
- (message (gnus-general-simplify-subject (gnus-summary-article-subject))))
+ (message "%s" (gnus-general-simplify-subject (gnus-summary-article-subject))))
(defun gnus-gather-threads-by-subject (threads)
"Gather threads by looking at Subject headers."
infloop))
(defun gnus-make-threads ()
- "Go through the dependency hashtb and find the roots. Return all threads."
+ "Go through the dependency hashtb and find the roots. Return all threads."
(let (threads)
(while (catch 'infloop
(mapatoms
(erase-buffer)))
(kill-buffer (current-buffer)))
;; Sort over trustworthiness.
- (mapcar
- (lambda (relation)
- (when (gnus-dependencies-add-header
- (make-full-mail-header
- gnus-reffed-article-number
- (nth 3 relation) "" (or (nth 4 relation) "")
- (nth 1 relation)
- (or (nth 2 relation) "") 0 0 "")
- gnus-newsgroup-dependencies nil)
- (push gnus-reffed-article-number gnus-newsgroup-limit)
- (push gnus-reffed-article-number gnus-newsgroup-sparse)
- (push (cons gnus-reffed-article-number gnus-sparse-mark)
- gnus-newsgroup-reads)
- (decf gnus-reffed-article-number)))
- (sort relations 'car-less-than-car))
+ (dolist (relation (sort relations 'car-less-than-car))
+ (when (gnus-dependencies-add-header
+ (make-full-mail-header
+ gnus-reffed-article-number
+ (nth 3 relation) "" (or (nth 4 relation) "")
+ (nth 1 relation)
+ (or (nth 2 relation) "") 0 0 "")
+ gnus-newsgroup-dependencies nil)
+ (push gnus-reffed-article-number gnus-newsgroup-limit)
+ (push gnus-reffed-article-number gnus-newsgroup-sparse)
+ (push (cons gnus-reffed-article-number gnus-sparse-mark)
+ gnus-newsgroup-reads)
+ (decf gnus-reffed-article-number)))
(gnus-message 7 "Making sparse threads...done")))
(defun gnus-build-old-threads ()
(error x))
(condition-case () ; from
(gnus-remove-odd-characters
- (funcall gnus-decode-encoded-word-function
+ (funcall gnus-decode-encoded-address-function
(setq x (nnheader-nov-field))))
(error x))
(nnheader-nov-field) ; date
;; First go up in this thread until we find the root.
(setq last-id (gnus-root-id id)
headers (message-flatten-list (gnus-id-to-thread last-id)))
- ;; We have now found the real root of this thread. It might have
+ ;; We have now found the real root of this thread. It might have
;; been gathered into some loose thread, so we have to search
;; through the threads to find the thread we wanted.
(let ((threads gnus-newsgroup-threads)
(1+ (point-at-eol))
(gnus-delete-line)))))))
-(defun gnus-sort-threads-1 (threads func)
+(defun gnus-sort-threads-recursive (threads func)
(sort (mapcar (lambda (thread)
(cons (car thread)
(and (cdr thread)
- (gnus-sort-threads-1 (cdr thread) func))))
+ (gnus-sort-threads-recursive (cdr thread) func))))
threads) func))
+(defun gnus-sort-threads-loop (threads func)
+ (let* ((superthread (cons nil threads))
+ (stack (list (cons superthread threads)))
+ remaining-threads thread)
+ (while stack
+ (setq remaining-threads (cdr (car stack)))
+ (if remaining-threads
+ (progn (setq thread (car remaining-threads))
+ (setcdr (car stack) (cdr remaining-threads))
+ (if (cdr thread)
+ (push (cons thread (cdr thread)) stack)))
+ (setq thread (caar stack))
+ (setcdr thread (sort (cdr thread) func))
+ (pop stack)))
+ (cdr superthread)))
+
(defun gnus-sort-threads (threads)
"Sort THREADS."
(if (not gnus-thread-sort-functions)
threads
(gnus-message 8 "Sorting threads...")
- (let ((max-lisp-eval-depth 5000))
- (prog1 (gnus-sort-threads-1
- threads
- (gnus-make-sort-function gnus-thread-sort-functions))
- (gnus-message 8 "Sorting threads...done")))))
+ (prog1
+ (condition-case nil
+ (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000)))
+ (gnus-sort-threads-recursive
+ threads (gnus-make-sort-function gnus-thread-sort-functions)))
+ ;; Even after binding max-lisp-eval-depth, the recursive
+ ;; sorter might fail for very long threads. In that case,
+ ;; try using a (less well-tested) non-recursive sorter.
+ (error (gnus-sort-threads-loop
+ threads (gnus-make-sort-function
+ gnus-thread-sort-functions))))
+ (gnus-message 8 "Sorting threads...done"))))
(defun gnus-sort-articles (articles)
"Sort ARTICLES."
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
- (string-lessp
+ (gnus-string<
(let ((extract (funcall
gnus-extract-address-components
(mail-header-from h1))))
(defsubst gnus-article-sort-by-recipient (h1 h2)
"Sort articles by recipient."
- (string-lessp
+ (gnus-string<
(let ((extract (funcall
gnus-extract-address-components
(or (cdr (assq 'To (mail-header-extra h1))) ""))))
(defsubst gnus-article-sort-by-subject (h1 h2)
"Sort articles by root subject."
- (string-lessp
+ (gnus-string<
(downcase (gnus-simplify-subject-re (mail-header-subject h1)))
(downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
(defvar gnus-tmp-root-expunged nil)
(defvar gnus-tmp-dummy-line nil)
-(eval-when-compile (defvar gnus-tmp-header))
(defun gnus-extra-header (type &optional header)
"Return the extra header of TYPE."
(or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
gnus-tmp-closing-bracket ?\>)
(setq gnus-tmp-opening-bracket ?\[
gnus-tmp-closing-bracket ?\]))
+ (if (>= gnus-tmp-level (length gnus-thread-indent-array))
+ (gnus-make-thread-indent-array
+ (max (* 2 (length gnus-thread-indent-array))
+ gnus-tmp-level)))
(setq
gnus-tmp-indentation
(aref gnus-thread-indent-array gnus-tmp-level)
t
gnus-summary-ignore-duplicates))
(info (nth 2 entry))
- articles fetched-articles cached)
+ charset articles fetched-articles cached)
(unless (gnus-check-server
(set (make-local-variable 'gnus-current-select-method)
(gnus-find-method-for-group group)))
(error "Couldn't open server"))
+ (setq charset (gnus-group-name-charset gnus-current-select-method group))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
(gnus-activate-group group) ; Or we can activate it...
(progn ; Or we bug out.
(when (equal major-mode 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer)))
- (error "Couldn't activate group %s: %s"
- group (gnus-status-message group))))
+ (error
+ "Couldn't activate group %s: %s"
+ (mm-decode-coding-string group charset)
+ (mm-decode-coding-string (gnus-status-message group) charset))))
(unless (gnus-request-group group t)
- (when (equal major-mode 'gnus-summary-mode)
- (gnus-kill-buffer (current-buffer)))
- (error "Couldn't request group %s: %s"
- group (gnus-status-message group)))
+ (when (equal major-mode 'gnus-summary-mode)
+ (gnus-kill-buffer (current-buffer)))
+ (error "Couldn't request group %s: %s"
+ (mm-decode-coding-string group charset)
+ (mm-decode-coding-string (gnus-status-message group) charset)))
(when gnus-agent
(gnus-agent-possibly-alter-active group (gnus-active group) info)
(setq gnus-newsgroup-auto-expire
(gnus-group-auto-expirable-p group))
;; Set up the article buffer now, if necessary.
- (unless gnus-single-article-buffer
+ (unless (and gnus-single-article-buffer
+ (equal gnus-article-buffer "*Article*"))
(gnus-article-setup-buffer))
;; First and last article in this newsgroup.
(when gnus-newsgroup-headers
(gnus-inverse-list-range-intersection
gnus-newsgroup-articles gnus-newsgroup-seen))))
+(declare-function gnus-get-predicate "gnus-agent" (predicate))
+
(defun gnus-summary-display-make-predicate (display)
(require 'gnus-agent)
(when (= (length display) 1)
(gnus-get-predicate display)))
;; Uses the dynamically bound `number' variable.
-(eval-when-compile
- (defvar number))
+(defvar number)
(defun gnus-article-marked-p (type &optional article)
(let ((article (or article number)))
(cond
;; articles in the group, or (if that's nil), the
;; articles in the cache.
(or
- (gnus-uncompress-range (gnus-active group))
+ (if gnus-newsgroup-maximum-articles
+ (let ((active (gnus-active group)))
+ (gnus-uncompress-range
+ (cons (max (car active)
+ (- (cdr active)
+ gnus-newsgroup-maximum-articles
+ -1))
+ (cdr active))))
+ (gnus-uncompress-range (gnus-active group)))
(gnus-cache-articles-in-group group))
;; Select only the "normal" subset of articles.
(gnus-sorted-nunion
(read-string
(format
"How many articles from %s (%s %d): "
- (gnus-limit-string
- (gnus-group-decoded-name gnus-newsgroup-name)
- 35)
+ (gnus-group-decoded-name gnus-newsgroup-name)
(if initial "max" "default")
number)
(if initial
(let* ((mformat (symbol-value
(intern
(format "gnus-%s-mode-line-format-spec" where))))
- (gnus-tmp-group-name (gnus-group-decoded-name
- gnus-newsgroup-name))
+ (gnus-tmp-group-name (gnus-mode-string-quote
+ (gnus-group-decoded-name
+ gnus-newsgroup-name)))
(gnus-tmp-article-number (or gnus-current-article 0))
(gnus-tmp-unread gnus-newsgroup-unreads)
(gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
(let ((case-fold-search t)
in-reply-to header p lines chars)
(goto-char (point-min))
- ;; Search to the beginning of the next header. Error messages
+ ;; Search to the beginning of the next header. Error messages
;; do not begin with 2 or 3.
(while (re-search-forward "^[23][0-9]+ " nil t)
(setq id nil
;; This implementation of this function, with nine
;; search-forwards instead of the one re-search-forward and
;; a case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
+ ;; about twice as fast, even though it looks messier. You
;; can't have everything, I guess. Speed and elegance
;; doesn't always go hand in hand.
(setq
(progn
(goto-char p)
(if (search-forward "\nfrom:" nil t)
- (funcall gnus-decode-encoded-word-function
+ (funcall gnus-decode-encoded-address-function
(nnheader-header-value))
"(nobody)"))
;; Date.
(allp (cond
((eq gnus-read-all-available-headers t)
t)
- ((stringp gnus-read-all-available-headers)
+ ((and (stringp gnus-read-all-available-headers)
+ group)
(string-match gnus-read-all-available-headers group))
(t
nil)))
(let ((top-pos (save-excursion (forward-line (- top)) (point))))
(if (> bottom top-pos)
;; Keep the second line from the top visible
- (set-window-start window top-pos t)
+ (set-window-start window top-pos)
;; Try to keep the bottom line visible; if it's partially
;; obscured, either scroll one more line to make it fully
;; visible, or revert to using TOP-POS.
(active (or (gnus-active group) (gnus-activate-group group)))
(last (or (cdr active)
(error "Group %s couldn't be activated " group)))
+ (bottom (if gnus-newsgroup-maximum-articles
+ (max (car active)
+ (- last gnus-newsgroup-maximum-articles -1))
+ (car active)))
first nlast unread)
;; If none are read, then all are unread.
(if (not read)
- (setq first (car active))
+ (setq first bottom)
;; If the range of read articles is a single range, then the
;; first unread article is the article after the last read
;; article. Sounds logical, doesn't it?
(if (and (not (listp (cdr read)))
- (or (< (car read) (car active))
+ (or (< (car read) bottom)
(progn (setq read (list read))
nil)))
- (setq first (max (car active) (1+ (cdr read))))
+ (setq first (max bottom (1+ (cdr read))))
;; `read' is a list of ranges.
(when (/= (setq nlast (or (and (numberp (car read)) (car read))
(caar read)))
1)
- (setq first (car active)))
+ (setq first bottom))
(while read
(when first
(while (< first nlast)
(gnus-list-range-difference
(gnus-list-range-difference
(gnus-sorted-complement
- (gnus-uncompress-range active)
+ (gnus-uncompress-range
+ (if gnus-newsgroup-maximum-articles
+ (cons (max (car active)
+ (- (cdr active)
+ gnus-newsgroup-maximum-articles
+ -1))
+ (cdr active))
+ active))
(gnus-list-of-unread-articles group))
(cdr (assq 'dormant marked)))
(cdr (assq 'tick marked))))))
(let* ((read (gnus-info-read (gnus-get-info group)))
(active (or (gnus-active group) (gnus-activate-group group)))
(last (cdr active))
+ (bottom (if gnus-newsgroup-maximum-articles
+ (max (car active)
+ (- last gnus-newsgroup-maximum-articles -1))
+ (car active)))
first nlast unread)
;; If none are read, then all are unread.
(if (not read)
- (setq first (car active))
+ (setq first bottom)
;; If the range of read articles is a single range, then the
;; first unread article is the article after the last read
;; article. Sounds logical, doesn't it?
(if (and (not (listp (cdr read)))
- (or (< (car read) (car active))
+ (or (< (car read) bottom)
(progn (setq read (list read))
nil)))
- (setq first (max (car active) (1+ (cdr read))))
+ (setq first (max bottom (1+ (cdr read))))
;; `read' is a list of ranges.
(when (/= (setq nlast (or (and (numberp (car read)) (car read))
(caar read)))
1)
- (setq first (car active)))
+ (setq first bottom))
(while read
(when first
(push (cons first nlast) unread))
(gnus-save-newsrc-file)
(gnus-dribble-save)))
+(declare-function gnus-cache-write-active "gnus-cache" (&optional force))
+
(defun gnus-summary-exit (&optional temporary leave-hidden)
"Exit reading current newsgroup, and then return to group selection mode.
`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
(gnus-run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
- (gnus-kill-buffer gnus-original-article-buffer)
- (setq gnus-article-current nil))
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ ;; Don't kill sticky article buffers
+ (unless (eq major-mode 'gnus-sticky-article-mode)
+ (gnus-kill-buffer gnus-article-buffer)
+ (setq gnus-article-current nil))))
+ (gnus-kill-buffer gnus-original-article-buffer))
(when gnus-use-cache
(gnus-cache-possibly-remove-articles)
(gnus-cache-save-buffers))
(gnus-group-jump-to-group group))
(gnus-run-hooks 'gnus-summary-exit-hook)
(unless (or quit-config
+ (not gnus-summary-next-group-on-exit)
;; If this group has disappeared from the summary
;; buffer, don't skip forwards.
(not (string= group (gnus-group-group-name))))
(setq group-point (point))
(if temporary
nil ;Nothing to do.
- ;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
- (gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer)
- (setq gnus-article-current nil))
(set-buffer buf)
(if (not gnus-kill-summary-on-exit)
(progn
(gnus-set-global-variables))))
(if (or (eq (cdr quit-config) 'article)
(eq (cdr quit-config) 'pick))
- (progn
- ;; The current article may be from the ephemeral group
- ;; thus it is best that we reload this article
- ;;
- ;; If we're exiting from a large digest, this can be
- ;; extremely slow. So, it's better not to reload it. -- jh.
- ;;(gnus-summary-show-article)
- (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
- (gnus-configure-windows 'pick 'force)
- (gnus-configure-windows (cdr quit-config) 'force)))
+ (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
+ (gnus-configure-windows 'pick 'force)
+ (gnus-configure-windows (cdr quit-config) 'force))
(gnus-configure-windows (cdr quit-config) 'force))
(when (eq major-mode 'gnus-summary-mode)
- (gnus-summary-next-subject 1 nil t)
+ (if (memq gnus-auto-select-on-ephemeral-exit '(next-noselect
+ next-unread-noselect))
+ (when (zerop (cond ((eq gnus-auto-select-on-ephemeral-exit
+ 'next-noselect)
+ (gnus-summary-next-subject 1 nil t))
+ ((eq gnus-auto-select-on-ephemeral-exit
+ 'next-unread-noselect)
+ (gnus-summary-next-subject 1 t t))))
+ ;; Hide the article buffer which displays the article different
+ ;; from the one that the cursor points to in the summary buffer.
+ (gnus-configure-windows 'summary 'force))
+ (cond ((eq gnus-auto-select-on-ephemeral-exit 'next)
+ (gnus-summary-next-subject 1))
+ ((eq gnus-auto-select-on-ephemeral-exit 'next-unread)
+ (gnus-summary-next-subject 1 t))))
(gnus-summary-recenter)
(gnus-summary-position-point))))
(defun gnus-summary-display-article (article &optional all-header)
"Display ARTICLE in article buffer."
- (when (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- (mm-enable-multibyte)))
+ (unless (and (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (eq major-mode 'gnus-article-mode)))
+ (gnus-article-setup-buffer))
(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)))
+ (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))
(if (null article)
nil
(prog1
If SUBJECT, only articles with SUBJECT are selected.
If BACKWARD, the previous article is selected instead of the next."
(interactive "P")
+ ;; Make sure we are in the summary buffer.
+ (unless (eq major-mode 'gnus-summary-mode)
+ (set-buffer gnus-summary-buffer))
(cond
;; Is there such an article?
((and (gnus-summary-search-forward unread subject backward)
(gnus-summary-article-subject))))
(defun gnus-summary-prev-article (&optional unread subject)
- "Select the article after the current one.
+ "Select the article before the current one.
If UNREAD is non-nil, only unread articles are selected."
(interactive "P")
(gnus-summary-next-article unread subject t))
(gnus-summary-limit articles))
(gnus-summary-position-point))))
+(defun gnus-summary-limit-to-address (address &optional not-matching)
+ "Limit the summary buffer to articles with the given ADDRESS.
+
+If NOT-MATCHING, exclude ADDRESS.
+
+To, Cc and From headers are checked. You need to include `To' and `Cc'
+in `nnmail-extra-headers'."
+ (interactive
+ (list (read-string (format "%s address (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")))
+ current-prefix-arg))
+ (when (not (equal "" address))
+ (prog1 (let* ((to
+ (if (memq 'To nnmail-extra-headers)
+ (gnus-summary-find-matching
+ (cons 'extra 'To) address 'all nil nil
+ not-matching)
+ (gnus-message
+ 1 "`To' isn't present in `nnmail-extra-headers'")
+ (sit-for 1)
+ t))
+ (cc
+ (if (memq 'Cc nnmail-extra-headers)
+ (gnus-summary-find-matching
+ (cons 'extra 'Cc) address 'all nil nil
+ not-matching)
+ (gnus-message
+ 1 "`Cc' isn't present in `nnmail-extra-headers'")
+ (sit-for 1)
+ t))
+ (from
+ (gnus-summary-find-matching "from" address
+ 'all nil nil not-matching))
+ (articles
+ (if not-matching
+ ;; We need the numbers that are in all lists:
+ (if (eq cc t)
+ (if (eq to t)
+ from
+ (mapcar (lambda (a) (car (memq a from))) to))
+ (if (eq to t)
+ (mapcar (lambda (a) (car (memq a from))) cc)
+ (mapcar (lambda (a) (car (memq a from)))
+ (mapcar (lambda (a) (car (memq a to)))
+ cc))))
+ (nconc (if (eq to t) nil to)
+ (if (eq cc t) nil cc)
+ from))))
+ (unless articles
+ (error "Found no matches for \"%s\"" address))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-strange-charsets-predicate (header)
+ (let ((string (concat (mail-header-subject header)
+ (mail-header-from header)))
+ charset found)
+ (dotimes (i (1- (length string)))
+ (setq charset (format "%s" (char-charset (aref string (1+ i)))))
+ (when (string-match "unicode\\|big\\|japanese" charset)
+ (setq found t)))
+ found))
+
+(defun gnus-summary-limit-to-predicate (predicate)
+ "Limit to articles where PREDICATE returns non-nil.
+PREDICATE will be called with the header structures of the
+articles."
+ (let ((articles nil)
+ (case-fold-search t))
+ (dolist (header gnus-newsgroup-headers)
+ (when (funcall predicate header)
+ (push (mail-header-number header) articles)))
+ (gnus-summary-limit (nreverse articles))))
+
(defun gnus-summary-limit-to-age (age &optional younger-p)
"Limit the summary buffer to articles that are older than (or equal) AGE days.
If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
gnus-duplicate-mark gnus-souped-mark)
'reverse)))
+(defun gnus-summary-limit-to-headers (match &optional reverse)
+ "Limit the summary buffer to articles that have headers that match MATCH.
+If REVERSE (the prefix), limit to articles that don't match."
+ (interactive "sMatch headers (regexp): \nP")
+ (gnus-summary-limit-to-bodies match reverse t))
+
+(defun gnus-summary-limit-to-bodies (match &optional reverse headersp)
+ "Limit the summary buffer to articles that have bodies that match MATCH.
+If REVERSE (the prefix), limit to articles that don't match."
+ (interactive "sMatch body (regexp): \nP")
+ (let ((articles nil)
+ (gnus-select-article-hook nil) ;Disable hook.
+ (gnus-article-prepare-hook nil)
+ (gnus-use-article-prefetch nil)
+ (gnus-keep-backlog nil)
+ (gnus-break-pages nil)
+ (gnus-summary-display-arrow nil)
+ (gnus-updated-mode-lines nil)
+ (gnus-auto-center-summary nil)
+ (gnus-display-mime-function nil))
+ (dolist (data gnus-newsgroup-data)
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil (gnus-data-number data)))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (article-goto-body)
+ (let* ((case-fold-search t)
+ (found (if headersp
+ (re-search-backward match nil t)
+ (re-search-forward match nil t))))
+ (when (or (and found
+ (not reverse))
+ (and (not found)
+ reverse))
+ (push (gnus-data-number data) articles)))))
+ (if (not articles)
+ (message "No messages matched")
+ (gnus-summary-limit articles)))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-limit-to-singletons (&optional threadsp)
+ "Limit the summary buffer to articles that aren't part on any thread.
+If THREADSP (the prefix), limit to articles that are in threads."
+ (interactive "P")
+ (let ((articles nil)
+ thread-articles
+ threads)
+ (dolist (thread gnus-newsgroup-threads)
+ (if (stringp (car thread))
+ (dolist (thread (cdr thread))
+ (push thread threads))
+ (push thread threads)))
+ (dolist (thread threads)
+ (setq thread-articles (gnus-articles-in-thread thread))
+ (when (or (and threadsp
+ (> (length thread-articles) 1))
+ (and (not threadsp)
+ (= (length thread-articles) 1)))
+ (setq articles (nconc thread-articles articles))))
+ (if (not articles)
+ (message "No messages matched")
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point)))
+
(defun gnus-summary-limit-to-replied (&optional unreplied)
"Limit the summary buffer to replied articles.
If UNREPLIED (the prefix), limit to unreplied articles."
(interactive)
(let ((gnus-verbose (max 6 gnus-verbose)))
(if (not gnus-newsgroup-dormant)
- (gnus-message 3 "No cached articles for this group")
+ (gnus-message 3 "No dormant articles for this group")
(gnus-summary-goto-subjects gnus-newsgroup-dormant))))
+(defun gnus-summary-insert-ticked-articles ()
+ "Insert ticked articles for this group into the current buffer."
+ (interactive)
+ (let ((gnus-verbose (max 6 gnus-verbose)))
+ (if (not gnus-newsgroup-marked)
+ (gnus-message 3 "No ticked articles for this group")
+ (gnus-summary-goto-subjects gnus-newsgroup-marked))))
+
(defun gnus-summary-limit-include-dormant ()
"Display all the hidden articles that are marked as dormant.
Note that this command only works on a subset of the articles currently
;; will really go down to a leaf article first, before slowly
;; working its way up towards the root.
(when thread
- (let* ((max-lisp-eval-depth 5000)
+ (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth))
(children
(if (cdr thread)
(apply '+ (mapcar 'gnus-summary-limit-children
;; the parent article.
(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
- to-address))))))
+ (setq params
+ (append
+ (list (cons 'to-address
+ (funcall gnus-decode-encoded-address-function
+ to-address))))))
(setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
(insert-buffer-substring gnus-original-article-buffer)
;; Remove lines that may lead nndoc to misinterpret the
(widen)
(isearch-forward regexp-p))))
+(defun gnus-summary-repeat-search-article-forward ()
+ "Repeat the previous search forwards."
+ (interactive)
+ (unless gnus-last-search-regexp
+ (error "No previous search"))
+ (gnus-summary-search-article-forward gnus-last-search-regexp))
+
+(defun gnus-summary-repeat-search-article-backward ()
+ "Repeat the previous search backwards."
+ (interactive)
+ (unless gnus-last-search-regexp
+ (error "No previous search"))
+ (gnus-summary-search-article-forward gnus-last-search-regexp t))
+
(defun gnus-summary-search-article-forward (regexp &optional backward)
"Search for an article containing REGEXP forward.
If BACKWARD, search backward instead."
(defun gnus-summary-caesar-message (&optional arg)
"Caesar rotate the current article by 13.
-The numerical prefix specifies how many places to rotate each letter
-forward."
+With a non-numerical prefix, also rotate headers. A numerical
+prefix specifies how many places to rotate each letter forward."
(interactive "P")
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(widen)
(let ((start (window-start))
buffer-read-only)
- (message-caesar-buffer-body arg)
+ (if (equal arg '(4))
+ (message-caesar-buffer-body nil t)
+ (message-caesar-buffer-body arg))
(set-window-start (get-buffer-window (current-buffer)) start)))))
;; Create buttons and stuff...
(gnus-treat-article nil))
+(declare-function idna-to-unicode "ext:idna" (str))
+
(defun gnus-summary-idna-message (&optional arg)
"Decode IDNA encoded domain names in the current articles.
IDNA encoded domain names looks like `xn--bar'. If a string
(replace-match (idna-to-unicode (match-string 1))))
(set-window-start (get-buffer-window (current-buffer)) start)))))))
-(autoload 'unmorse-region "morse"
- "Convert morse coded text in region to ordinary ASCII text."
- t)
-
(defun gnus-summary-morse-message (&optional arg)
"Morse decode the current article."
(interactive "P")
(crosspost "Crosspost" "Crossposting")))
(copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*")))
- art-group to-method new-xref article to-groups articles-to-update-marks)
+ art-group to-method new-xref article to-groups
+ articles-to-update-marks encoded)
(unless (assq action names)
(error "Unknown action %s" action))
;; Read the newsgroup name.
(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))
- (symbol-value (intern (format "gnus-current-%s-group" action)))
- articles prefix))
- (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
- (setq to-method (or select-method
- (gnus-server-to-method
- (gnus-group-method to-newsgroup))))
+ (setq to-newsgroup (gnus-read-move-group-name
+ (cadr (assq action names))
+ (symbol-value
+ (intern (format "gnus-current-%s-group" action)))
+ articles prefix)
+ encoded to-newsgroup
+ to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
+ (set (intern (format "gnus-current-%s-group" action))
+ (mm-decode-coding-string
+ to-newsgroup
+ (gnus-group-name-charset to-method to-newsgroup))))
+ (unless to-method
+ (setq to-method (or select-method
+ (gnus-server-to-method
+ (gnus-group-method to-newsgroup)))))
+ (setq to-newsgroup
+ (or encoded
+ (and to-newsgroup
+ (mm-encode-coding-string
+ to-newsgroup
+ (gnus-group-name-charset to-method to-newsgroup)))))
;; Check the method we are to move this article to...
(unless (gnus-check-backend-function
'request-accept-article (car to-method))
(error "Can't open server %s" (car to-method)))
(gnus-message 6 "%s to %s: %s..."
(caddr (assq action names))
- (or (car select-method) to-newsgroup) articles)
+ (or (car select-method)
+ (gnus-group-decoded-name to-newsgroup))
+ articles)
(while articles
(setq article (pop articles))
(setq
(gnus-dup-unsuppress-article article)
(let* ((from-method (gnus-find-method-for-group
gnus-newsgroup-name))
- (to-method (gnus-find-method-for-group
- to-newsgroup))
+ (to-method (or select-method
+ (gnus-find-method-for-group to-newsgroup)))
(move-is-internal (gnus-method-equal from-method to-method)))
- (gnus-request-move-article
- article ; Article to move
- gnus-newsgroup-name ; From newsgroup
- (nth 1 (gnus-find-method-for-group
- gnus-newsgroup-name)) ; Server
- (list 'gnus-request-accept-article
- to-newsgroup (list 'quote select-method)
- (not articles) t) ; Accept form
- (not articles) ; Only save nov last time
- move-is-internal))) ; is this move internal?
+ (gnus-request-move-article
+ article ; Article to move
+ gnus-newsgroup-name ; From newsgroup
+ (nth 1 (gnus-find-method-for-group
+ gnus-newsgroup-name)) ; Server
+ (list 'gnus-request-accept-article
+ to-newsgroup (list 'quote select-method)
+ (not articles) t) ; Accept form
+ (not articles) ; Only save nov last time
+ move-is-internal))) ; is this move internal?
;; Copy the article.
((eq action 'copy)
(save-excursion
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(when (consp (setq art-group
(gnus-request-accept-article
- to-newsgroup select-method (not articles))))
+ to-newsgroup select-method (not articles) t)))
(setq new-xref (concat new-xref " " (car art-group)
":"
(number-to-string (cdr art-group))))
;; it and replace the new article.
(nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
- (cdr art-group) to-newsgroup (current-buffer))
+ (cdr art-group) to-newsgroup (current-buffer) t)
art-group))))))
(cond
((not art-group)
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
- article gnus-newsgroup-name (current-buffer))))
+ article gnus-newsgroup-name (current-buffer) t)))
;; run the move/copy/crosspost/respool hook
(run-hook-with-args 'gnus-summary-article-move-hook
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
-
+
(gnus-summary-goto-subject article)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark))))
(set-buffer gnus-group-buffer)
(let ((gnus-group-marked to-groups))
(gnus-group-get-new-news-this-group nil t)))
-
+
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
(interactive)
(or gnus-expert-user
(gnus-yes-or-no-p
- "Are you really, really, really sure you want to delete all these messages? ")
+ "Are you really, really sure you want to delete all expirable messages? ")
(error "Phew!"))
(gnus-summary-expire-articles t))
;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
(defun gnus-summary-delete-article (&optional n)
"Delete the N next (mail) articles.
-This command actually deletes articles. This is not a marking
+This command actually deletes articles. This is not a marking
command. The article will disappear forever from your life, never to
return.
(message-options message-options)
(message-options-set-recipient)
(mail-parse-ignored-charsets
- ',gnus-newsgroup-ignored-charsets))
+ ',gnus-newsgroup-ignored-charsets)
+ (rfc2047-header-encoding-alist
+ ',(let ((charset (gnus-group-name-charset
+ (gnus-find-method-for-group
+ gnus-newsgroup-name)
+ gnus-newsgroup-name)))
+ (append (list (cons "Newsgroups" charset)
+ (cons "Followup-To" charset)
+ (cons "Xref" charset))
+ rfc2047-header-encoding-alist))))
,(if (not raw) '(progn
(mml-to-mime)
(mml-destroy-buffers)
(gnus-summary-mark-forward (- n) gnus-unread-mark))
(defun gnus-summary-mark-unread-as-read ()
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(when (memq gnus-current-article gnus-newsgroup-unreads)
(gnus-summary-mark-article gnus-current-article gnus-read-mark)))
(defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(let ((mark (gnus-summary-article-mark)))
(when (or (gnus-unread-mark-p mark)
(gnus-read-mark-p mark))
(or new-mark gnus-read-mark)))))
(defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark)
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(let ((mark (gnus-summary-article-mark)))
(when (or (gnus-unread-mark-p mark)
(gnus-read-mark-p mark))
(or new-mark gnus-read-mark)))))
(defun gnus-summary-mark-unread-as-ticked ()
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(when (memq gnus-current-article gnus-newsgroup-unreads)
(gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
(goto-char (point-min))
(push gnus-newsgroup-limit gnus-newsgroup-limits)
(setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
- (mapcar (lambda (x) (push (mail-header-number x)
- gnus-newsgroup-limit))
- headers)
+ (dolist (x headers)
+ (push (mail-header-number x) gnus-newsgroup-limit))
(gnus-summary-prepare-unthreaded (nreverse headers))
(goto-char (point-min))
(gnus-summary-position-point)
gnus-newsgroup-dormant nil))
(setq gnus-newsgroup-unreads
(gnus-sorted-nunion
- (gnus-intersection gnus-newsgroup-unreads
- gnus-newsgroup-downloadable)
- gnus-newsgroup-unfetched)))
+ (gnus-sorted-intersection gnus-newsgroup-unreads
+ gnus-newsgroup-downloadable)
+ (gnus-sorted-difference gnus-newsgroup-unfetched
+ gnus-newsgroup-cached))))
;; We actually mark all articles as canceled, which we
;; have to do when using auto-expiry or adaptive scoring.
(gnus-summary-show-all-threads)
(error "The current newsgroup does not support article editing"))
(unless (<= (length gnus-newsgroup-processable) 1)
(error "No more than one article may be marked"))
- (save-window-excursion
- (let ((gnus-article-buffer " *reparent*")
- (current-article (gnus-summary-article-number))
- ;; First grab the marked article, otherwise one line up.
- (parent-article (if (not (null gnus-newsgroup-processable))
- (car gnus-newsgroup-processable)
- (save-excursion
- (if (eq (forward-line -1) 0)
- (gnus-summary-article-number)
- (error "Beginning of summary buffer"))))))
- (unless (not (eq current-article parent-article))
- (error "An article may not be self-referential"))
- (let ((message-id (mail-header-id
- (gnus-summary-article-header parent-article))))
- (unless (and message-id (not (equal message-id "")))
- (error "No message-id in desired parent"))
- (gnus-with-article current-article
- (save-restriction
- (goto-char (point-min))
- (message-narrow-to-head)
- (if (re-search-forward "^References: " nil t)
- (progn
- (re-search-forward "^[^ \t]" nil t)
- (forward-line -1)
- (end-of-line)
- (insert " " message-id))
- (insert "References: " message-id "\n"))))
- (set-buffer gnus-summary-buffer)
- (gnus-summary-unmark-all-processable)
- (gnus-summary-update-article current-article)
- (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
+ (let ((child (gnus-summary-article-number))
+ ;; First grab the marked article, otherwise one line up.
+ (parent (if (not (null gnus-newsgroup-processable))
+ (car gnus-newsgroup-processable)
+ (save-excursion
+ (if (eq (forward-line -1) 0)
+ (gnus-summary-article-number)
+ (error "Beginning of summary buffer"))))))
+ (gnus-summary-reparent-children parent (list child))))
+
+(defun gnus-summary-reparent-children (parent children)
+ "Make PARENT the parent of CHILDREN.
+When called interactively, PARENT is the current article and CHILDREN
+are the process-marked articles."
+ (interactive
+ (list (gnus-summary-article-number)
+ (gnus-summary-work-articles nil)))
+ (dolist (child children)
+ (save-window-excursion
+ (let ((gnus-article-buffer " *reparent*"))
+ (unless (not (eq parent child))
+ (error "An article may not be self-referential"))
+ (let ((message-id (mail-header-id
+ (gnus-summary-article-header parent))))
+ (unless (and message-id (not (equal message-id "")))
+ (error "No message-id in desired parent"))
+ (gnus-with-article child
+ (save-restriction
+ (goto-char (point-min))
+ (message-narrow-to-head)
+ (if (re-search-forward "^References: " nil t)
+ (progn
+ (re-search-forward "^[^ \t]" nil t)
+ (forward-line -1)
+ (end-of-line)
+ (insert " " message-id))
+ (insert "References: " message-id "\n"))))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-unmark-all-processable)
+ (gnus-summary-update-article child)
+ (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
(gnus-summary-update-secondary-mark (cdr gnus-article-current)))
- (gnus-summary-rethread-current)
- (gnus-message 3 "Article %d is now the child of article %d"
- current-article parent-article)))))
+ (gnus-summary-rethread-current)
+ (gnus-message 3 "Article %d is now the child of article %d"
+ child parent))))))
(defun gnus-summary-toggle-threads (&optional arg)
"Toggle showing conversation threads.
(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))))
+ (mapcar (lambda (number)
+ (gnus-summary-article-header number))
+ articles))))
(defun gnus-summary-hide-all-threads (&optional predicate)
"Hide all thread subtrees.
(while (gnus-summary-go-up-thread))
(gnus-summary-article-number))
+(defun gnus-summary-expire-thread ()
+ "Mark articles under current thread as expired."
+ (interactive)
+ (gnus-summary-kill-thread 0))
+
(defun gnus-summary-kill-thread (&optional unmark)
"Mark articles under current thread as read.
If the prefix argument is positive, remove any kinds of marks.
+If the prefix argument is zero, mark thread as expired.
If the prefix argument is negative, tick articles instead."
(interactive "P")
(when unmark
(setq unmark (prefix-numeric-value unmark)))
- (let ((articles (gnus-summary-articles-in-thread)))
+ (let ((articles (gnus-summary-articles-in-thread))
+ (hide (or (null unmark) (= unmark 0))))
(save-excursion
;; Expand the thread.
(gnus-summary-show-thread)
(gnus-summary-mark-article-as-read gnus-killed-mark))
((> unmark 0)
(gnus-summary-mark-article-as-unread gnus-unread-mark))
+ ((= unmark 0)
+ (gnus-summary-mark-article-as-unread gnus-expirable-mark))
(t
(gnus-summary-mark-article-as-unread gnus-ticked-mark)))
(setq articles (cdr articles))))
- ;; Hide killed subtrees.
- (and (null unmark)
+ ;; Hide killed subtrees when hide is true.
+ (and hide
gnus-thread-hide-killed
(gnus-summary-hide-thread))
- ;; If marked as read, go to next unread subject.
- (when (null unmark)
+ ;; If hide is t, go to next unread subject.
+ (when hide
;; Go to next unread subject.
(gnus-summary-next-subject 1 t)))
(gnus-set-mode-line 'summary))
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.
-The variable `gnus-default-article-saver' specifies the saver function."
+The variable `gnus-default-article-saver' specifies the saver function.
+
+If the optional second argument NOT-SAVED is non-nil, articles saved
+will not be marked as saved."
(interactive "P")
+ (require 'gnus-art)
(let* ((articles (gnus-summary-work-articles n))
(save-buffer (save-excursion
(nnheader-set-temp-buffer " *Gnus Save*")))
(num (length articles))
+ ;; Whether to save decoded articles or raw articles.
+ (decode (when gnus-article-save-coding-system
+ (get gnus-default-article-saver :decode)))
+ ;; When saving many articles in a single file, use the other
+ ;; function to save articles other than the first one.
+ (saver2 (get gnus-default-article-saver :function))
+ (gnus-prompt-before-saving (if saver2
+ t
+ gnus-prompt-before-saving))
+ (gnus-default-article-saver gnus-default-article-saver)
header file)
(dolist (article articles)
(setq header (gnus-summary-article-header article))
(gnus-message 1 "Article %d is unsaveable" article))
;; This is a real article.
(save-window-excursion
- (let ((gnus-display-mime-function nil)
- (gnus-article-prepare-hook nil))
- (gnus-summary-select-article t nil nil article)))
+ (let ((gnus-display-mime-function (when decode
+ gnus-display-mime-function))
+ (gnus-article-prepare-hook (when decode
+ gnus-article-prepare-hook)))
+ (gnus-summary-select-article t nil nil article)
+ (gnus-summary-goto-subject article)))
(save-excursion
(set-buffer save-buffer)
(erase-buffer)
- (insert-buffer-substring gnus-original-article-buffer))
+ (insert-buffer-substring (if decode
+ gnus-article-buffer
+ gnus-original-article-buffer)))
(setq file (gnus-article-save save-buffer file num))
(gnus-summary-remove-process-mark article)
(unless not-saved
- (gnus-summary-set-saved-mark article))))
+ (gnus-summary-set-saved-mark article)))
+ (when saver2
+ (setq gnus-default-article-saver saver2
+ saver2 nil)))
(gnus-kill-buffer save-buffer)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)
(gnus-configure-windows 'pipe))))
(defun gnus-summary-save-article-mail (&optional arg)
- "Append the current article to an mail file.
+ "Append the current article to a Unix mail box file.
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,
(let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
(gnus-summary-save-article arg)))
+(defun gnus-summary-write-article-body-file (&optional arg)
+ "Write the current article body to a file, deleting the previous file.
+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-write-body-to-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.
(format "these %d articles" (length articles))
"this article")))
(to-newsgroup
- (cond
- ((null split-name)
- (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-with-default
- (car split-name) prom
- gnus-active-hashtb
- 'gnus-valid-move-group-p
- nil nil
- 'gnus-group-history))
- (t
- (gnus-completing-read-with-default
- nil prom
- (mapcar 'list (nreverse split-name))
- nil nil nil
- 'gnus-group-history))))
- (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
+ (let (active group)
+ (when (or (null split-name) (= 1 (length split-name)))
+ (setq active (gnus-make-hashtable (length gnus-active-hashtb)))
+ (mapatoms (lambda (symbol)
+ (setq group (symbol-name symbol))
+ (when (string-match "[^\000-\177]" group)
+ (setq group (gnus-group-decoded-name group)))
+ (set (intern group active) group))
+ gnus-active-hashtb))
+ (cond
+ ((null split-name)
+ (gnus-completing-read-with-default
+ default prom active 'gnus-valid-move-group-p nil prefix
+ 'gnus-group-history))
+ ((= 1 (length split-name))
+ (gnus-completing-read-with-default
+ (car split-name) prom active 'gnus-valid-move-group-p nil nil
+ 'gnus-group-history))
+ (t
+ (gnus-completing-read-with-default
+ nil prom (mapcar 'list (nreverse split-name)) nil nil nil
+ 'gnus-group-history)))))
+ (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
+ encoded)
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
(setq to-newsgroup default))
(unless to-newsgroup
(error "No group name entered"))
- (or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup nil nil to-method)
+ (setq encoded (mm-encode-coding-string
+ to-newsgroup
+ (gnus-group-name-charset to-method to-newsgroup)))
+ (or (gnus-active encoded)
+ (gnus-activate-group encoded nil nil to-method)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (and (gnus-request-create-group to-newsgroup to-method)
- (gnus-activate-group
- to-newsgroup nil nil to-method)
- (gnus-subscribe-group to-newsgroup))
+ (or (and (gnus-request-create-group encoded to-method)
+ (gnus-activate-group encoded nil nil to-method)
+ (gnus-subscribe-group encoded))
(error "Couldn't create group %s" to-newsgroup)))
- (error "No such group: %s" to-newsgroup)))
- to-newsgroup))
+ (error "No such group: %s" to-newsgroup))
+ encoded)))
+
+(defvar gnus-summary-save-parts-counter)
+(declare-function mm-uu-dissect "mm-uu" (&optional noheader mime-type))
(defun gnus-summary-save-parts (type dir n &optional reverse)
"Save parts matching TYPE to DIR.
(let ((handles (or gnus-article-mime-handles
(mm-dissect-buffer nil gnus-article-loose-mime)
(and gnus-article-emulate-mime
- (mm-uu-dissect)))))
+ (mm-uu-dissect))))
+ (gnus-summary-save-parts-counter 1))
(when handles
(gnus-summary-save-parts-1 type dir handles reverse)
(unless gnus-article-mime-handles ;; Don't destroy this case.
(mm-handle-disposition handle) 'filename)
(mail-content-type-get
(mm-handle-type handle) 'name)
- (concat gnus-newsgroup-name
- "." (number-to-string
- (cdr gnus-article-current))))))
+ (format "%s.%d.%d" gnus-newsgroup-name
+ (cdr gnus-article-current)
+ gnus-summary-save-parts-counter))))
dir)))
+ (incf gnus-summary-save-parts-counter)
(unless (file-exists-p file)
(mm-save-part-to-file handle file))))))
() ; Malformed head.
(unless (gnus-summary-article-sparse-p (mail-header-number header))
(when (and (stringp id)
- (not (string= (gnus-group-real-name group)
- (car where))))
- ;; If we fetched by Message-ID and the article came
- ;; from a different group, we fudge some bogus article
- ;; numbers for this article.
+ (or
+ (not (string= (gnus-group-real-name group)
+ (car where)))
+ (not (gnus-server-equal gnus-override-method
+ (gnus-group-method group)))))
+ ;; If we fetched by Message-ID and the article came from
+ ;; a different group (or server), we fudge some bogus
+ ;; article numbers for this article.
(mail-header-set-number header gnus-reffed-article-number))
(save-excursion
(set-buffer gnus-summary-buffer)
(when gnus-suppress-duplicates
(gnus-dup-suppress-articles))
- ;; We might want to build some more threads first.
- (when (and gnus-fetch-old-headers
- (eq gnus-headers-retrieved-by 'nov))
- (if (eq gnus-fetch-old-headers 'invisible)
- (gnus-build-all-threads)
- (gnus-build-old-threads)))
+ (if (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov))
+ ;; We might want to build some more threads first.
+ (if (eq gnus-fetch-old-headers 'invisible)
+ (gnus-build-all-threads)
+ (gnus-build-old-threads))
+ ;; Mark the inserted articles that are unread as unread.
+ (setq gnus-newsgroup-unreads
+ (gnus-sorted-nunion
+ gnus-newsgroup-unreads
+ (gnus-sorted-nintersection
+ (gnus-list-of-unread-articles gnus-newsgroup-name)
+ articles)))
+ ;; Mark the inserted articles as selected so that the information
+ ;; of the marks having been changed by a user may be updated when
+ ;; exiting this group. See `gnus-summary-update-info'.
+ (dolist (art articles)
+ (setq gnus-newsgroup-unselected (delq art gnus-newsgroup-unselected))))
;; Let the Gnus agent mark articles as read.
(when gnus-agent
(gnus-agent-get-undownloaded-list))
(read-string
(format
"How many articles from %s (%s %d): "
- (gnus-limit-string
- (gnus-group-decoded-name gnus-newsgroup-name) 35)
+ (gnus-group-decoded-name gnus-newsgroup-name)
(if initial "max" "default")
len)
(if initial
projects / gnus / blobdiff