+ ;; We build the thread tree.
+ (when header
+ (if (boundp (setq id-dep (intern id dependencies)))
+ (if (and (car (symbol-value id-dep))
+ (not force-new))
+ ;; An article with this Message-ID has already been seen,
+ ;; so we ignore this one, except we add any additional
+ ;; Xrefs (in case the two articles came from different
+ ;; servers.
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep))) "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ (setcar (symbol-value id-dep) header))
+ (set id-dep (list header))))
+ (when header
+ (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (symbol-value id-dep))))
+ (set ref-dep (list nil (symbol-value id-dep)))))
+ header))
+
+(defun gnus-article-get-xrefs ()
+ "Fill in the Xref value in `gnus-current-headers', if necessary.
+This is meant to be called in `gnus-article-internal-prepare-hook'."
+ (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-current-headers)))
+ (or (not gnus-use-cross-reference)
+ (not headers)
+ (and (mail-header-xref headers)
+ (not (string= (mail-header-xref headers) "")))
+ (let ((case-fold-search t)
+ xref)
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (goto-char (point-min))
+ (if (or (and (eq (downcase (following-char)) ?x)
+ (looking-at "Xref:"))
+ (search-forward "\nXref:" nil t))
+ (progn
+ (goto-char (1+ (match-end 0)))
+ (setq xref (buffer-substring (point)
+ (progn (end-of-line) (point))))
+ (mail-header-set-xref headers xref))))))))
+
+(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
+ "Find article ID and insert the summary line for that article."
+ (let ((header (if (and old-header use-old-header)
+ old-header (gnus-read-header id)))
+ (number (and (numberp id) id))
+ pos)
+ (when header
+ ;; Rebuild the thread that this article is part of and go to the
+ ;; article we have fetched.
+ (when (and (not gnus-show-threads)
+ old-header)
+ (when (setq pos (text-property-any
+ (point-min) (point-max) 'gnus-number
+ (mail-header-number old-header)))
+ (goto-char pos)
+ (gnus-delete-line)
+ (gnus-data-remove (mail-header-number old-header))))
+ (when old-header
+ (mail-header-set-number header (mail-header-number old-header)))
+ (setq gnus-newsgroup-sparse
+ (delq (setq number (mail-header-number header))
+ gnus-newsgroup-sparse))
+ (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
+ (gnus-rebuild-thread (mail-header-id header))
+ (gnus-summary-goto-subject number nil t))
+ (when (and (numberp number)
+ (> number 0))
+ ;; We have to update the boundaries even if we can't fetch the
+ ;; article if ID is a number -- so that the next `P' or `N'
+ ;; command will fetch the previous (or next) article even
+ ;; if the one we tried to fetch this time has been canceled.
+ (and (> number gnus-newsgroup-end)
+ (setq gnus-newsgroup-end number))
+ (and (< number gnus-newsgroup-begin)
+ (setq gnus-newsgroup-begin number))
+ (setq gnus-newsgroup-unselected
+ (delq number gnus-newsgroup-unselected)))
+ ;; Report back a success?
+ (and header (mail-header-number header))))
+
+(defun gnus-summary-work-articles (n)
+ "Return a list of articles to be worked upon. The prefix argument,
+the list of process marked articles, and the current article will be
+taken into consideration."
+ (cond
+ (n
+ ;; A numerical prefix has been given.
+ (let ((backward (< n 0))
+ (n (abs (prefix-numeric-value n)))
+ articles article)
+ (save-excursion
+ (while
+ (and (> n 0)
+ (push (setq article (gnus-summary-article-number))
+ articles)
+ (if backward
+ (gnus-summary-find-prev nil article)
+ (gnus-summary-find-next nil article)))
+ (decf n)))
+ (nreverse articles)))
+ ((and (boundp 'transient-mark-mode)
+ transient-mark-mode
+ mark-active)
+ ;; Work on the region between point and mark.
+ (let ((max (max (point) (mark)))
+ articles article)
+ (save-excursion
+ (goto-char (min (point) (mark)))
+ (while
+ (and
+ (push (setq article (gnus-summary-article-number)) articles)
+ (gnus-summary-find-next nil article)
+ (< (point) max)))
+ (nreverse articles))))
+ (gnus-newsgroup-processable
+ ;; There are process-marked articles present.
+ (reverse gnus-newsgroup-processable))
+ (t
+ ;; Just return the current article.
+ (list (gnus-summary-article-number)))))
+
+(defun gnus-summary-search-group (&optional backward use-level)
+ "Search for next unread newsgroup.
+If optional argument BACKWARD is non-nil, search backward instead."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (if (gnus-group-search-forward
+ backward nil (if use-level (gnus-group-group-level) nil))
+ (gnus-group-group-name))))
+
+(defun gnus-summary-best-group (&optional exclude-group)
+ "Find the name of the best unread group.
+If EXCLUDE-GROUP, do not go to this group."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (save-excursion
+ (gnus-group-best-unread-group exclude-group))))
+
+(defun gnus-summary-find-next (&optional unread article backward)
+ (if backward (gnus-summary-find-prev)
+ (let* ((dummy (gnus-summary-article-intangible-p))
+ (article (or article (gnus-summary-article-number)))
+ (arts (gnus-data-find-list article))
+ result)
+ (when (and (not dummy)
+ (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts)))))
+ (setq arts (cdr arts)))
+ (when (setq result
+ (if unread
+ (progn
+ (while arts
+ (when (gnus-data-unread-p (car arts))
+ (setq result (car arts)
+ arts nil))
+ (setq arts (cdr arts)))
+ result)
+ (car arts)))
+ (goto-char (gnus-data-pos result))
+ (gnus-data-number result)))))
+
+(defun gnus-summary-find-prev (&optional unread article)
+ (let* ((eobp (eobp))
+ (article (or article (gnus-summary-article-number)))
+ (arts (gnus-data-find-list article (gnus-data-list 'rev)))
+ result)
+ (when (and (not eobp)
+ (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts)))))
+ (setq arts (cdr arts)))
+ (if (setq result
+ (if unread
+ (progn
+ (while arts
+ (and (gnus-data-unread-p (car arts))
+ (setq result (car arts)
+ arts nil))
+ (setq arts (cdr arts)))
+ result)
+ (car arts)))
+ (progn
+ (goto-char (gnus-data-pos result))
+ (gnus-data-number result)))))
+
+(defun gnus-summary-find-subject (subject &optional unread backward article)
+ (let* ((simp-subject (gnus-simplify-subject-fully subject))
+ (article (or article (gnus-summary-article-number)))
+ (articles (gnus-data-list backward))
+ (arts (gnus-data-find-list article articles))
+ result)
+ (when (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts))))
+ (setq arts (cdr arts)))
+ (while arts
+ (and (or (not unread)
+ (gnus-data-unread-p (car arts)))
+ (vectorp (gnus-data-header (car arts)))
+ (gnus-subject-equal
+ simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
+ (setq result (car arts)
+ arts nil))
+ (setq arts (cdr arts)))
+ (and result
+ (goto-char (gnus-data-pos result))
+ (gnus-data-number result))))
+
+(defun gnus-summary-search-forward (&optional unread subject backward)
+ "Search forward for an article.
+If UNREAD, look for unread articles. If SUBJECT, look for
+articles with that subject. If BACKWARD, search backward instead."
+ (cond (subject (gnus-summary-find-subject subject unread backward))
+ (backward (gnus-summary-find-prev unread))
+ (t (gnus-summary-find-next unread))))
+
+(defun gnus-recenter (&optional n)
+ "Center point in window and redisplay frame.
+Also do horizontal recentering."
+ (interactive "P")
+ (when (and gnus-auto-center-summary
+ (not (eq gnus-auto-center-summary 'vertical)))
+ (gnus-horizontal-recenter))
+ (recenter n))
+
+(defun gnus-summary-recenter ()
+ "Center point in the summary window.
+If `gnus-auto-center-summary' is nil, or the article buffer isn't
+displayed, no centering will be performed."
+ ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
+ ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
+ (let* ((top (cond ((< (window-height) 4) 0)
+ ((< (window-height) 7) 1)
+ (t 2)))
+ (height (1- (window-height)))
+ (bottom (save-excursion (goto-char (point-max))
+ (forward-line (- height))
+ (point)))
+ (window (get-buffer-window (current-buffer))))
+ ;; The user has to want it.
+ (when gnus-auto-center-summary
+ (when (get-buffer-window gnus-article-buffer)
+ ;; Only do recentering when the article buffer is displayed,
+ ;; Set the window start to either `bottom', which is the biggest
+ ;; possible valid number, or the second line from the top,
+ ;; whichever is the least.
+ (set-window-start
+ window (min bottom (save-excursion
+ (forward-line (- top)) (point)))))
+ ;; Do horizontal recentering while we're at it.
+ (when (and (get-buffer-window (current-buffer) t)
+ (not (eq gnus-auto-center-summary 'vertical)))
+ (let ((selected (selected-window)))
+ (select-window (get-buffer-window (current-buffer) t))
+ (gnus-summary-position-point)
+ (gnus-horizontal-recenter)
+ (select-window selected))))))
+
+(defun gnus-horizontal-recenter ()
+ "Recenter the current buffer horizontally."
+ (if (< (current-column) (/ (window-width) 2))
+ (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
+ (let* ((orig (point))
+ (end (window-end (get-buffer-window (current-buffer) t)))
+ (max 0))
+ ;; Find the longest line currently displayed in the window.
+ (goto-char (window-start))
+ (while (and (not (eobp))
+ (< (point) end))
+ (end-of-line)
+ (setq max (max max (current-column)))
+ (forward-line 1))
+ (goto-char orig)
+ ;; Scroll horizontally to center (sort of) the point.
+ (if (> max (window-width))
+ (set-window-hscroll
+ (get-buffer-window (current-buffer) t)
+ (min (- (current-column) (/ (window-width) 3))
+ (+ 2 (- max (window-width)))))
+ (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
+ max)))
+
+;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
+(defun gnus-short-group-name (group &optional levels)
+ "Collapse GROUP name LEVELS."
+ (let* ((name "")
+ (foreign "")
+ (depth 0)
+ (skip 1)
+ (levels (or levels
+ (progn
+ (while (string-match "\\." group skip)
+ (setq skip (match-end 0)
+ depth (+ depth 1)))
+ depth))))
+ (if (string-match ":" group)
+ (setq foreign (substring group 0 (match-end 0))
+ group (substring group (match-end 0))))
+ (while group
+ (if (and (string-match "\\." group)
+ (> levels (- gnus-group-uncollapsed-levels 1)))
+ (setq name (concat name (substring group 0 1))
+ group (substring group (match-end 0))
+ levels (- levels 1)
+ name (concat name "."))
+ (setq name (concat foreign name group)
+ group nil)))
+ name))
+
+(defun gnus-summary-jump-to-group (newsgroup)
+ "Move point to NEWSGROUP in group mode buffer."
+ ;; Keep update point of group mode buffer if visible.
+ (if (eq (current-buffer) (get-buffer gnus-group-buffer))
+ (save-window-excursion
+ ;; Take care of tree window mode.
+ (if (get-buffer-window gnus-group-buffer)
+ (pop-to-buffer gnus-group-buffer))
+ (gnus-group-jump-to-group newsgroup))
+ (save-excursion
+ ;; Take care of tree window mode.
+ (if (get-buffer-window gnus-group-buffer)
+ (pop-to-buffer gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
+ (gnus-group-jump-to-group newsgroup))))
+
+;; This function returns a list of article numbers based on the
+;; difference between the ranges of read articles in this group and
+;; the range of active articles.
+(defun gnus-list-of-unread-articles (group)
+ (let* ((read (gnus-info-read (gnus-get-info group)))
+ (active (gnus-active group))
+ (last (cdr active))
+ first nlast unread)
+ ;; If none are read, then all are unread.
+ (if (not read)
+ (setq first (car active))
+ ;; If the range of read articles is a single range, then the
+ ;; first unread article is the article after the last read
+ ;; article. Sounds logical, doesn't it?
+ (if (not (listp (cdr read)))
+ (setq first (1+ (cdr read)))
+ ;; `read' is a list of ranges.
+ (if (/= (setq nlast (or (and (numberp (car read)) (car read))
+ (caar read))) 1)
+ (setq first 1))
+ (while read
+ (if first
+ (while (< first nlast)
+ (setq unread (cons first unread))
+ (setq first (1+ first))))
+ (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
+ (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
+ (setq read (cdr read)))))
+ ;; And add the last unread articles.
+ (while (<= first last)
+ (setq unread (cons first unread))
+ (setq first (1+ first)))
+ ;; Return the list of unread articles.
+ (nreverse unread)))
+
+(defun gnus-list-of-read-articles (group)
+ "Return a list of unread, unticked and non-dormant articles."
+ (let* ((info (gnus-get-info group))
+ (marked (gnus-info-marks info))
+ (active (gnus-active group)))
+ (and info active
+ (gnus-set-difference
+ (gnus-sorted-complement
+ (gnus-uncompress-range active)
+ (gnus-list-of-unread-articles group))
+ (append
+ (gnus-uncompress-range (cdr (assq 'dormant marked)))
+ (gnus-uncompress-range (cdr (assq 'tick marked))))))))
+
+;; Various summary commands
+
+(defun gnus-summary-universal-argument (arg)
+ "Perform any operation on all articles that are process/prefixed."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((articles (gnus-summary-work-articles arg))
+ func article)
+ (if (eq
+ (setq
+ func
+ (key-binding
+ (read-key-sequence
+ (substitute-command-keys
+ "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
+ ))))
+ 'undefined)
+ (gnus-error 1 "Undefined key")
+ (save-excursion
+ (while articles
+ (gnus-summary-goto-subject (setq article (pop articles)))
+ (command-execute func)
+ (gnus-summary-remove-process-mark article)))))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-toggle-truncation (&optional arg)
+ "Toggle truncation of summary lines.
+With arg, turn line truncation on iff arg is positive."
+ (interactive "P")
+ (setq truncate-lines
+ (if (null arg) (not truncate-lines)
+ (> (prefix-numeric-value arg) 0)))
+ (redraw-display))
+
+(defun gnus-summary-reselect-current-group (&optional all rescan)
+ "Exit and then reselect the current newsgroup.
+The prefix argument ALL means to select all articles."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (when (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (error "Ephemeral groups can't be reselected"))
+ (let ((current-subject (gnus-summary-article-number))
+ (group gnus-newsgroup-name))
+ (setq gnus-newsgroup-begin nil)
+ (gnus-summary-exit)
+ ;; We have to adjust the point of group mode buffer because the
+ ;; current point was moved to the next unread newsgroup by
+ ;; exiting.
+ (gnus-summary-jump-to-group group)
+ (when rescan
+ (save-excursion
+ (gnus-group-get-new-news-this-group 1)))
+ (gnus-group-read-group all t)
+ (gnus-summary-goto-subject current-subject nil t)))
+
+(defun gnus-summary-rescan-group (&optional all)
+ "Exit the newsgroup, ask for new articles, and select the newsgroup."
+ (interactive "P")
+ (gnus-summary-reselect-current-group all t))
+
+(defun gnus-summary-update-info ()
+ (let* ((group gnus-newsgroup-name))
+ (when gnus-newsgroup-kill-headers
+ (setq gnus-newsgroup-killed
+ (gnus-compress-sequence
+ (nconc
+ (gnus-set-sorted-intersection
+ (gnus-uncompress-range gnus-newsgroup-killed)
+ (setq gnus-newsgroup-unselected
+ (sort gnus-newsgroup-unselected '<)))
+ (setq gnus-newsgroup-unreads
+ (sort gnus-newsgroup-unreads '<))) t)))
+ (unless (listp (cdr gnus-newsgroup-killed))
+ (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
+ (let ((headers gnus-newsgroup-headers))
+ (run-hooks 'gnus-exit-group-hook)
+ (unless gnus-save-score
+ (setq gnus-newsgroup-scored nil))
+ ;; Set the new ranges of read articles.
+ (gnus-update-read-articles
+ group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
+ ;; Set the current article marks.
+ (gnus-update-marks)
+ ;; Do the cross-ref thing.
+ (when gnus-use-cross-reference
+ (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
+ ;; Do adaptive scoring, and possibly save score files.
+ (when gnus-newsgroup-adaptive
+ (gnus-score-adaptive))
+ (when gnus-use-scoring
+ (gnus-score-save))
+ ;; Do not switch windows but change the buffer to work.
+ (set-buffer gnus-group-buffer)
+ (or (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-group-update-group group)))))
+
+(defun gnus-summary-exit (&optional temporary)
+ "Exit reading current newsgroup, and then return to group selection mode.
+gnus-exit-group-hook is called with no arguments if that value is non-nil."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-kill-save-kill-buffer)
+ (let* ((group gnus-newsgroup-name)
+ (quit-config (gnus-group-quit-config gnus-newsgroup-name))
+ (mode major-mode)
+ (buf (current-buffer)))
+ (run-hooks 'gnus-summary-prepare-exit-hook)
+ ;; If we have several article buffers, we kill them at exit.
+ (unless gnus-single-article-buffer
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
+ (when gnus-use-cache
+ (gnus-cache-possibly-remove-articles)
+ (gnus-cache-save-buffers))
+ (when gnus-use-trees
+ (gnus-tree-close group))
+ ;; Make all changes in this group permanent.
+ (unless quit-config
+ (gnus-summary-update-info))
+ (gnus-close-group group)
+ ;; Make sure where I was, and go to next newsgroup.
+ (set-buffer gnus-group-buffer)
+ (unless quit-config
+ (gnus-group-jump-to-group group))
+ (run-hooks 'gnus-summary-exit-hook)
+ (unless quit-config
+ (gnus-group-next-unread-group 1))
+ (if temporary
+ nil ;Nothing to do.
+ ;; If we have several article buffers, we kill them at exit.
+ (unless gnus-single-article-buffer
+ (gnus-kill-buffer gnus-article-buffer)
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
+ (set-buffer buf)
+ (if (not gnus-kill-summary-on-exit)
+ (gnus-deaden-summary)
+ ;; We set all buffer-local variables to nil. It is unclear why
+ ;; this is needed, but if we don't, buffer-local variables are
+ ;; not garbage-collected, it seems. This would the lead to en
+ ;; ever-growing Emacs.
+ (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.
+ (gnus-configure-windows 'group 'force)
+ (gnus-summary-clear-local-variables)
+ ;; Return to group mode buffer.
+ (if (eq mode 'gnus-summary-mode)
+ (gnus-kill-buffer buf)))
+ (setq gnus-current-select-method gnus-select-method)
+ (pop-to-buffer gnus-group-buffer)
+ ;; Clear the current group name.
+ (if (not quit-config)
+ (progn
+ (gnus-group-jump-to-group group)
+ (gnus-group-next-unread-group 1)
+ (gnus-configure-windows 'group 'force))
+ (if (not (buffer-name (car quit-config)))
+ (gnus-configure-windows 'group 'force)
+ (set-buffer (car quit-config))
+ (and (eq major-mode 'gnus-summary-mode)
+ (gnus-set-global-variables))
+ (gnus-configure-windows (cdr quit-config))))
+ (unless quit-config
+ (setq gnus-newsgroup-name nil)))))
+
+(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
+(defun gnus-summary-exit-no-update (&optional no-questions)
+ "Quit reading current newsgroup without updating read article info."
+ (interactive)
+ (gnus-set-global-variables)
+ (let* ((group gnus-newsgroup-name)
+ (quit-config (gnus-group-quit-config group)))
+ (when (or no-questions
+ gnus-expert-user
+ (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
+ ;; If we have several article buffers, we kill them at exit.
+ (unless gnus-single-article-buffer
+ (gnus-kill-buffer gnus-article-buffer)
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
+ (if (not gnus-kill-summary-on-exit)
+ (gnus-deaden-summary)
+ (gnus-close-group group)
+ (gnus-summary-clear-local-variables)
+ (set-buffer gnus-group-buffer)
+ (gnus-summary-clear-local-variables)
+ (when (get-buffer gnus-summary-buffer)
+ (kill-buffer gnus-summary-buffer)))
+ (unless gnus-single-article-buffer
+ (setq gnus-article-current nil))
+ (when gnus-use-trees
+ (gnus-tree-close group))
+ (when (get-buffer gnus-article-buffer)
+ (bury-buffer gnus-article-buffer))
+ ;; Return to the group buffer.
+ (gnus-configure-windows 'group 'force)
+ ;; Clear the current group name.
+ (setq gnus-newsgroup-name nil)
+ (when (equal (gnus-group-group-name) group)
+ (gnus-group-next-unread-group 1))
+ (when quit-config
+ (if (not (buffer-name (car quit-config)))
+ (gnus-configure-windows 'group 'force)
+ (set-buffer (car quit-config))
+ (when (eq major-mode 'gnus-summary-mode)
+ (gnus-set-global-variables))
+ (gnus-configure-windows (cdr quit-config)))))))
+
+;;; Dead summaries.
+
+(defvar gnus-dead-summary-mode-map nil)
+
+(if gnus-dead-summary-mode-map
+ nil
+ (setq gnus-dead-summary-mode-map (make-keymap))
+ (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")))
+ (while keys
+ (define-key gnus-dead-summary-mode-map
+ (pop keys) 'gnus-summary-wake-up-the-dead))))
+
+(defvar gnus-dead-summary-mode nil
+ "Minor mode for Gnus summary buffers.")
+
+(defun gnus-dead-summary-mode (&optional arg)
+ "Minor mode for Gnus summary buffers."
+ (interactive "P")
+ (when (eq major-mode 'gnus-summary-mode)
+ (make-local-variable 'gnus-dead-summary-mode)
+ (setq gnus-dead-summary-mode
+ (if (null arg) (not gnus-dead-summary-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (when gnus-dead-summary-mode
+ (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
+ (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
+ (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
+ (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
+ minor-mode-map-alist)))))
+
+(defun gnus-deaden-summary ()
+ "Make the current summary buffer into a dead summary buffer."
+ ;; Kill any previous dead summary buffer.
+ (when (and gnus-dead-summary
+ (buffer-name gnus-dead-summary))
+ (save-excursion
+ (set-buffer gnus-dead-summary)
+ (when gnus-dead-summary-mode
+ (kill-buffer (current-buffer)))))
+ ;; Make this the current dead summary.
+ (setq gnus-dead-summary (current-buffer))
+ (gnus-dead-summary-mode 1)
+ (let ((name (buffer-name)))
+ (when (string-match "Summary" name)
+ (rename-buffer
+ (concat (substring name 0 (match-beginning 0)) "Dead "
+ (substring name (match-beginning 0))) t))))
+
+(defun gnus-kill-or-deaden-summary (buffer)
+ "Kill or deaden the summary BUFFER."
+ (when (and (buffer-name buffer)
+ (not gnus-single-article-buffer))
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-kill-buffer gnus-article-buffer)
+ (gnus-kill-buffer gnus-original-article-buffer)))
+ (cond (gnus-kill-summary-on-exit
+ (when (and gnus-use-trees
+ (and (get-buffer buffer)
+ (buffer-name (get-buffer buffer))))
+ (save-excursion
+ (set-buffer (get-buffer buffer))
+ (gnus-tree-close gnus-newsgroup-name)))
+ (gnus-kill-buffer buffer))
+ ((and (get-buffer buffer)
+ (buffer-name (get-buffer buffer)))
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-deaden-summary)))))
+
+(defun gnus-summary-wake-up-the-dead (&rest args)
+ "Wake up the dead summary buffer."
+ (interactive)
+ (gnus-dead-summary-mode -1)
+ (let ((name (buffer-name)))
+ (when (string-match "Dead " name)
+ (rename-buffer
+ (concat (substring name 0 (match-beginning 0))
+ (substring name (match-end 0))) t)))
+ (gnus-message 3 "This dead summary is now alive again"))
+
+;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
+(defun gnus-summary-fetch-faq (&optional faq-dir)
+ "Fetch the FAQ for the current group.
+If FAQ-DIR (the prefix), prompt for a directory to search for the faq
+in."
+ (interactive
+ (list
+ (if current-prefix-arg
+ (completing-read
+ "Faq dir: " (and (listp gnus-group-faq-directory)
+ gnus-group-faq-directory)))))
+ (let (gnus-faq-buffer)
+ (and (setq gnus-faq-buffer
+ (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
+ (gnus-configure-windows 'summary-faq))))
+
+;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defun gnus-summary-describe-group (&optional force)
+ "Describe the current newsgroup."
+ (interactive "P")
+ (gnus-group-describe-group force gnus-newsgroup-name))
+
+(defun gnus-summary-describe-briefly ()
+ "Describe summary mode commands briefly."
+ (interactive)
+ (gnus-message 6
+ (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+
+;; Walking around group mode buffer from summary mode.
+
+(defun gnus-summary-next-group (&optional no-article target-group backward)
+ "Exit current newsgroup and then select next unread newsgroup.
+If prefix argument NO-ARTICLE is non-nil, no article is selected
+initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
+previous group instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((current-group gnus-newsgroup-name)
+ (current-buffer (current-buffer))
+ entered)
+ ;; First we semi-exit this group to update Xrefs and all variables.
+ ;; We can't do a real exit, because the window conf must remain
+ ;; the same in case the user is prompted for info, and we don't
+ ;; want the window conf to change before that...
+ (gnus-summary-exit t)
+ (while (not entered)
+ ;; Then we find what group we are supposed to enter.
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group current-group)
+ (setq target-group
+ (or target-group
+ (if (eq gnus-keep-same-level 'best)
+ (gnus-summary-best-group gnus-newsgroup-name)
+ (gnus-summary-search-group backward gnus-keep-same-level))))
+ (if (not target-group)
+ ;; There are no further groups, so we return to the group
+ ;; buffer.
+ (progn
+ (gnus-message 5 "Returning to the group buffer")
+ (setq entered t)
+ (set-buffer current-buffer)
+ (gnus-summary-exit))
+ ;; We try to enter the target group.
+ (gnus-group-jump-to-group target-group)
+ (let ((unreads (gnus-group-group-unread)))
+ (if (and (or (eq t unreads)
+ (and unreads (not (zerop unreads))))
+ (gnus-summary-read-group
+ target-group nil no-article current-buffer))
+ (setq entered t)
+ (setq current-group target-group
+ target-group nil)))))))
+
+(defun gnus-summary-prev-group (&optional no-article)
+ "Exit current newsgroup and then select previous unread newsgroup.
+If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
+ (interactive "P")
+ (gnus-summary-next-group no-article nil t))
+
+;; Walking around summary lines.
+
+(defun gnus-summary-first-subject (&optional unread)
+ "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."
+ (interactive "P")
+ (prog1
+ (cond
+ ;; Empty summary.
+ ((null gnus-newsgroup-data)
+ (gnus-message 3 "No articles in the group")
+ nil)
+ ;; Pick the first article.
+ ((not unread)
+ (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
+ (gnus-data-number (car gnus-newsgroup-data)))
+ ;; No unread articles.
+ ((null gnus-newsgroup-unreads)
+ (gnus-message 3 "No more unread articles")
+ nil)
+ ;; Find the first unread article.
+ (t
+ (let ((data gnus-newsgroup-data))
+ (while (and data
+ (not (gnus-data-unread-p (car data))))
+ (setq data (cdr data)))
+ (if data
+ (progn
+ (goto-char (gnus-data-pos (car data)))
+ (gnus-data-number (car data)))))))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-next-subject (n &optional unread dont-display)
+ "Go to next N'th summary line.
+If N is negative, go to the previous N'th subject line.
+If UNREAD is non-nil, only unread articles are selected.
+The difference between N and the actual number of steps taken is
+returned."
+ (interactive "p")
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (while (and (> n 0)
+ (if backward
+ (gnus-summary-find-prev unread)
+ (gnus-summary-find-next unread)))
+ (setq n (1- n)))
+ (if (/= 0 n) (gnus-message 7 "No more%s articles"
+ (if unread " unread" "")))
+ (unless dont-display
+ (gnus-summary-recenter)
+ (gnus-summary-position-point))
+ n))
+
+(defun gnus-summary-next-unread-subject (n)
+ "Go to next N'th unread summary line."
+ (interactive "p")
+ (gnus-summary-next-subject n t))
+
+(defun gnus-summary-prev-subject (n &optional unread)
+ "Go to previous N'th summary line.
+If optional argument UNREAD is non-nil, only unread article is selected."
+ (interactive "p")
+ (gnus-summary-next-subject (- n) unread))
+
+(defun gnus-summary-prev-unread-subject (n)
+ "Go to previous N'th unread summary line."
+ (interactive "p")
+ (gnus-summary-next-subject (- n) t))
+
+(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 ((b (point))
+ (data (gnus-data-find article)))
+ ;; We read in the article if we have to.
+ (and (not data)
+ force
+ (gnus-summary-insert-subject article (and (vectorp force) force) t)
+ (setq data (gnus-data-find article)))
+ (goto-char b)
+ (if (not data)
+ (progn
+ (unless silent
+ (gnus-message 3 "Can't find article %d" article))
+ nil)
+ (goto-char (gnus-data-pos data))
+ article)))
+
+;; Walking around summary lines with displaying articles.
+
+(defun gnus-summary-expand-window (&optional arg)
+ "Make the summary buffer take up the entire Emacs frame.
+Given a prefix, will force an `article' buffer configuration."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (if arg
+ (gnus-configure-windows 'article 'force)
+ (gnus-configure-windows 'summary 'force)))
+
+(defun gnus-summary-display-article (article &optional all-header)
+ "Display ARTICLE in article buffer."
+ (gnus-set-global-variables)
+ (if (null article)
+ nil
+ (prog1
+ (if gnus-summary-display-article-function
+ (funcall gnus-summary-display-article-function article all-header)
+ (gnus-article-prepare article all-header))
+ (run-hooks 'gnus-select-article-hook)
+ (unless (zerop gnus-current-article)
+ (gnus-summary-goto-subject gnus-current-article))
+ (gnus-summary-recenter)
+ (when gnus-use-trees
+ (gnus-possibly-generate-tree article)
+ (gnus-highlight-selected-tree article))
+ ;; Successfully display article.
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks))))))
+
+(defun gnus-summary-select-article (&optional all-headers force pseudo article)
+ "Select the current article.
+If ALL-HEADERS is non-nil, show all header fields. If FORCE is
+non-nil, the article will be re-fetched even if it already present in
+the article buffer. If PSEUDO is non-nil, pseudo-articles will also
+be displayed."
+ ;; Make sure we are in the summary buffer to work around bbdb bug.
+ (unless (eq major-mode 'gnus-summary-mode)
+ (set-buffer gnus-summary-buffer))
+ (let ((article (or article (gnus-summary-article-number)))
+ (all-headers (not (not all-headers))) ;Must be T or NIL.
+ gnus-summary-display-article-function
+ did)
+ (and (not pseudo)
+ (gnus-summary-article-pseudo-p article)
+ (error "This is a pseudo-article."))
+ (prog1
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (if (or (and gnus-single-article-buffer
+ (or (null gnus-current-article)
+ (null gnus-article-current)
+ (null (get-buffer gnus-article-buffer))
+ (not (eq article (cdr gnus-article-current)))
+ (not (equal (car gnus-article-current)
+ gnus-newsgroup-name))))
+ (and (not gnus-single-article-buffer)
+ (or (null gnus-current-article)
+ (not (eq gnus-current-article article))))
+ force)
+ ;; The requested article is different from the current article.
+ (prog1
+ (gnus-summary-display-article article all-headers)
+ (setq did article))
+ (if (or all-headers gnus-show-all-headers)
+ (gnus-article-show-all-headers))
+ 'old))
+ (if did
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks)))))))
+
+(defun gnus-summary-set-current-mark (&optional current-mark)
+ "Obsolete function."
+ nil)
+
+(defun gnus-summary-next-article (&optional unread subject backward push)
+ "Select the next article.
+If UNREAD, only unread articles are selected.
+If SUBJECT, only articles with SUBJECT are selected.
+If BACKWARD, the previous article is selected instead of the next."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (cond
+ ;; Is there such an article?
+ ((and (gnus-summary-search-forward unread subject backward)
+ (or (gnus-summary-display-article (gnus-summary-article-number))
+ (eq (gnus-summary-article-mark) gnus-canceled-mark)))
+ (gnus-summary-position-point))
+ ;; If not, we try the first unread, if that is wanted.
+ ((and subject
+ gnus-auto-select-same
+ (gnus-summary-first-unread-article))
+ (gnus-summary-position-point)
+ (gnus-message 6 "Wrapped"))
+ ;; Try to get next/previous article not displayed in this group.
+ ((and gnus-auto-extend-newsgroup
+ (not unread) (not subject))
+ (gnus-summary-goto-article
+ (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
+ nil t))
+ ;; Go to next/previous group.
+ (t
+ (or (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-summary-jump-to-group gnus-newsgroup-name))
+ (let ((cmd last-command-char)
+ (group
+ (if (eq gnus-keep-same-level 'best)
+ (gnus-summary-best-group gnus-newsgroup-name)
+ (gnus-summary-search-group backward gnus-keep-same-level))))
+ ;; For some reason, the group window gets selected. We change
+ ;; it back.
+ (select-window (get-buffer-window (current-buffer)))
+ ;; Select next unread newsgroup automagically.
+ (cond
+ ((or (not gnus-auto-select-next)
+ (not cmd))
+ (gnus-message 7 "No more%s articles" (if unread " unread" "")))
+ ((or (eq gnus-auto-select-next 'quietly)
+ (and (eq gnus-auto-select-next 'slightly-quietly)
+ push)
+ (and (eq gnus-auto-select-next 'almost-quietly)
+ (gnus-summary-last-article-p)))
+ ;; Select quietly.
+ (if (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-summary-exit)
+ (gnus-message 7 "No more%s articles (%s)..."
+ (if unread " unread" "")
+ (if group (concat "selecting " group)
+ "exiting"))
+ (gnus-summary-next-group nil group backward)))
+ (t
+ (gnus-summary-walk-group-buffer
+ gnus-newsgroup-name cmd unread backward)))))))
+
+(defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
+ (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
+ (?\C-p (gnus-group-prev-unread-group 1))))
+ keve key group ended)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-summary-jump-to-group from-group)
+ (setq group
+ (if (eq gnus-keep-same-level 'best)
+ (gnus-summary-best-group gnus-newsgroup-name)
+ (gnus-summary-search-group backward gnus-keep-same-level))))
+ (while (not ended)
+ (gnus-message
+ 5 "No more%s articles%s" (if unread " unread" "")
+ (if (and group
+ (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
+ (format " (Type %s for %s [%s])"
+ (single-key-description cmd) group
+ (car (gnus-gethash group gnus-newsrc-hashtb)))
+ (format " (Type %s to exit %s)"
+ (single-key-description cmd)
+ gnus-newsgroup-name)))
+ ;; Confirm auto selection.
+ (setq key (car (setq keve (gnus-read-event-char))))
+ (setq ended t)
+ (cond
+ ((assq key keystrokes)
+ (let ((obuf (current-buffer)))
+ (switch-to-buffer gnus-group-buffer)
+ (and group
+ (gnus-group-jump-to-group group))
+ (eval (cadr (assq key keystrokes)))
+ (setq group (gnus-group-group-name))
+ (switch-to-buffer obuf))
+ (setq ended nil))
+ ((equal key cmd)
+ (if (or (not group)
+ (gnus-ephemeral-group-p gnus-newsgroup-name))
+ (gnus-summary-exit)
+ (gnus-summary-next-group nil group backward)))
+ (t
+ (push (cdr keve) unread-command-events))))))
+
+(defun gnus-read-event-char ()
+ "Get the next event."
+ (let ((event (read-event)))
+ (cons (and (numberp event) event) event)))
+
+(defun gnus-summary-next-unread-article ()
+ "Select unread article after current one."
+ (interactive)
+ (gnus-summary-next-article t (and gnus-auto-select-same
+ (gnus-summary-article-subject))))
+
+(defun gnus-summary-prev-article (&optional unread subject)
+ "Select the article after the current one.
+If UNREAD is non-nil, only unread articles are selected."
+ (interactive "P")
+ (gnus-summary-next-article unread subject t))
+
+(defun gnus-summary-prev-unread-article ()
+ "Select unred article before current one."
+ (interactive)
+ (gnus-summary-prev-article t (and gnus-auto-select-same
+ (gnus-summary-article-subject))))
+
+(defun gnus-summary-next-page (&optional lines circular)
+ "Show next page of the selected article.
+If at the end of the current article, select the next article.
+LINES says how many lines should be scrolled up.
+
+If CIRCULAR is non-nil, go to the start of the article instead of
+selecting the next article when reaching the end of the current
+article."
+ (interactive "P")
+ (setq gnus-summary-buffer (current-buffer))
+ (gnus-set-global-variables)
+ (let ((article (gnus-summary-article-number))
+ (endp nil))
+ (gnus-configure-windows 'article)
+ (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-last-article-p article)))
+ (gnus-summary-next-article)
+ (gnus-summary-next-unread-article))
+ (if (or (null gnus-current-article)
+ (null gnus-article-current)
+ (/= article (cdr gnus-article-current))
+ (not (equal (car gnus-article-current) gnus-newsgroup-name)))
+ ;; Selected subject is different from current article's.
+ (gnus-summary-display-article article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq endp (gnus-article-next-page lines)))
+ (if endp
+ (cond (circular
+ (gnus-summary-beginning-of-article))
+ (lines
+ (gnus-message 3 "End of message"))
+ ((null lines)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-last-article-p article)))
+ (gnus-summary-next-article)
+ (gnus-summary-next-unread-article)))))))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-prev-page (&optional lines)
+ "Show previous page of selected article.
+Argument LINES specifies lines to be scrolled down."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((article (gnus-summary-article-number)))
+ (gnus-configure-windows 'article)
+ (if (or (null gnus-current-article)
+ (null gnus-article-current)
+ (/= article (cdr gnus-article-current))
+ (not (equal (car gnus-article-current) gnus-newsgroup-name)))
+ ;; Selected subject is different from current article's.
+ (gnus-summary-display-article article)
+ (gnus-summary-recenter)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (gnus-article-prev-page lines))))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-scroll-up (lines)
+ "Scroll up (or down) one line current article.
+Argument LINES specifies lines to be scrolled up (or down if negative)."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-configure-windows 'article)
+ (gnus-summary-show-thread)
+ (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (cond ((> lines 0)
+ (if (gnus-article-next-page lines)
+ (gnus-message 3 "End of message")))
+ ((< lines 0)
+ (gnus-article-prev-page (- lines))))))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point))
+
+(defun gnus-summary-next-same-subject ()
+ "Select next article which has the same subject as current one."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-next-article nil (gnus-summary-article-subject)))
+
+(defun gnus-summary-prev-same-subject ()
+ "Select previous article which has the same subject as current one."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-prev-article nil (gnus-summary-article-subject)))
+
+(defun gnus-summary-next-unread-same-subject ()
+ "Select next unread article which has the same subject as current one."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-next-article t (gnus-summary-article-subject)))
+
+(defun gnus-summary-prev-unread-same-subject ()
+ "Select previous unread article which has the same subject as current one."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-prev-article t (gnus-summary-article-subject)))
+
+(defun gnus-summary-first-unread-article ()
+ "Select the first unread article.
+Return nil if there are no unread articles."
+ (interactive)
+ (gnus-set-global-variables)
+ (prog1
+ (if (gnus-summary-first-subject t)
+ (progn
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject t)
+ (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."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((best -1000000)
+ (data gnus-newsgroup-data)
+ article score)
+ (while data
+ (and (gnus-data-unread-p (car data))
+ (> (setq score
+ (gnus-summary-article-score (gnus-data-number (car data))))
+ best)
+ (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))))
+
+(defun gnus-summary-last-subject ()
+ "Go to the last displayed subject line in the group."
+ (let ((article (gnus-data-number (car (gnus-data-list t)))))
+ (when article
+ (gnus-summary-goto-subject article))))
+
+(defun gnus-summary-goto-article (article &optional all-headers force)
+ "Fetch ARTICLE and display it if it exists.
+If ALL-HEADERS is non-nil, no header lines are hidden."
+ (interactive
+ (list
+ (string-to-int
+ (completing-read
+ "Article number: "
+ (mapcar (lambda (number) (list (int-to-string number)))
+ gnus-newsgroup-limit)))
+ current-prefix-arg
+ t))
+ (prog1
+ (if (gnus-summary-goto-subject article force)
+ (gnus-summary-display-article article all-headers)
+ (gnus-message 4 "Couldn't go to article %s" article) nil)
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-goto-last-article ()
+ "Go to the previously read article."
+ (interactive)
+ (prog1
+ (and gnus-last-article
+ (gnus-summary-goto-article gnus-last-article))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-pop-article (number)
+ "Pop one article off the history and go to the previous.
+NUMBER articles will be popped off."
+ (interactive "p")
+ (let (to)
+ (setq gnus-newsgroup-history
+ (cdr (setq to (nthcdr number gnus-newsgroup-history))))
+ (if to
+ (gnus-summary-goto-article (car to))
+ (error "Article history empty")))
+ (gnus-summary-position-point))
+
+;; Summary commands and functions for limiting the summary buffer.
+
+(defun gnus-summary-limit-to-articles (n)
+ "Limit the summary buffer to the next N articles.
+If not given a prefix, use the process marked articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (prog1
+ (let ((articles (gnus-summary-work-articles n)))
+ (setq gnus-newsgroup-processable nil)
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-pop-limit (&optional total)
+ "Restore the previous limit.
+If given a prefix, remove all limits."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (when total
+ (setq gnus-newsgroup-limits
+ (list (mapcar (lambda (h) (mail-header-number h))
+ gnus-newsgroup-headers))))
+ (unless gnus-newsgroup-limits
+ (error "No limit to pop"))
+ (prog1
+ (gnus-summary-limit nil 'pop)
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-limit-to-subject (subject &optional header)
+ "Limit the summary buffer to articles that have subjects that match a regexp."
+ (interactive "sRegexp: ")
+ (unless header
+ (setq header "subject"))
+ (when (not (equal "" subject))
+ (prog1
+ (let ((articles (gnus-summary-find-matching
+ (or header "subject") subject 'all)))
+ (or articles (error "Found no matches for \"%s\"" subject))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-to-author (from)
+ "Limit the summary buffer to articles that have authors that match a regexp."
+ (interactive "sRegexp: ")
+ (gnus-summary-limit-to-subject from "from"))
+
+(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
+(make-obsolete
+ 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
+
+(defun gnus-summary-limit-to-unread (&optional all)
+ "Limit the summary buffer to articles that are not marked as read.
+If ALL is non-nil, limit strictly to unread articles."
+ (interactive "P")
+ (if all
+ (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
+ (gnus-summary-limit-to-marks
+ ;; Concat all the marks that say that an article is read and have
+ ;; those removed.
+ (list gnus-del-mark gnus-read-mark gnus-ancient-mark
+ gnus-killed-mark gnus-kill-file-mark
+ gnus-low-score-mark gnus-expirable-mark
+ gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark)
+ 'reverse)))
+
+(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
+(make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
+
+(defun gnus-summary-limit-to-marks (marks &optional reverse)
+ "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
+If REVERSE, limit the summary buffer to articles that are not marked
+with MARKS. MARKS can either be a string of marks or a list of marks.
+Returns how many articles were removed."
+ (interactive "sMarks: ")
+ (gnus-set-global-variables)
+ (prog1
+ (let ((data gnus-newsgroup-data)
+ (marks (if (listp marks) marks
+ (append marks nil))) ; Transform to list.
+ articles)
+ (while data
+ (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
+ (memq (gnus-data-mark (car data)) marks))
+ (setq articles (cons (gnus-data-number (car data)) articles)))
+ (setq data (cdr data)))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-limit-to-score (&optional score)
+ "Limit to articles with score at or above SCORE."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (setq score (if score
+ (prefix-numeric-value score)
+ (or gnus-summary-default-score 0)))
+ (let ((data gnus-newsgroup-data)
+ articles)
+ (while data
+ (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
+ score)
+ (push (gnus-data-number (car data)) articles))
+ (setq data (cdr data)))
+ (prog1
+ (gnus-summary-limit articles)
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-include-dormant ()
+ "Display all the hidden articles that are marked as dormant."
+ (interactive)
+ (gnus-set-global-variables)
+ (or gnus-newsgroup-dormant
+ (error "There are no dormant articles in this group"))
+ (prog1
+ (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-limit-exclude-dormant ()
+ "Hide all dormant articles."
+ (interactive)
+ (gnus-set-global-variables)
+ (prog1
+ (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-limit-exclude-childless-dormant ()
+ "Hide all dormant articles that have no children."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((data (gnus-data-list t))
+ articles d children)
+ ;; Find all articles that are either not dormant or have
+ ;; children.
+ (while (setq d (pop data))
+ (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
+ (and (setq children
+ (gnus-article-children (gnus-data-number d)))
+ (let (found)
+ (while children
+ (when (memq (car children) articles)
+ (setq children nil
+ found t))
+ (pop children))
+ found)))
+ (push (gnus-data-number d) articles)))
+ ;; Do the limiting.
+ (prog1
+ (gnus-summary-limit articles)
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-mark-excluded-as-read (&optional all)
+ "Mark all unread excluded articles as read.
+If ALL, mark even excluded ticked and dormants as read."
+ (interactive "P")
+ (let ((articles (gnus-sorted-complement
+ (sort
+ (mapcar (lambda (h) (mail-header-number h))
+ gnus-newsgroup-headers)
+ '<)
+ (sort gnus-newsgroup-limit '<)))
+ article)
+ (setq gnus-newsgroup-unreads nil)
+ (if all
+ (setq gnus-newsgroup-dormant nil
+ gnus-newsgroup-marked nil
+ gnus-newsgroup-reads
+ (nconc
+ (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
+ gnus-newsgroup-reads))
+ (while (setq article (pop articles))
+ (unless (or (memq article gnus-newsgroup-dormant)
+ (memq article gnus-newsgroup-marked))
+ (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
+
+(defun gnus-summary-limit (articles &optional pop)
+ (if pop
+ ;; We pop the previous limit off the stack and use that.
+ (setq articles (car gnus-newsgroup-limits)
+ gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
+ ;; We use the new limit, so we push the old limit on the stack.
+ (setq gnus-newsgroup-limits
+ (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
+ ;; Set the limit.
+ (setq gnus-newsgroup-limit articles)
+ (let ((total (length gnus-newsgroup-data))
+ (data (gnus-data-find-list (gnus-summary-article-number)))
+ (gnus-summary-mark-below nil) ; Inhibit this.
+ found)
+ ;; This will do all the work of generating the new summary buffer
+ ;; 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))
+ ;; Try to return to the article you were at, or one in the
+ ;; neighborhood.
+ (if data
+ ;; We try to find some article after the current one.
+ (while data
+ (and (gnus-summary-goto-subject
+ (gnus-data-number (car data)) nil t)
+ (setq data nil
+ found t))
+ (setq data (cdr data))))
+ (or found
+ ;; If there is no data, that means that we were after the last
+ ;; article. The same goes when we can't find any articles
+ ;; after the current one.
+ (progn
+ (goto-char (point-max))
+ (gnus-summary-find-prev)))
+ ;; We return how many articles were removed from the summary
+ ;; buffer as a result of the new limit.
+ (- total (length gnus-newsgroup-data))))
+
+(defsubst gnus-invisible-cut-children (threads)
+ (let ((num 0))
+ (while threads
+ (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
+ (incf num))
+ (pop threads))
+ (< num 2)))
+
+(defsubst gnus-cut-thread (thread)
+ "Go forwards in the thread until we find an article that we want to display."
+ (when (or (eq gnus-fetch-old-headers 'some)
+ (eq gnus-build-sparse-threads 'some)
+ (eq gnus-build-sparse-threads 'more))
+ ;; Deal with old-fetched headers and sparse threads.
+ (while (and
+ thread
+ (or
+ (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
+ (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
+ (or (<= (length (cdr thread)) 1)
+ (gnus-invisible-cut-children (cdr thread))))
+ (setq thread (cadr thread))))
+ thread)
+
+(defun gnus-cut-threads (threads)
+ "Cut off all uninteresting articles from the beginning of threads."
+ (when (or (eq gnus-fetch-old-headers 'some)
+ (eq gnus-build-sparse-threads 'some)
+ (eq gnus-build-sparse-threads 'more))
+ (let ((th threads))
+ (while th
+ (setcar th (gnus-cut-thread (car th)))
+ (setq th (cdr th)))))
+ ;; Remove nixed out threads.
+ (delq nil threads))
+
+(defun gnus-summary-initial-limit (&optional show-if-empty)
+ "Figure out what the initial limit is supposed to be on group entry.
+This entails weeding out unwanted dormants, low-scored articles,
+fetch-old-headers verbiage, and so on."
+ ;; Most groups have nothing to remove.
+ (if (or gnus-inhibit-limiting
+ (and (null gnus-newsgroup-dormant)
+ (not (eq gnus-fetch-old-headers 'some))
+ (null gnus-summary-expunge-below)
+ (not (eq gnus-build-sparse-threads 'some))
+ (not (eq gnus-build-sparse-threads 'more))
+ (null gnus-thread-expunge-below)
+ (not gnus-use-nocem)))
+ () ; Do nothing.
+ (push gnus-newsgroup-limit gnus-newsgroup-limits)
+ (setq gnus-newsgroup-limit nil)
+ (mapatoms
+ (lambda (node)
+ (unless (car (symbol-value node))
+ ;; These threads have no parents -- they are roots.
+ (let ((nodes (cdr (symbol-value node)))
+ thread)
+ (while nodes
+ (if (and gnus-thread-expunge-below
+ (< (gnus-thread-total-score (car nodes))
+ gnus-thread-expunge-below))
+ (gnus-expunge-thread (pop nodes))
+ (setq thread (pop nodes))
+ (gnus-summary-limit-children thread))))))
+ gnus-newsgroup-dependencies)
+ ;; If this limitation resulted in an empty group, we might
+ ;; pop the previous limit and use it instead.
+ (when (and (not gnus-newsgroup-limit)
+ show-if-empty)
+ (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
+ gnus-newsgroup-limit))
+
+(defun gnus-summary-limit-children (thread)
+ "Return 1 if this subthread is visible and 0 if it is not."
+ ;; First we get the number of visible children to this thread. This
+ ;; is done by recursing down the thread using this function, so this
+ ;; will really go down to a leaf article first, before slowly
+ ;; working its way up towards the root.
+ (when thread
+ (let ((children
+ (if (cdr thread)
+ (apply '+ (mapcar 'gnus-summary-limit-children
+ (cdr thread)))
+ 0))
+ (number (mail-header-number (car thread)))
+ score)
+ (if (or
+ ;; If this article is dormant and has absolutely no visible
+ ;; children, then this article isn't visible.
+ (and (memq number gnus-newsgroup-dormant)
+ (= children 0))
+ ;; If this is "fetch-old-headered" and there is only one
+ ;; visible child (or less), then we don't want this article.
+ (and (eq gnus-fetch-old-headers 'some)
+ (memq number gnus-newsgroup-ancient)
+ (zerop children))
+ ;; If this is a sparsely inserted article with no children,
+ ;; we don't want it.
+ (and (eq gnus-build-sparse-threads 'some)
+ (memq number gnus-newsgroup-sparse)
+ (zerop children))
+ ;; If we use expunging, and this article is really
+ ;; low-scored, then we don't want this article.
+ (when (and gnus-summary-expunge-below
+ (< (setq score
+ (or (cdr (assq number gnus-newsgroup-scored))
+ gnus-summary-default-score))
+ gnus-summary-expunge-below))
+ ;; We increase the expunge-tally here, but that has
+ ;; nothing to do with the limits, really.
+ (incf gnus-newsgroup-expunged-tally)
+ ;; We also mark as read here, if that's wanted.
+ (when (and gnus-summary-mark-below
+ (< score gnus-summary-mark-below))
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ (if gnus-newsgroup-auto-expire
+ (push number gnus-newsgroup-expirable)
+ (push (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads)))
+ t)
+ (and gnus-use-nocem
+ (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))))
+ ;; Nope, invisible article.
+ 0
+ ;; Ok, this article is to be visible, so we add it to the limit
+ ;; and return 1.
+ (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
+ 1))))
+
+(defun gnus-expunge-thread (thread)
+ "Mark all articles in THREAD as read."
+ (let* ((number (mail-header-number (car thread))))
+ (incf gnus-newsgroup-expunged-tally)
+ ;; We also mark as read here, if that's wanted.
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ (if gnus-newsgroup-auto-expire
+ (push number gnus-newsgroup-expirable)
+ (push (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads)))
+ ;; Go recursively through all subthreads.
+ (mapcar 'gnus-expunge-thread (cdr thread)))
+
+;; Summary article oriented commands
+
+(defun gnus-summary-refer-parent-article (n)
+ "Refer parent article N times.
+The difference between N and the number of articles fetched is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (while
+ (and
+ (> n 0)
+ (let* ((header (gnus-summary-article-header))
+ (ref
+ ;; If we try to find the parent of the currently
+ ;; displayed article, then we take a look at the actual
+ ;; References header, since this is slightly more
+ ;; reliable than the References field we got from the
+ ;; server.
+ (if (and (eq (mail-header-number header)
+ (cdr gnus-article-current))
+ (equal gnus-newsgroup-name
+ (car gnus-article-current)))
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (nnheader-narrow-to-headers)
+ (prog1
+ (message-fetch-field "references")
+ (widen)))
+ ;; It's not the current article, so we take a bet on
+ ;; the value we got from the server.
+ (mail-header-references header))))
+ (if (setq ref (or ref (mail-header-references header)))
+ (or (gnus-summary-refer-article (gnus-parent-id ref))
+ (gnus-message 1 "Couldn't find parent"))
+ (gnus-message 1 "No references in article %d"
+ (gnus-summary-article-number))
+ nil)))
+ (setq n (1- n)))
+ (gnus-summary-position-point)
+ n)
+
+(defun gnus-summary-refer-references ()
+ "Fetch all articles mentioned in the References header.
+Return how many articles were fetched."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((ref (mail-header-references (gnus-summary-article-header)))
+ (current (gnus-summary-article-number))
+ (n 0))
+ ;; For each Message-ID in the References header...
+ (while (string-match "<[^>]*>" ref)
+ (incf n)
+ ;; ... fetch that article.
+ (gnus-summary-refer-article
+ (prog1 (match-string 0 ref)
+ (setq ref (substring ref (match-end 0))))))
+ (gnus-summary-goto-subject current)
+ (gnus-summary-position-point)
+ n))
+
+(defun gnus-summary-refer-article (message-id)
+ "Fetch an article specified by MESSAGE-ID."
+ (interactive "sMessage-ID: ")
+ (when (and (stringp message-id)
+ (not (zerop (length message-id))))
+ ;; Construct the correct Message-ID if necessary.
+ ;; Suggested by tale@pawl.rpi.edu.
+ (unless (string-match "^<" message-id)
+ (setq message-id (concat "<" message-id)))
+ (unless (string-match ">$" message-id)
+ (setq message-id (concat message-id ">")))
+ (let* ((header (gnus-id-to-header message-id))
+ (sparse (and header
+ (memq (mail-header-number header)
+ gnus-newsgroup-sparse))))
+ (if header
+ (prog1
+ ;; The article is present in the buffer, to we just go to it.
+ (gnus-summary-goto-article
+ (mail-header-number header) nil header)
+ (when sparse
+ (gnus-summary-update-article (mail-header-number header))))
+ ;; We fetch the article
+ (let ((gnus-override-method
+ (and (gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method))
+ number)
+ ;; Start the special refer-article method, if necessary.
+ (when (and gnus-refer-article-method
+ (gnus-news-group-p gnus-newsgroup-name))
+ (gnus-check-server gnus-refer-article-method))
+ ;; Fetch the header, and display the article.
+ (if (setq number (gnus-summary-insert-subject message-id))
+ (gnus-summary-select-article nil nil nil number)
+ (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
+
+(defun gnus-summary-enter-digest-group (&optional force)
+ "Enter a digest group based on the current article."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (let ((name (format "%s-%d"
+ (gnus-group-prefixed-name
+ gnus-newsgroup-name (list 'nndoc ""))
+ gnus-current-article))
+ (ogroup gnus-newsgroup-name)
+ (case-fold-search t)
+ (buf (current-buffer))
+ dig)
+ (save-excursion
+ (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
+ (insert-buffer-substring gnus-original-article-buffer)
+ (narrow-to-region
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point)))
+ (goto-char (point-min))
+ (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (widen))
+ (unwind-protect
+ (if (gnus-group-read-ephemeral-group
+ name `(nndoc ,name (nndoc-address
+ ,(get-buffer dig))
+ (nndoc-article-type ,(if force 'digest 'guess))) t)
+ ;; Make all postings to this group go to the parent group.
+ (nconc (gnus-info-params (gnus-get-info name))
+ (list (cons 'to-group ogroup)))
+ ;; Couldn't select this doc group.
+ (switch-to-buffer buf)
+ (gnus-set-global-variables)
+ (gnus-configure-windows 'summary)
+ (gnus-message 3 "Article couldn't be entered?"))
+ (kill-buffer dig))))
+
+(defun gnus-summary-isearch-article (&optional regexp-p)
+ "Do incremental search forward on the current article.
+If REGEXP-P (the prefix) is non-nil, do regexp isearch."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (goto-char (point-min))
+ (isearch-forward regexp-p)))
+
+(defun gnus-summary-search-article-forward (regexp &optional backward)
+ "Search for an article containing REGEXP forward.
+If BACKWARD, search backward instead."
+ (interactive
+ (list (read-string
+ (format "Search article %s (regexp%s): "
+ (if current-prefix-arg "backward" "forward")
+ (if gnus-last-search-regexp
+ (concat ", default " gnus-last-search-regexp)
+ "")))
+ current-prefix-arg))
+ (gnus-set-global-variables)
+ (if (string-equal regexp "")
+ (setq regexp (or gnus-last-search-regexp ""))
+ (setq gnus-last-search-regexp regexp))
+ (unless (gnus-summary-search-article regexp backward)
+ (error "Search failed: \"%s\"" regexp)))
+
+(defun gnus-summary-search-article-backward (regexp)
+ "Search for an article containing REGEXP backward."
+ (interactive
+ (list (read-string
+ (format "Search article backward (regexp%s): "
+ (if gnus-last-search-regexp
+ (concat ", default " gnus-last-search-regexp)
+ "")))))
+ (gnus-summary-search-article-forward regexp 'backward))
+
+(defun gnus-summary-search-article (regexp &optional backward)
+ "Search for an article containing REGEXP.
+Optional argument BACKWARD means do search for backward.
+`gnus-select-article-hook' is not called during the search."
+ (let ((gnus-select-article-hook nil) ;Disable hook.
+ (gnus-article-display-hook nil)
+ (gnus-mark-article-hook nil) ;Inhibit marking as read.
+ (re-search
+ (if backward
+ 're-search-backward 're-search-forward))
+ (sum (current-buffer))
+ (found nil))
+ (gnus-save-hidden-threads
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (when backward
+ (forward-line -1))
+ (while (not found)
+ (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
+ (if (if backward
+ (re-search-backward regexp nil t)
+ (re-search-forward regexp nil t))
+ ;; We found the regexp.
+ (progn
+ (setq found 'found)
+ (beginning-of-line)
+ (set-window-start
+ (get-buffer-window (current-buffer))
+ (point))
+ (forward-line 1)
+ (set-buffer sum))
+ ;; We didn't find it, so we go to the next article.
+ (set-buffer sum)
+ (if (not (if backward (gnus-summary-find-prev)
+ (gnus-summary-find-next)))
+ ;; No more articles.
+ (setq found t)
+ ;; Select the next article and adjust point.
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (widen)
+ (goto-char (if backward (point-max) (point-min))))))
+ (gnus-message 7 ""))
+ ;; Return whether we found the regexp.
+ (when (eq found 'found)
+ (gnus-summary-show-thread)
+ (gnus-summary-goto-subject gnus-current-article)
+ (gnus-summary-position-point)
+ t)))
+
+(defun gnus-summary-find-matching (header regexp &optional backward unread
+ not-case-fold)
+ "Return a list of all articles that match REGEXP on HEADER.
+The search stars on the current article and goes forwards unless
+BACKWARD is non-nil. If BACKWARD is `all', do all articles.
+If UNREAD is non-nil, only unread articles will
+be taken into consideration. If NOT-CASE-FOLD, case won't be folded
+in the comparisons."
+ (let ((data (if (eq backward 'all) gnus-newsgroup-data
+ (gnus-data-find-list
+ (gnus-summary-article-number) (gnus-data-list backward))))
+ (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
+ (case-fold-search (not not-case-fold))
+ articles d)
+ (or (fboundp (intern (concat "mail-header-" header)))
+ (error "%s is not a valid header" header))
+ (while data
+ (setq d (car data))
+ (and (or (not unread) ; We want all articles...
+ (gnus-data-unread-p d)) ; Or just unreads.
+ (vectorp (gnus-data-header d)) ; It's not a pseudo.
+ (string-match regexp (funcall func (gnus-data-header d))) ; Match.
+ (setq articles (cons (gnus-data-number d) articles))) ; Success!
+ (setq data (cdr data)))
+ (nreverse articles)))
+
+(defun gnus-summary-execute-command (header regexp command &optional backward)
+ "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
+If HEADER is an empty string (or nil), the match is done on the entire
+article. If BACKWARD (the prefix) is non-nil, search backward instead."
+ (interactive
+ (list (let ((completion-ignore-case t))
+ (completing-read
+ "Header name: "
+ (mapcar (lambda (string) (list string))
+ '("Number" "Subject" "From" "Lines" "Date"
+ "Message-ID" "Xref" "References" "Body"))
+ nil 'require-match))
+ (read-string "Regexp: ")
+ (read-key-sequence "Command: ")
+ current-prefix-arg))
+ (when (equal header "Body")
+ (setq header ""))
+ (gnus-set-global-variables)
+ ;; Hidden thread subtrees must be searched as well.
+ (gnus-summary-show-all-threads)
+ ;; We don't want to change current point nor window configuration.
+ (save-excursion
+ (save-window-excursion
+ (gnus-message 6 "Executing %s..." (key-description command))
+ ;; We'd like to execute COMMAND interactively so as to give arguments.
+ (gnus-execute header regexp
+ `(lambda () (call-interactively ',(key-binding command)))
+ backward)
+ (gnus-message 6 "Executing %s...done" (key-description command)))))
+
+(defun gnus-summary-beginning-of-article ()
+ "Scroll the article back to the beginning."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (widen)
+ (goto-char (point-min))
+ (and gnus-break-pages (gnus-narrow-to-page))))
+
+(defun gnus-summary-end-of-article ()
+ "Scroll to the end of the article."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (widen)
+ (goto-char (point-max))
+ (recenter -3)
+ (and gnus-break-pages (gnus-narrow-to-page))))
+
+(defun gnus-summary-show-article (&optional arg)
+ "Force re-fetching of the current article.
+If ARG (the prefix) is non-nil, show the raw article without any
+article massaging functions being run."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (if (not arg)
+ ;; Select the article the normal way.
+ (gnus-summary-select-article nil 'force)
+ ;; Bind the article treatment functions to nil.
+ (let ((gnus-have-all-headers t)
+ gnus-article-display-hook
+ gnus-article-prepare-hook
+ gnus-break-pages
+ gnus-visual)
+ (gnus-summary-select-article nil 'force)))
+ (gnus-summary-goto-subject gnus-current-article)
+; (gnus-configure-windows 'article)
+ (gnus-summary-position-point))
+
+(defun gnus-summary-verbose-headers (&optional arg)
+ "Toggle permanent full header display.
+If ARG is a positive number, turn header display on.
+If ARG is a negative number, turn header display off."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-toggle-header arg)
+ (setq gnus-show-all-headers
+ (cond ((or (not (numberp arg))
+ (zerop arg))
+ (not gnus-show-all-headers))
+ ((natnump arg)
+ t))))
+
+(defun gnus-summary-toggle-header (&optional arg)
+ "Show the headers if they are hidden, or hide them if they are shown.
+If ARG is a positive number, show the entire header.
+If ARG is a negative number, hide the unwanted header lines."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let* ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (hidden (text-property-any
+ (goto-char (point-min)) (search-forward "\n\n")
+ 'invisible t))
+ e)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (point-min) (1- (point))))
+ (goto-char (point-min))
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
+ (insert-buffer-substring gnus-original-article-buffer 1 e)
+ (let ((gnus-inhibit-hiding t))
+ (run-hooks 'gnus-article-display-hook))
+ (if (or (not hidden) (and (numberp arg) (< arg 0)))
+ (gnus-article-hide-headers)))))
+
+(defun gnus-summary-show-all-headers ()
+ "Make all header lines visible."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-article-show-all-headers))
+
+(defun gnus-summary-toggle-mime (&optional arg)
+ "Toggle MIME processing.
+If ARG is a positive number, turn MIME processing on."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (setq gnus-show-mime
+ (if (null arg) (not gnus-show-mime)
+ (> (prefix-numeric-value arg) 0)))
+ (gnus-summary-select-article t 'force))
+
+(defun gnus-summary-caesar-message (&optional arg)
+ "Caesar rotate the current article by 13.
+The numerical prefix specifies how manu places to rotate each letter
+forward."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (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)
+ (message-caesar-buffer-body arg)
+ (set-window-start (get-buffer-window (current-buffer)) start))))))
+
+(defun gnus-summary-stop-page-breaking ()
+ "Stop page breaking in the current article."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (widen)))
+
+(defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
+ "Move the current article to a different newsgroup.
+If N is a positive number, move the N next articles.
+If N is a negative number, move the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+move those articles instead.
+If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
+If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
+re-spool using this method.
+
+For this function to work, both the current newsgroup and the
+newsgroup that you want to move to have to support the `request-move'
+and `request-accept' functions."
+ (interactive "P")
+ (unless action (setq action 'move))
+ (gnus-set-global-variables)
+ ;; Check whether the source group supports the required functions.
+ (cond ((and (eq action 'move)
+ (not (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name)))
+ (error "The current group does not support article moving"))
+ ((and (eq action 'crosspost)
+ (not (gnus-check-backend-function
+ 'request-replace-article gnus-newsgroup-name)))
+ (error "The current group does not support article editing")))
+ (let ((articles (gnus-summary-work-articles n))
+ (prefix (gnus-group-real-prefix gnus-newsgroup-name))
+ (names '((move "Move" "Moving")
+ (copy "Copy" "Copying")
+ (crosspost "Crosspost" "Crossposting")))
+ (copy-buf (save-excursion
+ (nnheader-set-temp-buffer " *copy article*")))
+ art-group to-method new-xref article to-groups)
+ (unless (assq action names)
+ (error "Unknown action %s" action))
+ ;; Read the newsgroup name.
+ (when (and (not to-newsgroup)
+ (not select-method))
+ (setq to-newsgroup
+ (gnus-read-move-group-name
+ (cadr (assq action names))
+ (symbol-value (intern (format "gnus-current-%s-group" action)))
+ articles prefix))
+ (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
+ (setq to-method (or select-method
+ (gnus-group-name-to-method to-newsgroup)))
+ ;; Check the method we are to move this article to...
+ (or (gnus-check-backend-function 'request-accept-article (car to-method))
+ (error "%s does not support article copying" (car to-method)))
+ (or (gnus-check-server to-method)
+ (error "Can't open server %s" (car to-method)))
+ (gnus-message 6 "%s to %s: %s..."
+ (caddr (assq action names))
+ (or (car select-method) to-newsgroup) articles)
+ (while articles
+ (setq article (pop articles))
+ (setq
+ art-group
+ (cond
+ ;; Move the article.
+ ((eq action 'move)
+ (gnus-request-move-article
+ article ; Article to move
+ gnus-newsgroup-name ; From newsgrouo
+ (nth 1 (gnus-find-method-for-group
+ gnus-newsgroup-name)) ; Server
+ (list 'gnus-request-accept-article
+ to-newsgroup (list 'quote select-method)
+ (not articles)) ; Accept form
+ (not articles))) ; Only save nov last time
+ ;; Copy the article.
+ ((eq action 'copy)
+ (save-excursion
+ (set-buffer copy-buf)
+ (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles))))
+ ;; Crosspost the article.
+ ((eq action 'crosspost)
+ (let ((xref (mail-header-xref (gnus-summary-article-header article))))
+ (setq new-xref (concat gnus-newsgroup-name ":" article))
+ (if (and xref (not (string= xref "")))
+ (progn
+ (when (string-match "^Xref: " xref)
+ (setq xref (substring xref (match-end 0))))
+ (setq new-xref (concat xref " " new-xref)))
+ (setq new-xref (concat (system-name) " " new-xref)))
+ (save-excursion
+ (set-buffer copy-buf)
+ (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (nnheader-replace-header "xref" new-xref)
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles)))))))
+ (if (not art-group)
+ (gnus-message 1 "Couldn't %s article %s"
+ (cadr (assq action names)) article)
+ (let* ((entry
+ (or
+ (gnus-gethash (car art-group) gnus-newsrc-hashtb)
+ (gnus-gethash
+ (gnus-group-prefixed-name
+ (car art-group)
+ (or select-method
+ (gnus-find-method-for-group to-newsgroup)))
+ gnus-newsrc-hashtb)))
+ (info (nth 2 entry))
+ (to-group (gnus-info-group info)))
+ ;; Update the group that has been moved to.
+ (when (and info
+ (memq action '(move copy)))
+ (unless (member to-group to-groups)
+ (push to-group to-groups))
+
+ (unless (memq article gnus-newsgroup-unreads)
+ (gnus-info-set-read
+ info (gnus-add-to-range (gnus-info-read info)
+ (list (cdr art-group)))))
+
+ ;; Copy any marks over to the new group.
+ (let ((marks gnus-article-mark-lists)
+ (to-article (cdr art-group)))
+
+ ;; See whether the article is to be put in the cache.
+ (when gnus-use-cache
+ (gnus-cache-possibly-enter-article
+ to-group to-article
+ (let ((header (copy-sequence
+ (gnus-summary-article-header article))))
+ (mail-header-set-number header to-article)
+ header)
+ (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-dormant)
+ (memq article gnus-newsgroup-unreads)))
+
+ (while marks
+ (when (memq article (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))
+ ;; If the other group is the same as this group,
+ ;; then we have to add the mark to the list.
+ (when (equal to-group gnus-newsgroup-name)
+ (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+ (cons to-article
+ (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))))
+ ;; Copy mark to other group.
+ (gnus-add-marked-articles
+ to-group (cdar marks) (list to-article) info))
+ (setq marks (cdr marks)))))
+
+ ;; Update the Xref header in this article to point to
+ ;; the new crossposted article we have just created.
+ (when (eq action 'crosspost)
+ (save-excursion
+ (set-buffer copy-buf)
+ (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (nnheader-replace-header
+ "xref" (concat new-xref " " (gnus-group-prefixed-name
+ (car art-group) to-method)
+ ":" (cdr art-group)))
+ (gnus-request-replace-article
+ article gnus-newsgroup-name (current-buffer)))))
+
+ (gnus-summary-goto-subject article)
+ (when (eq action 'move)
+ (gnus-summary-mark-article article gnus-canceled-mark)))
+ (gnus-summary-remove-process-mark article))
+ ;; Re-activate all groups that have been moved to.
+ (while to-groups
+ (gnus-activate-group (pop to-groups)))
+
+ (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.
+If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
+re-spool using this method."
+ (interactive "P")
+ (gnus-summary-move-article n nil select-method 'copy))
+
+(defun gnus-summary-crosspost-article (&optional n)
+ "Crosspost the current article to some other group."
+ (interactive "P")
+ (gnus-summary-move-article n nil nil 'crosspost))
+
+(defvar gnus-summary-respool-default-method nil
+ "Default method for respooling an article.
+If nil, use to the current newsgroup method.")
+
+(defun gnus-summary-respool-article (&optional n method)
+ "Respool the current article.
+The article will be squeezed through the mail spooling process again,
+which means that it will be put in some mail newsgroup or other
+depending on `nnmail-split-methods'.
+If N is a positive number, respool the N next articles.
+If N is a negative number, respool the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+respool those articles instead.
+
+Respooling can be done both from mail groups and \"real\" newsgroups.
+In the former case, the articles in question will be moved from the
+current group into whatever groups they are destined to. In the
+latter case, they will be copied into the relevant groups."
+ (interactive
+ (list current-prefix-arg
+ (let* ((methods (gnus-methods-using 'respool))
+ (methname
+ (symbol-name (or gnus-summary-respool-default-method
+ (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))))
+ (method
+ (gnus-completing-read
+ methname "What backend do you want to use when respooling?"
+ methods nil t nil 'gnus-method-history))
+ ms)
+ (cond
+ ((zerop (length (setq ms (gnus-servers-using-backend method))))
+ (list (intern method) ""))
+ ((= 1 (length ms))
+ (car ms))
+ (t
+ (cdr (completing-read
+ "Server name: "
+ (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t)))))))
+ (gnus-set-global-variables)
+ (unless method
+ (error "No method given for respooling"))
+ (if (assoc (symbol-name
+ (car (gnus-find-method-for-group gnus-newsgroup-name)))
+ (gnus-methods-using 'respool))
+ (gnus-summary-move-article n nil method)
+ (gnus-summary-copy-article n nil method)))
+
+(defun gnus-summary-import-article (file)
+ "Import a random file into a mail newsgroup."
+ (interactive "fImport file: ")
+ (gnus-set-global-variables)
+ (let ((group gnus-newsgroup-name)
+ (now (current-time))
+ atts lines)
+ (or (gnus-check-backend-function 'request-accept-article group)
+ (error "%s does not support article importing" group))
+ (or (file-readable-p file)
+ (not (file-regular-p file))
+ (error "Can't read %s" file))
+ (save-excursion
+ (set-buffer (get-buffer-create " *import file*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (unless (nnheader-article-p)
+ ;; This doesn't look like an article, so we fudge some headers.
+ (setq atts (file-attributes file)
+ lines (count-lines (point-min) (point-max)))
+ (insert "From: " (read-string "From: ") "\n"
+ "Subject: " (read-string "Subject: ") "\n"
+ "Date: " (timezone-make-date-arpa-standard
+ (current-time-string (nth 5 atts))
+ (current-time-zone now)
+ (current-time-zone now)) "\n"
+ "Message-ID: " (message-make-message-id) "\n"
+ "Lines: " (int-to-string lines) "\n"
+ "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
+ (gnus-request-accept-article group nil t)
+ (kill-buffer (current-buffer)))))
+
+(defun gnus-summary-expire-articles (&optional now)
+ "Expire all articles that are marked as expirable in the current group."
+ (interactive)
+ (gnus-set-global-variables)
+ (when (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)
+ ;; This backend supports expiry.
+ (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
+ (expirable (if total
+ (gnus-list-of-read-articles gnus-newsgroup-name)
+ (setq gnus-newsgroup-expirable
+ (sort gnus-newsgroup-expirable '<))))
+ (expiry-wait (if now 'immediate
+ (gnus-group-get-parameter
+ gnus-newsgroup-name 'expiry-wait)))
+ es)
+ (when expirable
+ ;; There are expirable articles in this group, so we run them
+ ;; through the expiry process.
+ (gnus-message 6 "Expiring articles...")
+ ;; The list of articles that weren't expired is returned.
+ (if expiry-wait
+ (let ((nnmail-expiry-wait-function nil)
+ (nnmail-expiry-wait expiry-wait))
+ (setq es (gnus-request-expire-articles
+ expirable gnus-newsgroup-name)))
+ (setq es (gnus-request-expire-articles
+ expirable gnus-newsgroup-name)))
+ (or total (setq gnus-newsgroup-expirable es))
+ ;; We go through the old list of expirable, and mark all
+ ;; really expired articles as nonexistent.
+ (unless (eq es expirable) ;If nothing was expired, we don't mark.
+ (let ((gnus-use-cache nil))
+ (while expirable
+ (unless (memq (car expirable) es)
+ (when (gnus-data-find (car expirable))
+ (gnus-summary-mark-article
+ (car expirable) gnus-canceled-mark)))
+ (setq expirable (cdr expirable)))))
+ (gnus-message 6 "Expiring articles...done")))))
+
+(defun gnus-summary-expire-articles-now ()
+ "Expunge all expirable articles in the current group.
+This means that *all* articles that are marked as expirable will be
+deleted forever, right now."
+ (interactive)
+ (gnus-set-global-variables)
+ (or gnus-expert-user
+ (gnus-y-or-n-p
+ "Are you really, really, really sure you want to delete all these messages? ")
+ (error "Phew!"))
+ (gnus-summary-expire-articles t))
+
+;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
+(defun gnus-summary-delete-article (&optional n)
+ "Delete the N next (mail) articles.
+This command actually deletes articles. This is not a marking
+command. The article will disappear forever from your life, never to
+return.
+If N is negative, delete backwards.
+If N is nil and articles have been marked with the process mark,
+delete these instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (or (gnus-check-backend-function 'request-expire-articles
+ gnus-newsgroup-name)
+ (error "The current newsgroup does not support article deletion."))
+ ;; Compute the list of articles to delete.
+ (let ((articles (gnus-summary-work-articles n))
+ not-deleted)
+ (if (and gnus-novice-user
+ (not (gnus-y-or-n-p
+ (format "Do you really want to delete %s forever? "
+ (if (> (length articles) 1)
+ (format "these %s articles" (length articles))
+ "this article")))))
+ ()
+ ;; Delete the articles.
+ (setq not-deleted (gnus-request-expire-articles
+ articles gnus-newsgroup-name 'force))
+ (while articles
+ (gnus-summary-remove-process-mark (car articles))
+ ;; The backend might not have been able to delete the article
+ ;; after all.
+ (or (memq (car articles) not-deleted)
+ (gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (setq articles (cdr articles))))
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ not-deleted))
+
+(defun gnus-summary-edit-article (&optional force)
+ "Enter into a buffer and edit the current article.
+This will have permanent effect only in mail groups.
+If FORCE is non-nil, allow editing of articles even in read-only
+groups."
+ (interactive "P")
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-set-global-variables)
+ (when (and (not force)
+ (gnus-group-read-only-p))
+ (error "The current newsgroup does not support article editing."))
+ (gnus-summary-select-article t nil t)
+ (gnus-configure-windows 'article)
+ (select-window (get-buffer-window gnus-article-buffer))
+ (gnus-message 6 "C-c C-c to end edits")
+ (setq buffer-read-only nil)
+ (text-mode)
+ (use-local-map (copy-keymap (current-local-map)))
+ (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
+ (buffer-enable-undo)
+ (widen)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)))
+
+(defun gnus-summary-edit-article-done ()
+ "Make edits to the current article permanent."
+ (interactive)
+ (if (gnus-group-read-only-p)
+ (progn
+ (let ((beep (not (eq major-mode 'text-mode))))
+ (gnus-summary-edit-article-postpone)
+ (when beep
+ (gnus-error
+ 3 "The current newsgroup does not support article editing."))))
+ (let ((buf (format "%s" (buffer-string))))
+ (erase-buffer)
+ (insert buf)
+ (if (not (gnus-request-replace-article
+ (cdr gnus-article-current) (car gnus-article-current)
+ (current-buffer)))
+ (error "Couldn't replace article.")
+ (gnus-article-mode)
+ (use-local-map gnus-article-mode-map)
+ (setq buffer-read-only t)
+ (buffer-disable-undo (current-buffer))
+ (gnus-configure-windows 'summary)
+ (gnus-summary-update-article (cdr gnus-article-current))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current))))
+ (save-excursion
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (setq gnus-article-current nil
+ gnus-current-article nil)
+ (run-hooks 'gnus-article-display-hook)
+ (and (gnus-visual-p 'summary-highlight 'highlight)
+ (run-hooks 'gnus-visual-mark-article-hook)))))
+
+(defun gnus-summary-edit-article-postpone ()
+ "Postpone changes to the current article."
+ (interactive)
+ (gnus-article-mode)
+ (use-local-map gnus-article-mode-map)
+ (setq buffer-read-only t)
+ (buffer-disable-undo (current-buffer))
+ (gnus-configure-windows 'summary)
+ (and (gnus-visual-p 'summary-highlight 'highlight)
+ (run-hooks 'gnus-visual-mark-article-hook)))
+
+(defun gnus-summary-respool-query ()
+ "Query where the respool algorithm would put this article."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (save-restriction
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (narrow-to-region (point-min) (point))
+ (pp-eval-expression
+ (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
+
+;; Summary marking commands.
+
+(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
+ "Mark articles which has the same subject as read, and then select the next.
+If UNMARK is positive, remove any kind of mark.
+If UNMARK is negative, tick articles."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (if unmark
+ (setq unmark (prefix-numeric-value unmark)))
+ (let ((count
+ (gnus-summary-mark-same-subject
+ (gnus-summary-article-subject) unmark)))
+ ;; Select next unread article. If auto-select-same mode, should
+ ;; select the first unread article.
+ (gnus-summary-next-article t (and gnus-auto-select-same
+ (gnus-summary-article-subject)))
+ (gnus-message 7 "%d article%s marked as %s"
+ count (if (= count 1) " is" "s are")
+ (if unmark "unread" "read"))))
+
+(defun gnus-summary-kill-same-subject (&optional unmark)
+ "Mark articles which has the same subject as read.
+If UNMARK is positive, remove any kind of mark.
+If UNMARK is negative, tick articles."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (if unmark
+ (setq unmark (prefix-numeric-value unmark)))
+ (let ((count
+ (gnus-summary-mark-same-subject
+ (gnus-summary-article-subject) unmark)))
+ ;; If marked as read, go to next unread subject.
+ (if (null unmark)
+ ;; Go to next unread subject.
+ (gnus-summary-next-subject 1 t))
+ (gnus-message 7 "%d articles are marked as %s"
+ count (if unmark "unread" "read"))))
+
+(defun gnus-summary-mark-same-subject (subject &optional unmark)
+ "Mark articles with same SUBJECT as read, and return marked number.
+If optional argument UNMARK is positive, remove any kinds of marks.
+If optional argument UNMARK is negative, mark articles as unread instead."
+ (let ((count 1))
+ (save-excursion
+ (cond
+ ((null unmark) ; Mark as read.
+ (while (and
+ (progn
+ (gnus-summary-mark-article-as-read gnus-killed-mark)
+ (gnus-summary-show-thread) t)
+ (gnus-summary-find-subject subject))
+ (setq count (1+ count))))
+ ((> unmark 0) ; Tick.
+ (while (and
+ (progn
+ (gnus-summary-mark-article-as-unread gnus-ticked-mark)
+ (gnus-summary-show-thread) t)
+ (gnus-summary-find-subject subject))
+ (setq count (1+ count))))
+ (t ; Mark as unread.
+ (while (and
+ (progn
+ (gnus-summary-mark-article-as-unread gnus-unread-mark)
+ (gnus-summary-show-thread) t)
+ (gnus-summary-find-subject subject))
+ (setq count (1+ count)))))
+ (gnus-set-mode-line 'summary)
+ ;; Return the number of marked articles.
+ count)))
+
+(defun gnus-summary-mark-as-processable (n &optional unmark)
+ "Set the process mark on the next N articles.
+If N is negative, mark backward instead. If UNMARK is non-nil, remove
+the process mark instead. The difference between N and the actual
+number of articles marked is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (while (and
+ (> n 0)
+ (if unmark
+ (gnus-summary-remove-process-mark
+ (gnus-summary-article-number))
+ (gnus-summary-set-process-mark (gnus-summary-article-number)))
+ (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
+ (setq n (1- n)))
+ (if (/= 0 n) (gnus-message 7 "No more articles"))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ n))
+
+(defun gnus-summary-unmark-as-processable (n)
+ "Remove the process mark from the next N articles.
+If N is negative, mark backward instead. The difference between N and
+the actual number of articles marked is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-summary-mark-as-processable n t))
+
+(defun gnus-summary-unmark-all-processable ()
+ "Remove the process mark from all articles."
+ (interactive)
+ (gnus-set-global-variables)
+ (save-excursion
+ (while gnus-newsgroup-processable
+ (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
+ (gnus-summary-position-point))
+
+(defun gnus-summary-mark-as-expirable (n)
+ "Mark N articles forward as expirable.
+If N is negative, mark backward instead. The difference between N and
+the actual number of articles marked is returned."
+ (interactive "p")
+ (gnus-set-global-variables)
+ (gnus-summary-mark-forward n gnus-expirable-mark))