;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(eval-when-compile
(require 'cl)
- (defvar tool-bar-map))
+ (defvar tool-bar-mode))
(require 'gnus)
(require 'gnus-group)
(require 'gnus-int)
(require 'gnus-undo)
(require 'gnus-util)
+(require 'gmm-utils)
(require 'mm-decode)
(require 'nnoo)
(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 read (or
-just marked as read) article, the old article will not normally be
-displayed in the Summary buffer. If this variable is non-nil, Gnus
-will attempt to grab the headers to the old articles, and thereby
-build complete threads. If it has the value `some', only enough
-headers to connect otherwise loose threads will be displayed. This
-variable can also be a number. In that case, no more than that number
-of old headers will be fetched. If it has the value `invisible', all
+If an unread article in the group refers to an older, already
+read (or just marked as read) article, the old article will not
+normally be displayed in the Summary buffer. If this variable is
+t, Gnus will attempt to grab the headers to the old articles, and
+thereby build complete threads. If it has the value `some', all
+old headers will be fetched but only enough headers to connect
+otherwise loose threads will be displayed. This variable can
+also be a number. In that case, no more than that number of old
+headers will be fetched. If it has the value `invisible', all
old headers will be fetched, but none will be displayed.
-The server has to support NOV for any of this to work."
+The server has to support NOV for any of this to work.
+
+This feature can seriously impact performance it ignores all
+locally cached header entries."
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
+ (const :tag "on" t)
(const some)
+ (const invisible)
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
(defcustom gnus-summary-make-false-root-always nil
"Always make a false dummy root."
+ :version "22.1"
:group 'gnus-thread
:type 'boolean)
"*Default threshold for a high scored article.
An article will be highlighted as high scored if its score is greater
than this score."
+ :version "22.1"
:group 'gnus-score-default
:type 'integer)
"*Default threshold for a low scored article.
An article will be highlighted as low scored if its score is smaller
than this score."
+ :version "22.1"
:group 'gnus-score-default
:type 'integer)
"*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."
+`gnus-summary-show-thread' by hand or select an article."
:group 'gnus-thread
:type '(radio (sexp :format "Non-nil\n"
:match (lambda (widget value)
(not (or (consp value) (functionp value))))
:value t)
(const nil)
- (sexp :tag "Predicate specifier" :size 0)))
+ (sexp :tag "Predicate specifier")))
(defcustom gnus-thread-hide-killed t
"*If non-nil, hide killed threads automatically."
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
+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."
+ :version "22.1"
:group 'gnus-group-select
:type '(choice (const best)
(const unread)
NOTE: The list of unfetched articles will always be nil when plugged
and, when unplugged, a subset of the undownloaded article list."
+ :version "22.1"
:group 'gnus-summary-maneuvering
:type '(choice (const :tag "None" nil)
(const :tag "Undownloaded when unplugged" undownloaded)
:group 'gnus-summary-mail
:type 'function)
+;; FIXME: Although the custom type is `character' for the following variables,
+;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs
+
(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
(defcustom gnus-spam-mark ?$
"*Mark used for spam articles."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-forwarded-mark ?F
"*Mark used for articles that have been forwarded."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-recent-mark ?N
"*Mark used for articles that are recent."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-unseen-mark ?.
"*Mark used for articles that haven't been seen."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-no-mark ? ;Whitespace
"*Mark used for articles that have no other secondary mark."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-undownloaded-mark ?-
"*Mark used for articles that weren't downloaded."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
function; this specifies reversed sort order.
Ready-made functions include `gnus-thread-sort-by-number',
-`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
-`gnus-thread-sort-by-date', `gnus-thread-sort-by-score',
-`gnus-thread-sort-by-most-recent-number',
-`gnus-thread-sort-by-most-recent-date',
-`gnus-thread-sort-by-random', and
-`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').
+`gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient'
+`gnus-thread-sort-by-subject', `gnus-thread-sort-by-date',
+`gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number',
+`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random',
+and `gnus-thread-sort-by-total-score' (see
+`gnus-thread-score-function').
When threading is turned off, the variable
`gnus-article-sort-functions' controls how articles are sorted."
:group 'gnus-summary-sort
- :type '(repeat
+ :type '(repeat
(gnus-widget-reversible
(choice (function-item gnus-thread-sort-by-number)
(function-item gnus-thread-sort-by-author)
+ (function-item gnus-thread-sort-by-recipient)
(function-item gnus-thread-sort-by-subject)
(function-item gnus-thread-sort-by-date)
(function-item gnus-thread-sort-by-score)
(defcustom gnus-summary-article-move-hook nil
"*A hook called after an article is moved, copied, respooled, or crossposted."
+ :version "22.1"
:group 'gnus-summary
:type 'hook)
(defcustom gnus-summary-article-delete-hook nil
"*A hook called after an article is deleted."
+ :version "22.1"
:group 'gnus-summary
:type 'hook)
(defcustom gnus-summary-article-expire-hook nil
"*A hook called after an article is expired."
+ :version "22.1"
:group 'gnus-summary
:type 'hook)
(and (fboundp 'display-graphic-p)
(display-graphic-p))
"*If non-nil, display an arrow highlighting the current article."
- :version "21.1"
+ :version "22.1"
:group 'gnus-summary
:type 'boolean)
-(defcustom gnus-summary-selected-face 'gnus-summary-selected-face
+(defcustom gnus-summary-selected-face 'gnus-summary-selected
"Face used for highlighting the current article in the summary buffer."
:group 'gnus-summary-visual
:type 'face)
(defcustom gnus-summary-highlight
'(((eq mark gnus-canceled-mark)
- . gnus-summary-cancelled-face)
+ . gnus-summary-cancelled)
((and uncached (> score default-high))
- . gnus-summary-high-undownloaded-face)
+ . gnus-summary-high-undownloaded)
((and uncached (< score default-low))
- . gnus-summary-low-undownloaded-face)
+ . gnus-summary-low-undownloaded)
(uncached
- . gnus-summary-normal-undownloaded-face)
+ . gnus-summary-normal-undownloaded)
((and (> score default-high)
(or (eq mark gnus-dormant-mark)
(eq mark gnus-ticked-mark)))
- . gnus-summary-high-ticked-face)
+ . gnus-summary-high-ticked)
((and (< score default-low)
(or (eq mark gnus-dormant-mark)
(eq mark gnus-ticked-mark)))
- . gnus-summary-low-ticked-face)
+ . gnus-summary-low-ticked)
((or (eq mark gnus-dormant-mark)
(eq mark gnus-ticked-mark))
- . gnus-summary-normal-ticked-face)
+ . gnus-summary-normal-ticked)
((and (> score default-high) (eq mark gnus-ancient-mark))
- . gnus-summary-high-ancient-face)
+ . gnus-summary-high-ancient)
((and (< score default-low) (eq mark gnus-ancient-mark))
- . gnus-summary-low-ancient-face)
+ . gnus-summary-low-ancient)
((eq mark gnus-ancient-mark)
- . gnus-summary-normal-ancient-face)
+ . gnus-summary-normal-ancient)
((and (> score default-high) (eq mark gnus-unread-mark))
- . gnus-summary-high-unread-face)
+ . gnus-summary-high-unread)
((and (< score default-low) (eq mark gnus-unread-mark))
- . gnus-summary-low-unread-face)
+ . gnus-summary-low-unread)
((eq mark gnus-unread-mark)
- . gnus-summary-normal-unread-face)
+ . gnus-summary-normal-unread)
((> score default-high)
- . gnus-summary-high-read-face)
+ . gnus-summary-high-read)
((< score default-low)
- . gnus-summary-low-read-face)
+ . gnus-summary-low-read)
(t
- . gnus-summary-normal-read-face))
+ . gnus-summary-normal-read))
"*Controls the highlighting of summary buffer lines.
A list of (FORM . FACE) pairs. When deciding how a a particular
:type '(repeat symbol))
(defcustom gnus-ignored-from-addresses
- (and user-mail-address (regexp-quote 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."
:version "21.1"
:group 'gnus-summary
:type 'regexp)
+(defcustom gnus-summary-to-prefix "-> "
+ "*String prefixed to the To field in the summary line when
+using `gnus-ignored-from-addresses'."
+ :version "22.1"
+ :group 'gnus-summary
+ :type 'string)
+
+(defcustom gnus-summary-newsgroup-prefix "=> "
+ "*String prefixed to the Newsgroup field in the summary
+line when using `gnus-ignored-from-addresses'."
+ :version "22.1"
+ :group 'gnus-summary
+ :type 'string)
+
(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
"List of charsets that should be ignored.
When these charsets are used in the \"charset\" parameter, the
This is mostly relevant for slow back ends where the user may
wish to widen the summary buffer to include all headers
that were fetched. Say, for nnultimate groups."
+ :version "22.1"
:group 'gnus-summary
:type '(choice boolean regexp))
(defcustom gnus-summary-muttprint-program "muttprint"
"Command (and optional arguments) used to run Muttprint."
- :version "21.3"
+ :version "22.1"
:group 'gnus-summary
:type 'string)
supply the MIME-Version header or deliberately strip it from the mail.
If non-nil (the default), Gnus will treat some articles as MIME
even if the MIME-Version header is missing."
- :version "21.3"
+ :version "22.1"
:type 'boolean
:group 'gnus-article-mime)
This means that Gnus will search message bodies for text that look
like uuencoded bits, yEncoded bits, and so on, and present that using
the normal Gnus MIME machinery."
+ :version "22.1"
:type 'boolean
:group 'gnus-article-mime)
"," 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
"\C-c\C-s\C-l" gnus-summary-sort-by-lines
"\C-c\C-s\C-c" gnus-summary-sort-by-chars
"\C-c\C-s\C-a" gnus-summary-sort-by-author
+ "\C-c\C-s\C-t" gnus-summary-sort-by-recipient
"\C-c\C-s\C-s" gnus-summary-sort-by-subject
"\C-c\C-s\C-d" gnus-summary-sort-by-date
"\C-c\C-s\C-i" gnus-summary-sort-by-score
"Q" gnus-summary-exit-no-update
"\C-c\C-i" gnus-info-find-node
gnus-mouse-2 gnus-mouse-pick-article
+ [follow-link] mouse-face
"m" gnus-summary-mail-other-window
"a" gnus-summary-post-news
"i" gnus-summary-news-other-window
(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
"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
- "r" gnus-summary-limit-to-replied)
+ "r" gnus-summary-limit-to-replied
+ "R" gnus-summary-limit-to-recipient)
(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
"n" gnus-summary-next-unread-article
"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
"Q" gnus-summary-exit
"Z" gnus-summary-exit
"n" gnus-summary-catchup-and-goto-next-group
+ "p" gnus-summary-catchup-and-goto-prev-group
"R" gnus-summary-reselect-current-group
"G" gnus-summary-rescan-group
"N" gnus-summary-next-group
"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
+ "i" gnus-summary-idna-message)
(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
;; mnemonic: deuglif*Y*
"m" gnus-summary-repair-multipart
"v" gnus-article-view-part
"o" gnus-article-save-part
+ "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
["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
["Rot 13" gnus-summary-caesar-message
,@(if (featurep 'xemacs) '(t)
'(:help "\"Caesar rotate\" article by 13"))]
+ ["De-IDNA" gnus-summary-idna-message t]
["Morse decode" gnus-summary-morse-message t]
["Unix pipe..." gnus-summary-pipe-message t]
["Add buttons" gnus-article-add-buttons t]
["Marks..." gnus-summary-limit-to-marks t]
["Subject..." gnus-summary-limit-to-subject t]
["Author..." gnus-summary-limit-to-author t]
+ ["Recipient..." gnus-summary-limit-to-recipient t]
["Age..." gnus-summary-limit-to-age t]
["Extra..." gnus-summary-limit-to-extra t]
["Score..." gnus-summary-limit-to-score t]
("Sort"
["Sort by number" gnus-summary-sort-by-number t]
["Sort by author" gnus-summary-sort-by-author t]
+ ["Sort by recipient" gnus-summary-sort-by-recipient t]
["Sort by subject" gnus-summary-sort-by-subject t]
["Sort by date" gnus-summary-sort-by-date t]
["Sort by score" gnus-summary-sort-by-score t]
'(:help "Mark unread articles in this group as read, then exit"))]
["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
+ ["Catchup and goto prev" gnus-summary-catchup-and-goto-prev-group t]
["Exit group" gnus-summary-exit
,@(if (featurep 'xemacs) '(t)
'(:help "Exit current group, return to group selection mode"))]
(defvar gnus-summary-tool-bar-map nil)
-;; Emacs 21 tool bar. Should be no-op otherwise.
-(defun gnus-summary-make-tool-bar ()
- (if (and (fboundp 'tool-bar-add-item-from-menu)
- (default-value 'tool-bar-mode)
- (not gnus-summary-tool-bar-map))
- (setq gnus-summary-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap))
- (load-path (mm-image-load-path)))
- (tool-bar-add-item-from-menu
- 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-post-news "post" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-followup "followup" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-reply "reply" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-caesar-message "rot13" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-save-article "save-art" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-uu-post-news "uu-post" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-uu-post-news "uu-post" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-catchup "catchup" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-exit "exit-summ" gnus-summary-mode-map)
- tool-bar-map)))
- (if gnus-summary-tool-bar-map
- (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
+;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only
+;; affect _new_ message buffers. We might add a function that walks thru all
+;; summary-mode buffers and force the update.
+(defun gnus-summary-tool-bar-update (&optional symbol value)
+ "Update summary mode toolbar.
+Setter function for custom variables."
+ (setq-default gnus-summary-tool-bar-map nil)
+ (when symbol
+ ;; When used as ":set" function:
+ (set-default symbol value))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-make-tool-bar))))
+
+(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
+`gmm-tool-bar-from-list' for the format of the list. The
+default key map is `gnus-summary-mode-map'.
+
+Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
+`gnus-summary-tool-bar-retro'."
+ :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome)
+ (const :tag "Retro look" gnus-summary-tool-bar-retro)
+ (repeat :tag "User defined list" gmm-tool-bar-item)
+ (symbol))
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-summary-tool-bar-update
+ :group 'gnus-summary)
+
+(defcustom gnus-summary-tool-bar-gnome
+ '((gnus-summary-post-news "mail/compose" nil)
+ (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" nil :visible nil)
+ (gnus-summary-print-article "print")
+ (gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
+ ;; 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")
+ (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")
+ (gmm-customize-mode "preferences" t :help "Edit mode preferences")
+ (gnus-info-find-node "help"))
+ "List of functions for the summary tool bar (GNOME style).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type '(repeat gmm-tool-bar-item)
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-summary-tool-bar-update
+ :group 'gnus-summary)
+
+(defcustom gnus-summary-tool-bar-retro
+ '((gnus-summary-prev-unread-article "gnus/prev-ur")
+ (gnus-summary-next-unread-article "gnus/next-ur")
+ (gnus-summary-post-news "gnus/post")
+ (gnus-summary-followup-with-original "gnus/fuwo")
+ (gnus-summary-followup "gnus/followup")
+ (gnus-summary-reply-with-original "gnus/reply-wo")
+ (gnus-summary-reply "gnus/reply")
+ (gnus-summary-caesar-message "gnus/rot13")
+ (gnus-uu-decode-uu "gnus/uu-decode")
+ (gnus-summary-save-article-file "gnus/save-aif")
+ (gnus-summary-save-article "gnus/save-art")
+ (gnus-uu-post-news "gnus/uu-post")
+ (gnus-summary-catchup "gnus/catchup")
+ (gnus-summary-catchup-and-exit "gnus/cu-exit")
+ (gnus-summary-exit "gnus/exit-summ")
+ ;; Some new command that may need more suitable icons:
+ (gnus-summary-print-article "gnus/print" nil :visible nil)
+ (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil)
+ (gnus-summary-save-newsrc "gnus/save" nil :visible nil)
+ ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil)
+ (gnus-summary-search-article-forward "gnus/search" nil :visible nil)
+ ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil)
+ ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil)
+ ;;
+ (gnus-info-find-node "gnus/help" nil :visible nil))
+ "List of functions for the summary tool bar (retro look).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type '(repeat gmm-tool-bar-item)
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-summary-tool-bar-update
+ :group 'gnus-summary)
+
+(defcustom gnus-summary-tool-bar-zap-list t
+ "List of icon items from the global tool bar.
+These items are not displayed in the Gnus summary mode tool bar.
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type 'gmm-tool-bar-zap-list
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :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."
+ (when (and (not (featurep 'xemacs))
+ (boundp 'tool-bar-mode)
+ tool-bar-mode
+ (or (not gnus-summary-tool-bar-map) force))
+ (let* ((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)))
+ (when map
+ ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
+ ;; uses it's value.
+ (setq gnus-summary-tool-bar-map map))))
+ (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
(defun gnus-score-set-default (var value)
"A version of set that updates the GNU Emacs menu-bar."
\\{gnus-summary-mode-map}"
(interactive)
(kill-all-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-make-local-variables))
+ (gnus-summary-make-local-variables)
+ (setq gnus-newsgroup-name group)
(when (gnus-visual-p 'summary-menu 'menu)
(gnus-summary-make-menu-bar)
(gnus-summary-make-tool-bar))
- (gnus-summary-make-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-make-local-variables))
(gnus-make-thread-indent-array)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
(setq selective-display-ellipses t) ;Display `...'
(gnus-summary-set-display-table)
(gnus-set-default-directory)
- (setq gnus-newsgroup-name group)
(make-local-variable 'gnus-summary-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
(make-local-variable 'gnus-summary-dummy-line-format)
(make-local-variable 'gnus-summary-mark-positions)
(gnus-make-local-hook 'pre-command-hook)
(add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
- (gnus-run-hooks 'gnus-summary-mode-hook)
+ (gnus-run-mode-hooks 'gnus-summary-mode-hook)
(turn-on-gnus-mailing-list-mode)
(mm-enable-multibyte)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(let ((locals gnus-summary-local-variables))
(while locals
(if (consp (car locals))
- (and (vectorp (caar locals))
+ (and (symbolp (caar locals))
(set (caar locals) nil))
- (and (vectorp (car locals))
+ (and (symbolp (car locals))
(set (car locals) nil)))
(setq locals (cdr locals)))))
(setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
(when offset
(gnus-data-update-list odata offset)))
- ;; Find the last element in the list to be spliced into the main
+ ;; Find the last element in the list to be spliced into the main
;; list.
- (while (cdr list)
- (setq list (cdr list)))
+ (setq list (last list))
(if (not data)
(progn
(setcdr list gnus-newsgroup-data)
(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)
(save-excursion
(when (gnus-buffer-exists-p gnus-summary-buffer)
(set-buffer gnus-summary-buffer))
- (let ((gnus-replied-mark 129)
- (gnus-score-below-mark 130)
- (gnus-score-over-mark 130)
- (gnus-undownloaded-mark 131)
- (spec gnus-summary-line-format-spec)
- gnus-visual pos)
+ (let ((spec gnus-summary-line-format-spec)
+ pos)
(save-excursion
(gnus-set-work-buffer)
- (let ((gnus-summary-line-format-spec spec)
- (gnus-newsgroup-downloadable '(0)))
- (gnus-summary-insert-line
- [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
- 0 nil t 128 t nil "" nil 1)
+ (let ((gnus-tmp-unread ?Z)
+ (gnus-replied-mark ?Z)
+ (gnus-score-below-mark ?Z)
+ (gnus-score-over-mark ?Z)
+ (gnus-undownloaded-mark ?Z)
+ (gnus-summary-line-format-spec spec)
+ (gnus-newsgroup-downloadable '(0))
+ (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil])
+ case-fold-search ignores)
+ ;; Here, all marks are bound to Z.
+ (gnus-summary-insert-line header
+ 0 nil t gnus-tmp-unread t nil "" nil 1)
(goto-char (point-min))
- (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
- (- (point) (point-min) 1)))))
+ ;; Memorize the positions of the same characters as dummy marks.
+ (while (re-search-forward "[A-D]" nil t)
+ (push (point) ignores))
+ (erase-buffer)
+ ;; We use A-D as dummy marks in order to know column positions
+ ;; where marks should be inserted.
+ (setq gnus-tmp-unread ?A
+ gnus-replied-mark ?B
+ gnus-score-below-mark ?C
+ gnus-score-over-mark ?C
+ gnus-undownloaded-mark ?D)
+ (gnus-summary-insert-line header
+ 0 nil t gnus-tmp-unread t nil "" nil 1)
+ ;; Ignore characters which aren't dummy marks.
+ (dolist (p ignores)
+ (delete-region (goto-char (1- p)) p)
+ (insert ?Z))
+ (goto-char (point-min))
+ (setq pos (list (cons 'unread
+ (and (search-forward "A" nil t)
+ (- (point) (point-min) 1)))))
(goto-char (point-min))
- (push (cons 'replied (and (search-forward "\201" nil t)
+ (push (cons 'replied (and (search-forward "B" nil t)
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
- (push (cons 'score (and (search-forward "\202" nil t)
+ (push (cons 'score (and (search-forward "C" nil t)
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
- (push (cons 'download
- (and (search-forward "\203" nil t)
- (- (point) (point-min) 1)))
+ (push (cons 'download (and (search-forward "D" nil t)
+ (- (point) (point-min) 1)))
pos)))
(setq gnus-summary-mark-positions pos))))
newsgroups)
(cond
((setq to (cdr (assq 'To extra-headers)))
- (concat "-> "
+ (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)))
- (concat "=> " newsgroups)))))
+ ((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)))))
(defun gnus-summary-insert-line (gnus-tmp-header
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
- (let ((params (gnus-group-find-parameter group))
- (vars '(quit-config)) ; Ignore quit-config.
- elem)
- (while params
- (setq elem (car params)
- params (cdr params))
+ (let ((vars '(quit-config))) ; Ignore quit-config.
+ (dolist (elem (gnus-group-find-parameter group))
(and (consp elem) ; Has to be a cons.
(consp (cdr elem)) ; The cdr has to be a list.
(symbolp (car elem)) ; Has to be a symbol in there.
(gnus-active gnus-newsgroup-name)))
;; You can change the summary buffer in some way with this hook.
(gnus-run-hooks 'gnus-select-group-hook)
- (gnus-update-format-specifications
- nil 'summary 'summary-mode 'summary-dummy)
- (gnus-update-summary-mark-positions)
+ (when (memq 'summary (gnus-update-format-specifications
+ nil 'summary 'summary-mode 'summary-dummy))
+ ;; The format specification for the summary line was updated,
+ ;; so we need to update the mark positions as well.
+ (gnus-update-summary-mark-positions))
;; Do score processing.
(when gnus-use-scoring
(gnus-possibly-score-headers))
(gnus-article-sort-by-author
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-recipient (h1 h2)
+ "Sort articles by recipient."
+ (string-lessp
+ (let ((extract (funcall
+ gnus-extract-address-components
+ (or (cdr (assq 'To (mail-header-extra h1))) ""))))
+ (or (car extract) (cadr extract)))
+ (let ((extract (funcall
+ gnus-extract-address-components
+ (or (cdr (assq 'To (mail-header-extra h2))) ""))))
+ (or (car extract) (cadr extract)))))
+
+(defun gnus-thread-sort-by-recipient (h1 h2)
+ "Sort threads by root recipient."
+ (gnus-article-sort-by-recipient
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-subject (h1 h2)
"Sort articles by root subject."
(string-lessp
(defcustom gnus-sum-thread-tree-root "> "
"With %B spec, used for the root of a thread.
If nil, use subject instead."
- :type '(radio (const :format "%v " nil) (string :size 0))
+ :version "22.1"
+ :type '(radio (const :format "%v " nil) string)
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-false-root "> "
"With %B spec, used for a false root of a thread.
If nil, use subject instead."
- :type '(radio (const :format "%v " nil) (string :size 0))
+ :version "22.1"
+ :type '(radio (const :format "%v " nil) 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."
- :type '(radio (const :format "%v " nil) (string :size 0))
+ :version "22.1"
+ :type '(radio (const :format "%v " nil) string)
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-vertical "| "
"With %B spec, used for drawing a vertical line."
+ :version "22.1"
:type 'string
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-indent " "
"With %B spec, used for indenting."
+ :version "22.1"
:type 'string
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
"With %B spec, used for a leaf with brothers."
+ :version "22.1"
:type 'string
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-single-leaf "\\-> "
"With %B spec, used for a leaf without brothers."
+ :version "22.1"
:type 'string
:group 'gnus-thread)
(when gnus-agent
(gnus-agent-possibly-alter-active group (gnus-active group) info)
-
+
(setq gnus-summary-use-undownloaded-faces
(gnus-agent-find-parameter
group
(match-end 1)))
(substring xrefs (match-beginning 1) (match-end 1))))
(setq number
- (string-to-int (substring xrefs (match-beginning 2)
+ (string-to-number (substring xrefs (match-beginning 2)
(match-end 2))))
(if (setq entry (gnus-gethash group xref-hashtb))
(setcdr entry (cons number (cdr entry)))
(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)))
;; Remove list identifiers from subject.
(when gnus-list-identifiers
(let ((gnus-newsgroup-headers (list header)))
- (gnus-summary-remove-list-identifiers)
- (setq header (car gnus-newsgroup-headers))))
+ (gnus-summary-remove-list-identifiers)))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(setq gnus-newsgroup-sparse
(let ((max (max (point) (mark)))
articles article)
(save-excursion
- (goto-char (min (min (point) (mark))))
+ (goto-char (min (point) (mark)))
(while
(and
(push (setq article (gnus-summary-article-number)) articles)
(defun gnus-summary-process-mark-set (set)
"Make SET into the current process marked articles."
(gnus-summary-unmark-all-processable)
- (while set
- (gnus-summary-set-process-mark (pop set))))
+ (mapc 'gnus-summary-set-process-mark set))
;;; Searching and stuff
(defun gnus-list-of-unread-articles (group)
(let* ((read (gnus-info-read (gnus-get-info group)))
(active (or (gnus-active group) (gnus-activate-group group)))
- (last (cdr active))
+ (last (or (cdr active)
+ (error "Group %s couldn't be activated " group)))
first nlast unread)
;; If none are read, then all are unread.
(if (not read)
(setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
(setq read (cdr read)))))
;; And add the last unread articles.
- (cond ((< first last)
- (push (cons first last) unread))
- ((= first last)
- (push first unread)))
+ (cond ((not (and first last))
+ nil)
+ ((< first last)
+ (push (cons first last) unread))
+ ((= first last)
+ (push first unread)))
;; Return the sequence of unread articles.
(delq 0 (nreverse unread))))
(gnus-summary-clear-local-variables))
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
- ;; We clear the global counterparts of the buffer-local
- ;; variables as well, just to be on the safe side.
- (set-buffer gnus-group-buffer)
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
;; Return to group mode buffer.
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
- (if leave-hidden
- (set-buffer gnus-group-buffer)
- (pop-to-buffer gnus-group-buffer))
- (if (not quit-config)
- (progn
- (goto-char group-point)
- (unless leave-hidden
- (gnus-configure-windows 'group 'force)))
- (gnus-handle-ephemeral-exit quit-config))
+ (set-buffer gnus-group-buffer)
+ (if quit-config
+ (gnus-handle-ephemeral-exit quit-config)
+ (goto-char group-point)
+ ;; If gnus-group-buffer is already displayed, make sure we also move
+ ;; the cursor in the window that displays it.
+ (let ((win (get-buffer-window (current-buffer) 0)))
+ (if win (set-window-point win (point))))
+ (unless leave-hidden
+ (gnus-configure-windows 'group 'force)))
;; Clear the current group name.
(unless quit-config
(setq gnus-newsgroup-name nil)))))
(gnus-deaden-summary)
(gnus-close-group group)
(gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
- (set-buffer gnus-group-buffer)
- (gnus-summary-clear-local-variables)
(let ((gnus-summary-local-variables gnus-newsgroup-variables))
(gnus-summary-clear-local-variables))
(gnus-kill-buffer gnus-summary-buffer))
(gnus-summary-goto-subject article t)))
(gnus-summary-limit (append articles gnus-newsgroup-limit))
(gnus-summary-position-point))
-
+
(defun gnus-summary-goto-subject (article &optional force silent)
"Go the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
(let ((mm-verify-option 'known)
(mm-decrypt-option 'known)
(gnus-article-emulate-mime t)
- (mm-fill-flowed nil)
(gnus-buttonized-mime-types (append (list "multipart/signed"
"multipart/encrypted")
gnus-buttonized-mime-types)))
(if (and group
(not (gnus-ephemeral-group-p gnus-newsgroup-name)))
(format " (Type %s for %s [%s])"
- (single-key-description cmd) group
+ (single-key-description cmd)
+ (gnus-group-decoded-name group)
(gnus-group-unread group))
(format " (Type %s to exit %s)"
(single-key-description cmd)
- gnus-newsgroup-name))))
+ (gnus-group-decoded-name gnus-newsgroup-name)))))
;; Confirm auto selection.
(setq key (car (setq keve (gnus-read-event-char prompt)))
ended t)
current-prefix-arg))
(gnus-summary-limit-to-subject from "from" not-matching))
+(defun gnus-summary-limit-to-recipient (recipient &optional not-matching)
+ "Limit the summary buffer to articles with the given RECIPIENT.
+
+If NOT-MATCHING, exclude RECIPIENT.
+
+To and Cc headers are checked. You need to include them in
+`nnmail-extra-headers'."
+ ;; Unlike `rmail-summary-by-recipients', doesn't include From.
+ (interactive
+ (list (read-string (format "%s recipient (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")))
+ current-prefix-arg))
+ (when (not (equal "" recipient))
+ (prog1 (let* ((to
+ (if (memq 'To nnmail-extra-headers)
+ (gnus-summary-find-matching
+ (cons 'extra 'To) recipient 'all nil nil
+ not-matching)
+ (gnus-message
+ 1 "`To' isn't present in `nnmail-extra-headers'")
+ (sit-for 1)
+ nil))
+ (cc
+ (if (memq 'Cc nnmail-extra-headers)
+ (gnus-summary-find-matching
+ (cons 'extra 'Cc) recipient 'all nil nil
+ not-matching)
+ (gnus-message
+ 1 "`Cc' isn't present in `nnmail-extra-headers'")
+ (sit-for 1)
+ nil))
+ (articles
+ (if not-matching
+ ;; We need the numbers that are in both lists:
+ (mapcar (lambda (a)
+ (and (memq a to) a))
+ cc)
+ (nconc to cc))))
+ (unless articles
+ (error "Found no matches for \"%s\"" recipient))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point))))
+
(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-completing-read-with-default
(symbol-name (car gnus-extra-headers))
(if current-prefix-arg
- "Exclude extra header:"
- "Limit extra header:")
+ "Exclude extra header"
+ "Limit extra header")
(mapcar (lambda (x)
(cons (symbol-name x) x))
gnus-extra-headers)
gnus-duplicate-mark gnus-souped-mark)
'reverse)))
+(defun gnus-summary-limit-to-bodies (match &optional reverse)
+ "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 (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-replied (&optional unreplied)
"Limit the summary buffer to replied articles.
If UNREPLIED (the prefix), limit to unreplied articles."
documents as newsgroups.
Obeys the standard process/prefix convention."
(interactive "P")
- (let* ((articles (gnus-summary-work-articles n))
- (ogroup gnus-newsgroup-name)
+ (let* ((ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
(list (cons 'to-group ogroup))))
- article group egroup groups vgroup)
- (while (setq article (pop articles))
+ group egroup groups vgroup)
+ (dolist (article (gnus-summary-work-articles n))
(setq group (format "%s-%d" gnus-newsgroup-name article))
(gnus-summary-remove-process-mark article)
(when (gnus-summary-display-article article)
(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."
(let ((gnus-last-article gnus-last-article))
(if (gnus-summary-search-article regexp backward)
(gnus-summary-show-thread)
- (error "Search failed: \"%s\"" regexp))))
+ (signal 'search-failed (list regexp)))))
(defun gnus-summary-search-article-backward (regexp)
"Search for an article containing REGEXP backward."
(or (cdr (assq arg gnus-summary-show-article-charset-alist))
(mm-read-coding-system
"View as charset: " ;; actually it is coding system.
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(mm-detect-coding-region (point) (point-max))))))
(gnus-newsgroup-ignored-charsets 'gnus-all))
(gnus-summary-select-article nil 'force)
(inhibit-point-motion-hooks t)
(hidden (if (numberp arg)
(>= arg 0)
- (gnus-article-hidden-text-p 'headers)))
+ (or (not (looking-at "[^ \t\n]+:"))
+ (gnus-article-hidden-text-p 'headers))))
s e)
(delete-region (point-min) (point-max))
(with-current-buffer gnus-original-article-buffer
(let ((start (window-start))
buffer-read-only)
(message-caesar-buffer-body arg)
- (set-window-start (get-buffer-window (current-buffer)) start))))))
-
-(autoload 'unmorse-region "morse"
- "Convert morse coded text in region to ordinary ASCII text."
- t)
+ (set-window-start (get-buffer-window (current-buffer)) start)))))
+ ;; Create buttons and stuff...
+ (gnus-treat-article nil))
+
+(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
+remain unencoded after running this function, it is likely an
+invalid IDNA string (`xn--bar' is invalid).
+
+You must have GNU Libidn (`http://www.gnu.org/software/libidn/')
+installed for this command to work."
+ (interactive "P")
+ (if (not (and (condition-case nil (require 'idna)
+ (file-error))
+ (mm-coding-system-p 'utf-8)
+ (executable-find (symbol-value 'idna-program))))
+ (gnus-message
+ 5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)")
+ (gnus-summary-select-article)
+ (let ((mail-header-separator ""))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (let ((start (window-start))
+ buffer-read-only)
+ (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t)
+ (replace-match (idna-to-unicode (match-string 1))))
+ (set-window-start (get-buffer-window (current-buffer)) start)))))))
(defun gnus-summary-morse-message (&optional arg)
"Morse decode the current article."
(crosspost "Crosspost" "Crossposting")))
(copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*")))
- art-group to-method new-xref article to-groups)
+ art-group to-method new-xref article to-groups articles-to-update-marks)
(unless (assq action names)
(error "Unknown action %s" action))
;; Read the newsgroup name.
((eq action 'move)
;; Remove this article from future suppression.
(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))
+ (move-is-internal (gnus-method-equal from-method to-method)))
(gnus-request-move-article
article ; Article to move
gnus-newsgroup-name ; From newsgroup
(list 'gnus-request-accept-article
to-newsgroup (list 'quote select-method)
(not articles) t) ; Accept form
- (not articles))) ; Only save nov last time
+ (not articles) ; Only save nov last time
+ move-is-internal))) ; is this move internal?
;; Copy the article.
((eq action 'copy)
(save-excursion
(set-buffer copy-buf)
(when (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (dolist (hdr gnus-copy-article-ignored-headers)
+ (message-remove-header hdr t)))
(gnus-request-accept-article
to-newsgroup select-method (not articles) t))))
;; Crosspost the article.
(gnus-summary-goto-subject article)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark))))
- (gnus-summary-remove-process-mark article))
+ (push article articles-to-update-marks))
+
+ (apply 'gnus-summary-remove-process-mark articles-to-update-marks)
;; Re-activate all groups that have been moved to.
(save-excursion
(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)))
(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.
+ "Copy the current article to some other group.
+If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy 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 non-nil, show and update the summary buffer as it's being built.
If the value is t, update the buffer after every line is inserted. If
the value is an integer (N), update the display every N lines."
+ :version "22.1"
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
number
gnus-newsgroup-name)))))
(method
(gnus-completing-read-with-default
- methname "What backend do you want to use when respooling?"
+ methname "Backend to use when respooling"
methods nil t nil 'gnus-mail-method-history))
ms)
(cond
(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))
`(lambda ()
(let ((mbl mml-buffer-list))
(setq mml-buffer-list nil)
- (mime-to-mml ,'current-handles)
+ (let ((rfc2047-quote-decoded-words-containing-tspecials t))
+ (mime-to-mml ,'current-handles))
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
(set (make-local-variable 'mml-buffer-list) mbl1))
(save-excursion
(save-restriction
(message-narrow-to-head)
- (let ((head (buffer-string))
+ (let ((head (buffer-substring-no-properties
+ (point-min) (point-max)))
header)
(with-temp-buffer
(insert (format "211 %d Article retrieved.\n"
(gnus-summary-goto-subject article)
(gnus-summary-update-secondary-mark article)))
-(defun gnus-summary-remove-process-mark (article)
- "Remove the process mark from ARTICLE and update the summary line."
- (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
- (when (gnus-summary-goto-subject article)
- (gnus-summary-show-thread)
- (gnus-summary-goto-subject article)
- (gnus-summary-update-secondary-mark article)))
+(defun gnus-summary-remove-process-mark (&rest articles)
+ "Remove the process mark from ARTICLES and update the summary line."
+ (dolist (article articles)
+ (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
+ (when (gnus-summary-goto-subject article)
+ (gnus-summary-show-thread)
+ (gnus-summary-goto-subject article)
+ (gnus-summary-update-secondary-mark article)))
+ t)
(defun gnus-summary-set-saved-mark (article)
"Set the process mark on ARTICLE and update the summary line."
(gnus-summary-catchup all))
(gnus-summary-next-group))
+(defun gnus-summary-catchup-and-goto-prev-group (&optional all)
+ "Mark all articles in this group as read and select the previous group.
+If given a prefix, mark all articles, unread as well as ticked, as
+read."
+ (interactive "P")
+ (save-excursion
+ (gnus-summary-catchup all))
+ (gnus-summary-next-group nil nil t))
+
;;;
;;; with article
;;;
(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 is 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.
(interactive "P")
(gnus-summary-sort 'author reverse))
+(defun gnus-summary-sort-by-recipient (&optional reverse)
+ "Sort the summary buffer by recipient name alphabetically.
+If `case-fold-search' is non-nil, case of letters is ignored.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'recipient reverse))
+
(defun gnus-summary-sort-by-subject (&optional reverse)
"Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
If `case-fold-search' is non-nil, case of letters is ignored.
(let* ((split-name (gnus-get-split-value gnus-move-split-methods))
(minibuffer-confirm-incomplete nil) ; XEmacs
(prom
- (format "%s %s to:"
+ (format "%s %s to"
prompt
(if (> (length articles) 1)
(format "these %d articles" (length articles))
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
+(defvar gnus-summary-save-parts-counter)
+
(defun gnus-summary-save-parts (type dir n &optional reverse)
"Save parts matching TYPE to DIR.
If REVERSE, save parts that do not match TYPE."
(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)
;; coding: iso-8859-1
;; End:
-;;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
+;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
;;; gnus-sum.el ends here
projects / gnus / blobdiff