;;; gnus-sum.el --- summary mode commands for Semi-gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'gnus-int)
(require 'gnus-undo)
(require 'gnus-util)
-;; Recursive :-(.
-;; (require 'gnus-art)
(require 'nnoo)
(require 'mime-view)
(defcustom gnus-thread-hide-subtree nil
"*If non-nil, hide all threads initially.
+This can be a predicate specifier which says which threads to hide.
If threads are hidden, you have to run the command
`gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
to expose hidden threads."
:type 'boolean)
(defcustom gnus-auto-select-first t
- "*If nil, don't select the first unread article when entering a group.
-If this variable is `best', select the highest-scored unread article
-in the group. If t, select the first unread article.
-
-This variable can also be a function to place point on a likely
-subject line. Useful values include `gnus-summary-first-unread-subject',
-`gnus-summary-first-unread-article' and
-`gnus-summary-best-unread-article'.
-
-If you want to prevent automatic selection of the first unread article
-in some newsgroups, set the variable to nil in
-`gnus-select-group-hook'."
+ "*If non-nil, select the article under point.
+Which article this is is controlled by the `gnus-auto-select-subject'
+variable.
+
+If you want to prevent automatic selection of articles in some
+newsgroups, set the variable to nil in `gnus-select-group-hook'."
:group 'gnus-group-select
:type '(choice (const :tag "none" nil)
- (const best)
- (sexp :menu-tag "first" t)
- (function-item gnus-summary-first-unread-subject)
- (function-item gnus-summary-first-unread-article)
- (function-item gnus-summary-best-unread-article)))
+ (sexp :menu-tag "first" t)))
+
+(defcustom gnus-auto-select-subject 'unread
+ "*Says what subject to place under point when entering a group.
+
+This variable can either be the symbols `first' (place point on the
+first subject), `unread' (place point on the subject line of the first
+unread article), `best' (place point on the subject line of the
+higest-scored article), `unseen' (place point on the subject line of
+the first unseen article), or a function to be called to place point on
+some subject line.."
+ :group 'gnus-group-select
+ :type '(choice (const best)
+ (const unread)
+ (const first)
+ (const unseen)))
(defcustom gnus-dont-select-after-jump-to-other-group nil
"If non-nil, don't select the first unread article after entering the
It works along the same lines as a normal formatting string,
with some simple extensions.
-%S The subject"
+%S The subject
+
+General format specifiers can also be used.
+See (gnus)Formatting Variables."
+ :link '(custom-manual "(gnus)Formatting Variables")
:group 'gnus-threading
:type 'string)
Ready-made functions include `gnus-thread-sort-by-number',
`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
-`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
+`gnus-thread-sort-by-date', `gnus-thread-sort-by-score',
+`gnus-thread-sort-by-most-recent-number',
+`gnus-thread-sort-by-most-recent-date', and
`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').
When threading is turned off, the variable
`gnus-summary-next-same-subject' command does, you can use the
following hook:
- (setq gnus-select-group-hook
- (list
- (lambda ()
- (mapcar (lambda (header)
- (mail-header-set-subject
- header
- (gnus-simplify-subject
- (mail-header-subject header) 're-only)))
- gnus-newsgroup-headers))))"
+ (add-hook gnus-select-group-hook
+ (lambda ()
+ (mapcar (lambda (header)
+ (mail-header-set-subject
+ header
+ (gnus-simplify-subject
+ (mail-header-subject header) 're-only)))
+ gnus-newsgroup-headers)))"
:group 'gnus-group-select
:type 'hook)
(mime-find-field-decoder 'From 'nov)
"Variable that says which function should be used to decode a string with encoded words.")
-(defcustom gnus-extra-headers nil
+(defcustom gnus-extra-headers '(To Newsgroups)
"*Extra headers to parse."
:version "21.1"
:group 'gnus-summary
"l" gnus-summary-stop-page-breaking
"r" gnus-summary-caesar-message
"t" gnus-article-toggle-headers
- "g" gnus-summary-toggle-smiley
+ "g" gnus-treat-smiley
"v" gnus-summary-verbose-headers
"m" gnus-summary-toggle-mime
"a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
"c" gnus-article-highlight-citation
"s" gnus-article-highlight-signature)
+ (gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map)
+ "f" gnus-article-treat-fold-headers
+ "u" gnus-article-treat-unfold-headers
+ "n" gnus-article-treat-fold-newsgroups)
+
+ (gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map)
+ "x" gnus-article-display-x-face
+ "s" gnus-treat-smiley
+ "D" gnus-article-remove-images
+ "f" gnus-treat-from-picon
+ "m" gnus-treat-mail-picon
+ "n" gnus-treat-newsgroups-picon)
+
(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
"z" gnus-article-date-ut
"u" gnus-article-date-ut
["Original" gnus-article-date-original t]
["Lapsed" gnus-article-date-lapsed t]
["User-defined" gnus-article-date-user t])
+ ("Display"
+ ["Remove images" gnus-article-remove-images t]
+ ["Toggle smiley" gnus-treat-smiley t]
+ ["Show X-Face" gnus-article-display-x-face t]
+ ["Show picons in From" gnus-treat-from-picon t]
+ ["Show picons in mail headers" gnus-treat-mail-picon t]
+ ["Show picons in news headers" gnus-treat-newsgroups-picon t])
("Washing"
("Remove Blanks"
["Leading" gnus-article-strip-leading-blank-lines t]
["Fill long lines" gnus-article-fill-long-lines t]
["Capitalize sentences" gnus-article-capitalize-sentences t]
["CR" gnus-article-remove-cr t]
- ["Show X-Face" gnus-article-display-x-face t]
["Rot 13" gnus-summary-caesar-message
,@(if (featurep 'xemacs) '(t)
'(:help "\"Caesar rotate\" article by 13"))]
["Toggle MIME" gnus-summary-toggle-mime t]
["Verbose header" gnus-summary-verbose-headers t]
["Toggle header" gnus-summary-toggle-header t]
- ["Toggle smiley" gnus-summary-toggle-smiley t]
+ ["Unfold headers" gnus-article-treat-unfold-headers t]
+ ["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
["HZ" gnus-article-decode-HZ t])
("Output"
["Fetch article with id..." gnus-summary-refer-article t]
["Setup Mailing List Params" gnus-mailing-list-insinuate t]
["Redisplay" gnus-summary-show-article t]
- ["Raw article" gnus-summary-show-raw-article t])))
+ ["Raw article" gnus-summary-show-raw-article :keys "C-u g"])))
(easy-menu-define
gnus-summary-article-menu gnus-summary-mode-map ""
(cons "Article" innards))
["Wide reply and yank" gnus-summary-wide-reply-with-original
,@(if (featurep 'xemacs) '(t)
'(:help "Mail a reply, quoting this article"))]
+ ["Very wide reply" gnus-summary-very-wide-reply t]
+ ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mail a very wide reply, quoting this article"))]
["Mail forward" gnus-summary-mail-forward t]
["Post forward" gnus-summary-post-forward t]
["Digest and mail" gnus-summary-digest-mail-forward t]
["Set expirable mark" gnus-summary-mark-as-expirable t]
["Set bookmark" gnus-summary-set-bookmark t]
["Remove bookmark" gnus-summary-remove-bookmark t])
- ("Mark Limit"
+ ("Limit to"
["Marks..." gnus-summary-limit-to-marks t]
["Subject..." gnus-summary-limit-to-subject t]
["Author..." gnus-summary-limit-to-author t]
;; Saving hidden threads.
-(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
-(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
-
(defmacro gnus-save-hidden-threads (&rest forms)
"Save hidden threads, eval FORMS, and restore the hidden threads."
(let ((config (make-symbol "config")))
(save-excursion
,@forms)
(gnus-restore-hidden-threads-configuration ,config)))))
+(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
+(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
(defun gnus-data-compute-positions ()
"Compute the positions of all articles."
;; Hide conversation thread subtrees. We cannot do this in
;; gnus-summary-prepare-hook since kill processing may not
;; work with hidden articles.
- (and gnus-show-threads
- gnus-thread-hide-subtree
- (gnus-summary-hide-all-threads))
+ (gnus-summary-maybe-hide-threads)
(when kill-buffer
(gnus-kill-or-deaden-summary kill-buffer))
+ (gnus-summary-auto-select-subject)
;; Show first unread article if requested.
(if (and (not no-article)
(not no-display)
gnus-auto-select-first)
(progn
(gnus-configure-windows 'summary)
- (cond
- ((eq gnus-auto-select-first 'best)
- (gnus-summary-best-unread-article))
- ((eq gnus-auto-select-first t)
- (gnus-summary-first-unread-article))
- ((gnus-functionp gnus-auto-select-first)
- (funcall gnus-auto-select-first))))
- ;; Don't select any articles, just move point to the first
- ;; article in the group.
- (goto-char (point-min))
+ (let ((art (gnus-summary-article-number)))
+ (unless (memq art gnus-newsgroup-undownloaded)
+ (gnus-summary-goto-article art))))
+ ;; Don't select any articles.
(gnus-summary-position-point)
(gnus-configure-windows 'summary 'force)
(gnus-set-mode-line 'summary))
(gnus-run-hooks 'gnus-summary-prepared-hook)
t)))))
+(defun gnus-summary-auto-select-subject ()
+ "Select the subject line on initial group entry."
+ (goto-char (point-min))
+ (cond
+ ((eq gnus-auto-select-subject 'best)
+ (gnus-summary-best-unread-subject))
+ ((eq gnus-auto-select-subject 'unread)
+ (gnus-summary-first-unread-subject))
+ ((eq gnus-auto-select-subject 'unseen)
+ (gnus-summary-first-unseen-subject))
+ ((eq gnus-auto-select-subject 'first)
+ ;; Do nothing.
+ )
+ ((gnus-functionp gnus-auto-select-subject)
+ (funcall gnus-auto-select-subject))))
+
(defun gnus-summary-prepare ()
"Generate the summary buffer."
(interactive)
(defun gnus-thread-total-score (thread)
;; This function find the total score of THREAD.
- (cond ((null thread)
- 0)
- ((consp thread)
- (if (stringp (car thread))
- (apply gnus-thread-score-function 0
- (mapcar 'gnus-thread-total-score-1 (cdr thread)))
- (gnus-thread-total-score-1 thread)))
- (t
- (gnus-thread-total-score-1 (list thread)))))
+ (cond
+ ((null thread)
+ 0)
+ ((consp thread)
+ (if (stringp (car thread))
+ (apply gnus-thread-score-function 0
+ (mapcar 'gnus-thread-total-score-1 (cdr thread)))
+ (gnus-thread-total-score-1 thread)))
+ (t
+ (gnus-thread-total-score-1 (list thread)))))
+
+(defun gnus-thread-sort-by-most-recent-number (h1 h2)
+ "Sort threads such that the thread with the most recently arrived article comes first."
+ (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
+
+(defun gnus-thread-highest-number (thread)
+ "Return the highest article number in THREAD."
+ (apply 'max (mapcar (lambda (header)
+ (mail-header-number header))
+ (message-flatten-list thread))))
+
+(defun gnus-thread-sort-by-most-recent-date (h1 h2)
+ "Sort threads such that the thread with the most recently dated article comes first."
+ (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
+
+(defun gnus-thread-latest-date (thread)
+ "Return the highest article date in THREAD."
+ (let ((previous-time 0))
+ (apply 'max (mapcar
+ (lambda (header)
+ (setq previous-time
+ (time-to-seconds
+ (mail-header-parse-date
+ (condition-case ()
+ (mail-header-date header)
+ (error previous-time))))))
+ (sort
+ (message-flatten-list thread)
+ (lambda (h1 h2)
+ (< (mail-header-number h1)
+ (mail-header-number h2))))))))
(defun gnus-thread-total-score-1 (root)
;; This function find the total score of the thread below ROOT.
(gnus-set-sorted-intersection
gnus-newsgroup-unreads fetched-articles))
- (let ((marks (assq 'seen (gnus-info-marks info))))
- ;; The `seen' marks are treated specially.
- (if (setq gnus-newsgroup-seen (cdr marks))
- (dolist (article gnus-newsgroup-articles)
- (unless (gnus-member-of-range article gnus-newsgroup-seen)
- (setq gnus-newsgroup-unseen
- (append gnus-newsgroup-unseen (list article)))))
- (setq gnus-newsgroup-unseen gnus-newsgroup-articles)))
+ ;; The `seen' marks are treated specially.
+ (if (not gnus-newsgroup-seen)
+ (setq gnus-newsgroup-unseen gnus-newsgroup-articles)
+ (dolist (article gnus-newsgroup-articles)
+ (unless (gnus-member-of-range article gnus-newsgroup-seen)
+ (push article gnus-newsgroup-unseen)))
+ (setq gnus-newsgroup-unseen (nreverse gnus-newsgroup-unseen)))
;; Removed marked articles that do not exist.
(gnus-update-missing-marks
(< (car article) min)
(> (car article) max))
(set var (delq article (symbol-value var))))))
+ ;; Adjust ranges (sloppily).
((eq mark-type 'range)
(cond
- ((eq mark 'seen))))))))
+ ((eq mark 'seen)
+ (setq articles (cdr marks))
+ (while (and articles
+ (or (and (consp (car articles))
+ (> min (cdar articles)))
+ (and (numberp (car articles))
+ (> min (car articles)))))
+ (pop articles))
+ (set var articles))))))))
(defun gnus-update-missing-marks (missing)
"Go through the list of MISSING articles and remove them from the mark lists."
(setq list (cdr all)))))
(when (eq (cdr type) 'seen)
- (setq list
- (if list
- (gnus-range-add (gnus-uncompress-sequence list)
- gnus-newsgroup-unseen)
- (gnus-compress-sequence gnus-newsgroup-articles))))
+ (setq list (gnus-range-add list gnus-newsgroup-unseen)))
(when (eq (gnus-article-mark-to-type (cdr type)) 'list)
(setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
(suppress-keymap gnus-dead-summary-mode-map)
(substitute-key-definition
'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
- (let ((keys '("\C-d" "\r" "\177" [delete])))
- (while keys
- (define-key gnus-dead-summary-mode-map
- (pop keys) 'gnus-summary-wake-up-the-dead))))
+ (dolist (key '("\C-d" "\r" "\177" [delete]))
+ (define-key gnus-dead-summary-mode-map
+ key 'gnus-summary-wake-up-the-dead))
+ (dolist (key '("q" "Q"))
+ (define-key gnus-dead-summary-mode-map key 'bury-buffer)))
(defvar gnus-dead-summary-mode nil
"Minor mode for Gnus summary buffers.")
;; Walking around summary lines.
-(defun gnus-summary-first-subject (&optional unread undownloaded)
+(defun gnus-summary-first-subject (&optional unread undownloaded unseen)
"Go to the first unread subject.
If UNREAD is non-nil, go to the first unread article.
Returns the article selected or nil if there are no unread articles."
(and (not (and undownloaded
(eq gnus-undownloaded-mark
(gnus-data-mark (car data)))))
- (not (gnus-data-unread-p (car data)))))
+ (if unseen
+ (or (not (memq
+ (gnus-data-number (car data))
+ gnus-newsgroup-unseen))
+ (not (gnus-data-unread-p (car data))))
+ (not (gnus-data-unread-p (car data))))))
(setq data (cdr data)))
(when data
(goto-char (gnus-data-pos (car data)))
(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)))
+ (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
+ (set-buffer-multibyte t)))
(if (null article)
nil
(prog1
(gnus-summary-first-subject t))
(gnus-summary-position-point)))
+(defun gnus-summary-first-unseen-subject ()
+ "Place the point on the subject line of the first unseen article.
+Return nil if there are no unseen articles."
+ (interactive)
+ (prog1
+ (when (gnus-summary-first-subject t t t)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject t t t))
+ (gnus-summary-position-point)))
+
(defun gnus-summary-first-article ()
"Select the first article.
Return nil if there are no articles."
(gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
-(defun gnus-summary-best-unread-article ()
- "Select the unread article with the highest score."
+(defun gnus-summary-best-unread-article (&optional arg)
+ "Select the unread article with the highest score.
+If given a prefix argument, select the next unread article that has a
+score higher than the default score."
+ (interactive "P")
+ (let ((article (if arg
+ (gnus-summary-better-unread-subject)
+ (gnus-summary-best-unread-subject))))
+ (if article
+ (gnus-summary-goto-article article)
+ (error "No unread articles"))))
+
+(defun gnus-summary-best-unread-subject ()
+ "Select the unread subject with the highest score."
(interactive)
(let ((best -1000000)
(data gnus-newsgroup-data)
(setq best score
article (gnus-data-number (car data))))
(setq data (cdr data)))
- (prog1
- (if article
- (gnus-summary-goto-article article)
- (error "No unread articles"))
- (gnus-summary-position-point))))
+ (when article
+ (gnus-summary-goto-subject article))
+ (gnus-summary-position-point)
+ article))
+
+(defun gnus-summary-better-unread-subject ()
+ "Select the first unread subject that has a score over the default score."
+ (interactive)
+ (let ((data gnus-newsgroup-data)
+ article score)
+ (while (and (setq article (gnus-data-number (car data)))
+ (or (gnus-data-read-p (car data))
+ (not (> (gnus-summary-article-score article)
+ gnus-summary-default-score))))
+ (setq data (cdr data)))
+ (when article
+ (gnus-summary-goto-subject article))
+ (gnus-summary-position-point)
+ article))
(defun gnus-summary-last-subject ()
"Go to the last displayed subject line in the group."
(when (> (length days) 0)
(setq days (read days)))
(if (numberp days)
- (setq days-got t)
+ (progn
+ (setq days-got t)
+ (if (< days 0)
+ (progn
+ (setq younger (not younger))
+ (setq days (* days -1)))))
(message "Please enter a number.")
(sleep-for 1)))
(list days younger)))
;; according to the new limit.
(gnus-summary-prepare)
;; Hide any threads, possibly.
- (and gnus-show-threads
- gnus-thread-hide-subtree
- (gnus-summary-hide-all-threads))
+ (gnus-summary-maybe-hide-threads)
;; Try to return to the article you were at, or one in the
;; neighborhood.
(when data
(gnus-group-read-ephemeral-group
name `(nndoc ,name (nndoc-address ,(get-buffer dig))
(nndoc-article-type
- ,(if force 'mbox 'guess))) t))
+ ,(if force 'mbox 'guess)))
+ t nil nil nil
+ `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name
+ "ADAPT")))))
;; Make all postings to this group go to the parent group.
(nconc (gnus-info-params (gnus-get-info name))
params)
(dolist (article (gnus-summary-work-articles n))
(gnus-summary-select-article nil nil 'pseudo article)
(gnus-eval-in-buffer-window gnus-article-buffer
- (let ((buffer (generate-new-buffer " *print*")))
- (unwind-protect
- (progn
- (copy-to-buffer buffer (point-min) (point-max))
- (set-buffer buffer)
- (gnus-article-delete-invisible-text)
- (when (gnus-visual-p 'article-highlight 'highlight)
- ;; Copy-to-buffer doesn't copy overlay. So redo
- ;; highlight.
- (let ((gnus-article-buffer buffer))
- (gnus-article-highlight-citation t)
- (gnus-article-highlight-signature)))
- (let ((ps-left-header
- (list
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-subject gnus-current-headers)
- 66) ")")
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-from gnus-current-headers)
- 45) ")")))
- (ps-right-header
- (list
- "/pagenumberstring load"
- (concat "("
- (mail-header-date gnus-current-headers) ")"))))
- (gnus-run-hooks 'gnus-ps-print-hook)
- (save-excursion
- (if window-system
- (ps-spool-buffer-with-faces)
- (ps-spool-buffer)))))
- (kill-buffer buffer))))
+ (gnus-print-buffer))
(gnus-summary-remove-process-mark article))
(ps-despool filename))
+(defun gnus-print-buffer ()
+ (let ((buffer (generate-new-buffer " *print*")))
+ (unwind-protect
+ (progn
+ (copy-to-buffer buffer (point-min) (point-max))
+ (set-buffer buffer)
+ (gnus-article-delete-invisible-text)
+ (when (gnus-visual-p 'article-highlight 'highlight)
+ ;; Copy-to-buffer doesn't copy overlay. So redo
+ ;; highlight.
+ (let ((gnus-article-buffer buffer))
+ (gnus-article-highlight-citation t)
+ (gnus-article-highlight-signature)))
+ (let ((ps-left-header
+ (list
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-subject gnus-current-headers)
+ 66) ")")
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-from gnus-current-headers)
+ 45) ")")))
+ (ps-right-header
+ (list
+ "/pagenumberstring load"
+ (concat "("
+ (mail-header-date gnus-current-headers) ")"))))
+ (gnus-run-hooks 'gnus-ps-print-hook)
+ (save-excursion
+ (if window-system
+ (ps-spool-buffer-with-faces)
+ (ps-spool-buffer)))))
+ (kill-buffer buffer))))
+
(defun gnus-summary-show-article (&optional arg)
"Force redisplaying of the current article.
If ARG (the prefix) is a number, show the article with the charset
(let ((gnus-newsgroup-charset
(or (cdr (assq arg gnus-summary-show-article-charset-alist))
(mm-read-coding-system
- "View as charset: "
+ "View as charset: " ;; actually it is coding system.
(save-excursion
(set-buffer gnus-article-buffer)
- (let ((coding-systems
- (detect-coding-region (point) (point-max))))
- (or (car-safe coding-systems)
- coding-systems))))))
+ (mm-detect-coding-region (point) (point-max))))))
(gnus-newsgroup-ignored-charsets 'gnus-all))
(gnus-summary-select-article nil 'force)
(let ((deps gnus-newsgroup-dependencies)
(if hidden
(let ((gnus-treat-hide-headers nil)
(gnus-treat-hide-boring-headers nil))
- (setq gnus-article-wash-types
- (delq 'headers gnus-article-wash-types))
+ (gnus-delete-wash-type 'headers)
(gnus-treat-article 'head))
(gnus-treat-article 'head)))
(gnus-set-mode-line 'article)))))
art-group to-method new-xref article to-groups)
(unless (assq action names)
(error "Unknown action %s" action))
+ ;; We have to select an article to give
+ ;; `gnus-read-move-group-name' an opportunity to suggest an
+ ;; appropriate default.
+ (unless (gnus-buffer-live-p gnus-original-article-buffer)
+ (gnus-summary-select-article nil nil nil (car articles)))
;; Read the newsgroup name.
(when (and (not to-newsgroup)
(not select-method))
(execute-kbd-macro (concat (this-command-keys) key))
(gnus-article-edit-done))
-(defun gnus-summary-toggle-smiley (&optional arg)
- "Toggle the display of smilies as small graphical icons."
- (interactive "P")
- (save-excursion
- (set-buffer gnus-article-buffer)
- (gnus-smiley-display arg)))
-
;;; Respooling
(defun gnus-summary-respool-query (&optional silent trace)
(goto-char orig)
(gnus-summary-position-point))))
-(defun gnus-summary-hide-all-threads ()
- "Hide all thread subtrees."
+(defun gnus-summary-maybe-hide-threads ()
+ "If requested, hide the threads that should be hidden."
+ (when (and gnus-show-threads
+ gnus-thread-hide-subtree)
+ (gnus-summary-hide-all-threads
+ (if (or (consp gnus-thread-hide-subtree)
+ (gnus-functionp gnus-thread-hide-subtree))
+ (gnus-make-predicate gnus-thread-hide-subtree)
+ nil))))
+
+;;; Hiding predicates.
+
+(defun gnus-article-unread-p (header)
+ (memq (mail-header-number header) gnus-newsgroup-unreads))
+
+(defun gnus-article-unseen-p (header)
+ (memq (mail-header-number header) gnus-newsgroup-unseen))
+
+(defun gnus-map-articles (predicate articles)
+ "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil."
+ (apply 'gnus-or (mapcar predicate
+ (mapcar 'gnus-summary-article-header articles))))
+
+(defun gnus-summary-hide-all-threads (&optional predicate)
+ "Hide all thread subtrees.
+If PREDICATE is supplied, threads that satisfy this predicate
+will not be hidden."
(interactive)
(save-excursion
(goto-char (point-min))
- (gnus-summary-hide-thread)
- (while (zerop (gnus-summary-next-thread 1 t))
- (gnus-summary-hide-thread)))
+ (let ((end nil))
+ (while (not end)
+ (when (or (not predicate)
+ (gnus-map-articles
+ predicate (gnus-summary-article-children)))
+ (gnus-summary-hide-thread))
+ (setq end (not (zerop (gnus-summary-next-thread 1 t)))))))
(gnus-summary-position-point))
(defun gnus-summary-hide-thread ()
"Hide thread subtrees.
+If PREDICATE is supplied, threads that satisfy this predicate
+will not be hidden.
Returns nil if no threads were there to be hidden."
(interactive)
(let ((buffer-read-only nil)
;; We do the sorting by regenerating the threads.
(gnus-summary-prepare)
;; Hide subthreads if needed.
- (when (and gnus-show-threads gnus-thread-hide-subtree)
- (gnus-summary-hide-all-threads))))
+ (gnus-summary-maybe-hide-threads)))
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
;; We do the sorting by regenerating the threads.
(gnus-summary-prepare)
;; Hide subthreads if needed.
- (when (and gnus-show-threads gnus-thread-hide-subtree)
- (gnus-summary-hide-all-threads))))
+ (gnus-summary-maybe-hide-threads)))
;; Summary saving commands.
(setq older (subseq older 0 all))))))))
(if (not older)
(message "No old news.")
- (gnus-summary-insert-articles older)
+ (let ((gnus-fetch-old-headers t))
+ (gnus-summary-insert-articles older))
(gnus-summary-limit (gnus-union older old))))
(gnus-summary-position-point)))
projects / elisp / gnus.git- / blobdiff