-;;; gnus-sum.el --- summary mode commands for Semi-gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;;; gnus-sum.el --- summary mode commands for gnus
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(defcustom gnus-summary-make-false-root-always nil
"Always make a false dummy root."
- :version "21.4"
+ :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 "21.4"
+ :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 "21.4"
+ :version "22.1"
:group 'gnus-score-default
:type 'integer)
(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."
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 "21.4"
+ :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 "21.4"
+ :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 "21.4"
+ :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 "21.4"
+ :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 "21.4"
+ :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)
(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.4"
+ :version "22.1"
:group 'gnus-summary
:type 'boolean)
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 "21.4"
+ :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.4"
+ :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.4"
+ :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 "21.4"
+ :version "22.1"
:type 'boolean
:group 'gnus-article-mime)
"\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
"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
"m" gnus-summary-toggle-mime
"a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
"p" gnus-article-verify-x-pgp-sig
- "d" gnus-article-treat-dumbquotes)
+ "d" gnus-article-treat-dumbquotes
+ "i" gnus-summary-idna-message)
(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
;; mnemonic: deuglif*Y*
["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]
(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)))))
(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
- (make-full-mail-header 0 "" "nobody"
- "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
+ (make-full-mail-header
+ 0 "" "nobody" "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))
+ ;; 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
- (string-as-multibyte "\200") nil t)
+ (and (search-forward "A" nil t)
(- (point) (point-min) 1)))))
(goto-char (point-min))
- (push (cons 'replied (and (search-forward
- (string-as-multibyte "\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
- (string-as-multibyte "\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
- (string-as-multibyte "\203") nil t)
+ (push (cons 'download (and (search-forward "D" nil t)
(- (point) (point-min) 1)))
pos)))
(setq gnus-summary-mark-positions pos))))
(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)))))
+
(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."
- :version "21.4"
- :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."
- :version "21.4"
- :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."
- :version "21.4"
- :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 "21.4"
+ :version "22.1"
:type 'string
:group 'gnus-thread)
(defcustom gnus-sum-thread-tree-indent " "
"With %B spec, used for indenting."
- :version "21.4"
+ :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 "21.4"
+ :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 "21.4"
+ :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
(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)
(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))
- (unless (pos-visible-in-window-p)
- (forward-line (/ (static-if (featurep 'xemacs)
- (window-displayed-height)
- (1- (window-height)))
- -2))
- (set-window-start (selected-window) (point))
- (goto-char group-point)))
- (gnus-handle-ephemeral-exit quit-config))
+ (set-buffer gnus-group-buffer)
+ (if quit-config
+ (gnus-handle-ephemeral-exit quit-config)
+ (goto-char group-point)
+ (unless leave-hidden
+ (gnus-configure-windows 'group 'force))
+ (unless (pos-visible-in-window-p)
+ (forward-line (/ (static-if (featurep 'xemacs)
+ (window-displayed-height)
+ (1- (window-height)))
+ -2))
+ (set-window-start (selected-window) (point))
+ (goto-char group-point)))
;; Clear the current group name.
(unless quit-config
(setq gnus-newsgroup-name nil)))))
(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))
(unless gnus-single-article-buffer
(setq gnus-article-current nil))
(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."
(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
(message-caesar-buffer-body arg)
(set-window-start (get-buffer-window (current-buffer)) start))))))
+(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)))))))
+
(autoload 'unmorse-region "morse"
"Convert morse coded text in region to ordinary ASCII text."
t)
(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.
;;;!!!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))))
"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
(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.