;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'gnus)
(require 'gnus-group)
(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-int)
(require 'gnus-undo)
+(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(defcustom gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
just marked as read) article, the old article will not normally be
displayed in the Summary buffer. If this variable is non-nil, Gnus
will attempt to grab the headers to the old articles, and thereby
-build complete threads. If it has the value `some', only enough
-headers to connect otherwise loose threads will be displayed.
-This variable can also be a number. In that case, no more than that
-number of old headers will be fetched.
+build complete threads. If it has the value `some', only enough
+headers to connect otherwise loose threads will be displayed. This
+variable can also be a number. In that case, no more than that number
+of old headers will be fetched. If it has the value `invisible', all
+old headers will be fetched, but none will be displayed.
The server has to support NOV for any of this to work."
:group 'gnus-thread
number
(sexp :menu-tag "other" t)))
+(defcustom gnus-refer-thread-limit 200
+ "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
+If t, fetch all the available old headers."
+ :group 'gnus-thread
+ :type '(choice number
+ (sexp :menu-tag "other" t)))
+
(defcustom gnus-summary-make-false-root 'adopt
"*nil means that Gnus won't gather loose threads.
If the root of a thread has expired or been read in a previous
(const fuzzy)
(sexp :menu-tag "on" t)))
+(defcustom gnus-simplify-subject-functions nil
+ "List of functions taking a string argument that simplify subjects.
+The functions are applied recursively."
+ :group 'gnus-thread
+ :type '(repeat (list function)))
+
(defcustom gnus-simplify-ignored-prefixes nil
"*Regexp, matches for which are removed from subject lines when simplifying fuzzily."
:group 'gnus-thread
`gnus-gather-threads-by-references', which compared the References
headers of the articles to find matches."
:group 'gnus-thread
- :type '(set (function-item gnus-gather-threads-by-subject)
- (function-item gnus-gather-threads-by-references)
- (function :tag "other")))
+ :type '(radio (function-item gnus-gather-threads-by-subject)
+ (function-item gnus-gather-threads-by-references)
+ (function :tag "other")))
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defcustom gnus-summary-same-subject ""
"*String indicating that the current article has the same subject as the previous.
This variable will only be used if the value of
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-undownloaded-mark ?@
+ "*Mark used for articles that weren't downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-downloadable-mark ?%
+ "*Mark used for articles that are to be downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-unsendable-mark ?=
+ "*Mark used for articles that won't be sent."
+ :group 'gnus-summary-marks
+ :type 'character)
+
(defcustom gnus-score-over-mark ?+
"*Score mark used for articles with high scores."
:group 'gnus-summary-marks
:group 'gnus-summary-visual
:type 'hook)
+;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+(defcustom gnus-structured-field-decoder 'identity
+ "Function to decode non-ASCII characters in structured field for summary."
+ :group 'gnus-various
+ :type 'function)
+
+(defcustom gnus-unstructured-field-decoder 'identity
+ "Function to decode non-ASCII characters in unstructured field for summary."
+ :group 'gnus-various
+ :type 'function)
+
(defcustom gnus-parse-headers-hook
- (list 'gnus-decode-rfc1522)
+ (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
"*A hook called before parsing the headers."
:group 'gnus-various
:type 'hook)
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
+(defcustom gnus-alter-header-function nil
+ "Function called to allow alteration of article header structures.
+The function is called with one parameter, the article header vector,
+which it may alter in any way.")
;;; Internal variables
(defvar gnus-newsgroup-processable nil
"List of articles in the current newsgroup that can be processed.")
+(defvar gnus-newsgroup-downloadable nil
+ "List of articles in the current newsgroup that can be processed.")
+
+(defvar gnus-newsgroup-undownloaded nil
+ "List of articles in the current newsgroup that haven't been downloaded..")
+
+(defvar gnus-newsgroup-unsendable nil
+ "List of articles in the current newsgroup that won't be sent.")
+
(defvar gnus-newsgroup-bookmarks nil
"List of articles in the current newsgroup that have bookmarks.")
gnus-newsgroup-reads gnus-newsgroup-saved
gnus-newsgroup-replied gnus-newsgroup-expirable
gnus-newsgroup-processable gnus-newsgroup-killed
+ gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
+ gnus-newsgroup-unsendable
gnus-newsgroup-bookmarks gnus-newsgroup-dormant
gnus-newsgroup-headers gnus-newsgroup-threads
gnus-newsgroup-prepared gnus-summary-highlight-line-function
;; Subject simplification.
+(defun gnus-simplify-whitespace (str)
+ "Remove excessive whitespace."
+ (let ((mystr str))
+ ;; Multiple spaces.
+ (while (string-match "[ \t][ \t]+" mystr)
+ (setq mystr (concat (substring mystr 0 (match-beginning 0))
+ " "
+ (substring mystr (match-end 0)))))
+ ;; Leading spaces.
+ (when (string-match "^[ \t]+" mystr)
+ (setq mystr (substring mystr (match-end 0))))
+ ;; Trailing spaces.
+ (when (string-match "[ \t]+$" mystr)
+ (setq mystr (substring mystr 0 (match-beginning 0))))
+ mystr))
+
(defsubst gnus-simplify-subject-re (subject)
"Remove \"Re:\" from subject lines."
(if (string-match "^[Rr][Ee]: *" subject)
(defun gnus-simplify-subject-fuzzy (subject)
"Simplify a subject string fuzzily.
-See gnus-simplify-buffer-fuzzy for details."
+See `gnus-simplify-buffer-fuzzy' for details."
(save-excursion
(gnus-set-work-buffer)
(let ((case-fold-search t))
(defsubst gnus-simplify-subject-fully (subject)
"Simplify a subject string according to gnus-summary-gather-subject-limit."
(cond
+ (gnus-simplify-subject-functions
+ (gnus-map-function gnus-simplify-subject-functions subject))
((null gnus-summary-gather-subject-limit)
(gnus-simplify-subject-re subject))
((eq gnus-summary-gather-subject-limit 'fuzzy)
subject)))
(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
- "Check whether two subjects are equal. If optional argument
-simple-first is t, first argument is already simplified."
+ "Check whether two subjects are equal.
+If optional argument simple-first is t, first argument is already
+simplified."
(cond
((null simple-first)
(equal (gnus-simplify-subject-fully s1)
"\C-l" gnus-recenter
"I" gnus-summary-increase-score
"L" gnus-summary-lower-score
-
+ "\M-i" gnus-symbolic-argument
+
"V" gnus-summary-score-map
"X" gnus-uu-extract-map
"S" gnus-summary-send-map)
"u" gnus-summary-limit-to-unread
"m" gnus-summary-limit-to-marks
"v" gnus-summary-limit-to-score
+ "*" gnus-summary-limit-include-cached
"D" gnus-summary-limit-include-dormant
+ "T" gnus-summary-limit-include-thread
"d" gnus-summary-limit-exclude-dormant
"t" gnus-summary-limit-to-age
"E" gnus-summary-limit-include-expunged
"j" gnus-summary-goto-article
"g" gnus-summary-goto-subject
"l" gnus-summary-goto-last-article
- "p" gnus-summary-pop-article)
+ "o" gnus-summary-pop-article)
(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
"k" gnus-summary-kill-thread
"^" gnus-summary-refer-parent-article
"r" gnus-summary-refer-parent-article
"R" gnus-summary-refer-references
+ "T" gnus-summary-refer-thread
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
"P" gnus-summary-print-article)
["End of the article" gnus-summary-end-of-article t]
["Fetch parent of article" gnus-summary-refer-parent-article t]
["Fetch referenced articles" gnus-summary-refer-references t]
+ ["Fetch current thread" gnus-summary-refer-thread t]
["Fetch article with id..." gnus-summary-refer-article t]
["Redisplay" gnus-summary-show-article t]))
(defmacro gnus-article-mark (number)
`(cond
+ ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
+ ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark)
+ ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
(let ((gnus-replied-mark 129)
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
+ (gnus-download-mark 131)
(spec gnus-summary-line-format-spec)
thread gnus-visual pos)
(save-excursion
(gnus-set-work-buffer)
- (let ((gnus-summary-line-format-spec spec))
+ (let ((gnus-summary-line-format-spec spec)
+ (gnus-newsgroup-downloadable '((0 . t))))
(gnus-summary-insert-line
[0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
(goto-char (point-min))
pos)
(goto-char (point-min))
(push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
+ pos)
+ (goto-char (point-min))
+ (push (cons 'download
+ (and (search-forward "\203" nil t) (- (point) 2)))
pos)))
(setq gnus-summary-mark-positions pos))))
(while (and group
(null (setq result
(let ((gnus-auto-select-next nil))
- (gnus-summary-read-group-1
- group show-all no-article
- kill-buffer no-display))))
+ (or (gnus-summary-read-group-1
+ group show-all no-article
+ kill-buffer no-display)
+ (setq show-all nil)))))
(eq gnus-auto-select-next 'quietly))
(set-buffer gnus-group-buffer)
(if (not (equal group (gnus-group-group-name)))
(setq subject
(cond
;; Truncate the subject.
+ (gnus-simplify-subject-functions
+ (gnus-map-function gnus-simplify-subject-functions subject))
((numberp gnus-summary-gather-subject-limit)
(setq subject (gnus-simplify-subject-re subject))
(if (> (length subject) gnus-summary-gather-subject-limit)
(let ((headers gnus-newsgroup-headers)
(deps gnus-newsgroup-dependencies)
header references generation relations
- cthread subject child end pthread relation)
+ cthread subject child end pthread relation new-child)
;; First we create an alist of generations/relations, where
;; generations is how much we trust the relation, and the relation
;; is parent/child.
(while (search-backward ">" nil t)
(setq end (1+ (point)))
(when (search-backward "<" nil t)
- (push (list (incf generation)
- child (setq child (buffer-substring (point) end))
- subject)
- relations)))
+ (unless (string= (setq new-child (buffer-substring (point) end))
+ child)
+ (push (list (incf generation)
+ child (setq child new-child)
+ subject)
+ relations))))
(push (list (1+ generation) child nil subject) relations)
(erase-buffer)))
(kill-buffer (current-buffer)))
;; Sort over trustworthiness.
- (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
+ (setq relations (sort relations 'car-less-than-car))
(while (setq relation (pop relations))
(when (if (boundp (setq cthread (intern (cadr relation) deps)))
(unless (car (symbol-value cthread))
(delq number gnus-newsgroup-unselected)))
(push number gnus-newsgroup-ancient)))))))
+(defun gnus-build-all-threads ()
+ "Read all the headers."
+ (let ((deps gnus-newsgroup-dependencies)
+ (gnus-summary-ignore-duplicates t)
+ found header article)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (ignore-errors
+ (setq article (read (current-buffer)))
+ (setq header (gnus-nov-parse-line article deps)))
+ (when header
+ (push header gnus-newsgroup-headers)
+ (if (memq (setq article (mail-header-number header))
+ gnus-newsgroup-unselected)
+ (progn
+ (push article gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unselected
+ (delq article gnus-newsgroup-unselected)))
+ (push article gnus-newsgroup-ancient))
+ (forward-line 1)))))))
+
(defun gnus-summary-update-article-line (article header)
"Update the line for ARTICLE using HEADERS."
(let* ((id (mail-header-id header))
"Return the headers of the GENERATIONeth parent of HEADERS."
(unless generation
(setq generation 1))
- (let (references parent)
- (while (and headers (not (zerop generation)))
+ (let ((parent t)
+ references)
+ (while (and parent headers (not (zerop generation)))
(setq references (mail-header-references headers))
(when (and references
(setq parent (gnus-parent-id references))
id (gnus-parent-id (mail-header-references prev))))
last-id))
+(defun gnus-articles-in-thread (thread)
+ "Return the list of articles in THREAD."
+ (cons (mail-header-number (car thread))
+ (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread)))))
+
(defun gnus-remove-thread (id &optional dont-remove)
"Remove the thread that has ID in it."
(let ((dep gnus-newsgroup-dependencies)
;; Removed marked articles that do not exist.
(gnus-update-missing-marks
(gnus-sorted-complement fetched-articles articles))
+ ;; Let the Gnus agent mark articles as read.
+ (when gnus-agent
+ (gnus-agent-get-undownloaded-list))
;; We might want to build some more threads first.
- (and gnus-fetch-old-headers
- (eq gnus-headers-retrieved-by 'nov)
- (gnus-build-old-threads))
+ (when (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov))
+ (if (eq gnus-fetch-old-headers 'invisible)
+ (gnus-build-all-threads)
+ (gnus-build-old-threads)))
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
(gnus-group-auto-expirable-p group))
(set var (delq article (symbol-value var))))))
;; Adjust assocs.
((memq mark uncompressed)
+ (when (not (listp (cdr (symbol-value var))))
+ (set var (list (symbol-value var))))
+ (when (not (listp (cdr articles)))
+ (setq articles (list articles)))
(while articles
(when (or (not (consp (setq article (pop articles))))
(< (car article) min)
(gnus-group-make-articles-read name idlist))))
xref-hashtb)))))
+(defun gnus-compute-read-articles (group articles)
+ (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (info (nth 2 entry))
+ (active (gnus-active group))
+ ninfo)
+ (when entry
+ ;; First peel off all illegal article numbers.
+ (when active
+ (let ((ids articles)
+ id first)
+ (while (setq id (pop ids))
+ (when (and first (> id (cdr active)))
+ ;; We'll end up in this situation in one particular
+ ;; obscure situation. If you re-scan a group and get
+ ;; a new article that is cross-posted to a different
+ ;; group that has not been re-scanned, you might get
+ ;; crossposted article that has a higher number than
+ ;; Gnus believes possible. So we re-activate this
+ ;; group as well. This might mean doing the
+ ;; crossposting thingy will *increase* the number
+ ;; of articles in some groups. Tsk, tsk.
+ (setq active (or (gnus-activate-group group) active)))
+ (when (or (> id (cdr active))
+ (< id (car active)))
+ (setq articles (delq id articles))))))
+ ;; If the read list is nil, we init it.
+ (if (and active
+ (null (gnus-info-read info))
+ (> (car active) 1))
+ (setq ninfo (cons 1 (1- (car active))))
+ (setq ninfo (gnus-info-read info)))
+ ;; Then we add the read articles to the range.
+ (gnus-add-to-range
+ ninfo (setq articles (sort articles '<))))))
+
(defun gnus-group-make-articles-read (group articles)
"Update the info of GROUP to say that ARTICLES are read."
(let* ((num 0)
(info (nth 2 entry))
(active (gnus-active group))
range)
- ;; First peel off all illegal article numbers.
- (when active
- (let ((ids articles)
- id first)
- (while (setq id (pop ids))
- (when (and first (> id (cdr active)))
- ;; We'll end up in this situation in one particular
- ;; obscure situation. If you re-scan a group and get
- ;; a new article that is cross-posted to a different
- ;; group that has not been re-scanned, you might get
- ;; crossposted article that has a higher number than
- ;; Gnus believes possible. So we re-activate this
- ;; group as well. This might mean doing the
- ;; crossposting thingy will *increase* the number
- ;; of articles in some groups. Tsk, tsk.
- (setq active (or (gnus-activate-group group) active)))
- (when (or (> id (cdr active))
- (< id (car active)))
- (setq articles (delq id articles))))))
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
- (gnus-group-update-group ,group t))))
- ;; If the read list is nil, we init it.
- (and active
- (null (gnus-info-read info))
- (> (car active) 1)
- (gnus-info-set-read info (cons 1 (1- (car active)))))
- ;; Then we add the read articles to the range.
- (gnus-info-set-read
- info
- (setq range
- (gnus-add-to-range
- (gnus-info-read info) (setq articles (sort articles '<)))))
- ;; Then we have to re-compute how many unread
- ;; articles there are in this group.
- (when active
- (cond
- ((not range)
- (setq num (- (1+ (cdr active)) (car active))))
- ((not (listp (cdr range)))
- (setq num (- (cdr active) (- (1+ (cdr range))
- (car range)))))
- (t
- (while range
- (if (numberp (car range))
- (setq num (1+ num))
- (setq num (+ num (- (1+ (cdar range)) (caar range)))))
- (setq range (cdr range)))
- (setq num (- (cdr active) num))))
- ;; Update the number of unread articles.
- (setcar entry num)
- ;; Update the group buffer.
- (gnus-group-update-group group t))))
+ (when entry
+ (setq range (gnus-compute-read-articles group articles))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
+ ;; Add the read articles to the range.
+ (gnus-info-set-read info range)
+ ;; Then we have to re-compute how many unread
+ ;; articles there are in this group.
+ (when active
+ (cond
+ ((not range)
+ (setq num (- (1+ (cdr active)) (car active))))
+ ((not (listp (cdr range)))
+ (setq num (- (cdr active) (- (1+ (cdr range))
+ (car range)))))
+ (t
+ (while range
+ (if (numberp (car range))
+ (setq num (1+ num))
+ (setq num (+ num (- (1+ (cdar range)) (caar range)))))
+ (setq range (cdr range)))
+ (setq num (- (cdr active) num))))
+ ;; Update the number of unread articles.
+ (setcar entry num)
+ ;; Update the group buffer.
+ (gnus-group-update-group group t)))))
(defun gnus-methods-equal-p (m1 m2)
(let ((m1 (or m1 gnus-select-method))
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (nnheader-header-value) "(none)"))
+ ;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ (funcall
+ gnus-unstructured-field-decoder (nnheader-header-value))
+ "(none)"))
;; From.
(progn
(goto-char p)
(if (search-forward "\nfrom: " nil t)
- (nnheader-header-value) "(nobody)"))
+ ;; 1997/5/4 by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ (funcall
+ gnus-structured-field-decoder (nnheader-header-value))
+ "(nobody)"))
;; Date.
(progn
(goto-char p)
(nnheader-header-value)))))
(when (equal id ref)
(setq ref nil))
+
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header)
+ (setq id (mail-header-id header)
+ ref (gnus-parent-id (mail-header-references header))))
+
;; We do the threading while we read the headers. The
;; message-id and the last reference are both entered into
;; the same hash table. Some tippy-toeing around has to be
(let ((num (ignore-errors (read buffer))))
(if (numberp num) num 0)))
(unless (eobp)
- (forward-char 1))))
+ (search-forward "\t" eol 'move))))
(defmacro gnus-nov-skip-field ()
'(search-forward "\t" eol 'move))
(setq header
(vector
number ; number
- (gnus-nov-field) ; subject
- (gnus-nov-field) ; from
+ (funcall
+ gnus-unstructured-field-decoder (gnus-nov-field)) ; subject
+ (funcall
+ gnus-structured-field-decoder (gnus-nov-field)) ; from
(gnus-nov-field) ; date
(setq id (or (gnus-nov-field)
(nnheader-generate-fake-message-id))) ; id
(widen))
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header)
+ (setq id (mail-header-id header)
+ ref (gnus-parent-id (mail-header-references header))))
+
;; We build the thread tree.
(when (equal id ref)
;; This article refers back to itself. Naughty, naughty.
(push first unread)
(setq first (1+ first)))
;; Return the list of unread articles.
- (nreverse unread)))
+ (delq 0 (nreverse unread))))
(defun gnus-list-of-read-articles (group)
"Return a list of unread, unticked and non-dormant articles."
(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")))
+ (let ((keys '("\C-d" "\r" "\177" [delete])))
(while keys
(define-key gnus-dead-summary-mode-map
(pop keys) 'gnus-summary-wake-up-the-dead))))
(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)))))
+ (gnus-add-minor-mode
+ 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
(defun gnus-deaden-summary ()
"Make the current summary buffer into a dead summary buffer."
(when current-prefix-arg
(completing-read
"Faq dir: " (and (listp gnus-group-faq-directory)
- gnus-group-faq-directory)))))
+ (mapcar (lambda (file) (list file))
+ gnus-group-faq-directory))))))
(let (gnus-faq-buffer)
(when (setq gnus-faq-buffer
(gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
did)
(and (not pseudo)
(gnus-summary-article-pseudo-p article)
- (error "This is a pseudo-article."))
+ (error "This is a pseudo-article"))
(prog1
(save-excursion
(set-buffer gnus-summary-buffer)
(gnus-summary-goto-subject article))))
(defun gnus-summary-goto-article (article &optional all-headers force)
- "Fetch ARTICLE and display it if it exists.
+ "Fetch ARTICLE (article number or Message-ID) 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)))
+ (completing-read
+ "Article number or Message-ID: "
+ (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)
+ (if (and (stringp article)
+ (string-match "@" article))
+ (gnus-summary-refer-article article)
+ (when (stringp article)
+ (setq article (string-to-number article)))
+ (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 ()
(setq gnus-newsgroup-history
(cdr (setq to (nthcdr number gnus-newsgroup-history))))
(if to
- (gnus-summary-goto-article (car to))
+ (gnus-summary-goto-article (car to) nil t)
(error "Article history empty")))
(gnus-summary-position-point))
not marked with MARKS. MARKS can either be a string of marks or a
list of marks.
Returns how many articles were removed."
- (interactive (list (read-string "Marks: ") current-prefix-arg))
+ (interactive "sMarks: \nP")
(gnus-set-global-variables)
(prog1
(let ((data gnus-newsgroup-data)
(gnus-summary-limit articles)
(gnus-summary-position-point))))
+(defun gnus-summary-limit-include-thread (id)
+ "Display all the hidden articles that in the current thread."
+ (interactive (mail-header-id (gnus-summary-article-header)))
+ (gnus-set-global-variables)
+ (let ((articles (gnus-articles-in-thread
+ (gnus-id-to-thread (gnus-root-id id)))))
+ (prog1
+ (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
+ (gnus-summary-position-point))))
+
(defun gnus-summary-limit-include-dormant ()
"Display all the hidden articles that are marked as dormant."
(interactive)
'<)
(sort gnus-newsgroup-limit '<)))
article)
- (setq gnus-newsgroup-unreads nil)
+ (setq gnus-newsgroup-unreads gnus-newsgroup-limit)
(if all
(setq gnus-newsgroup-dormant nil
gnus-newsgroup-marked nil
(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-fetch-old-headers 'invisible)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
;; Deal with old-fetched headers and sparse threads.
(gnus-summary-article-sparse-p (mail-header-number (car thread)))
(gnus-summary-article-ancient-p
(mail-header-number (car thread))))
- (progn
- (if (<= (length (cdr thread)) 1)
- (setq gnus-newsgroup-limit
- (delq (mail-header-number (car thread))
+ (if (or (<= (length (cdr thread)) 1)
+ (eq gnus-fetch-old-headers 'invisible))
+ (setq gnus-newsgroup-limit
+ (delq (mail-header-number (car thread))
+ gnus-newsgroup-limit)
+ thread (cadr thread))
+ (when (gnus-invisible-cut-children (cdr thread))
+ (let ((th (cdr thread)))
+ (while th
+ (if (memq (mail-header-number (caar th))
gnus-newsgroup-limit)
- thread (cadr thread))
- (when (gnus-invisible-cut-children (cdr thread))
- (let ((th (cdr thread)))
- (while th
- (if (memq (mail-header-number (caar th))
- gnus-newsgroup-limit)
- (setq thread (car th)
- th nil)
- (setq th (cdr th)))))))))))
+ (setq thread (car th)
+ th nil)
+ (setq th (cdr th))))))))))
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-fetch-old-headers 'invisible)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
(let ((th threads))
(if (or gnus-inhibit-limiting
(and (null gnus-newsgroup-dormant)
(not (eq gnus-fetch-old-headers 'some))
+ (not (eq gnus-fetch-old-headers 'invisible))
(null gnus-summary-expunge-below)
(not (eq gnus-build-sparse-threads 'some))
(not (eq gnus-build-sparse-threads 'more))
(and (eq gnus-fetch-old-headers 'some)
(gnus-summary-article-ancient-p number)
(zerop children))
+ ;; If this is "fetch-old-headered" and `invisible', then
+ ;; we don't want this article.
+ (and (eq gnus-fetch-old-headers 'invisible)
+ (gnus-summary-article-ancient-p number))
;; If this is a sparsely inserted article with no children,
;; we don't want it.
(and (eq gnus-build-sparse-threads 'some)
(gnus-nocem-unwanted-article-p
(mail-header-id (car thread))))
(progn
- (setq gnus-newsgroup-reads
+ (setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
t))))
;; Nope, invisible article.
(defun gnus-summary-refer-references ()
"Fetch all articles mentioned in the References header.
-Return how many articles were fetched."
+Return the number of articles fetched."
(interactive)
(gnus-set-global-variables)
(let ((ref (mail-header-references (gnus-summary-article-header)))
(gnus-summary-position-point)
n)))
+(defun gnus-summary-refer-thread (&optional limit)
+ "Fetch all articles in the current thread.
+If LIMIT (the numerical prefix), fetch that many old headers instead
+of what's specified by the `gnus-refer-thread-limit' variable."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((id (mail-header-id (gnus-summary-article-header)))
+ (limit (if limit (prefix-numeric-value limit)
+ gnus-refer-thread-limit))
+ fmethod root)
+ ;; We want to fetch LIMIT *old* headers, but we also have to
+ ;; re-fetch all the headers in the current buffer, because many of
+ ;; them may be undisplayed. So we adjust LIMIT.
+ (when (numberp limit)
+ (incf limit (- gnus-newsgroup-end gnus-newsgroup-begin)))
+ (unless (eq gnus-fetch-old-headers 'invisible)
+ (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
+ ;; Retrieve the headers and read them in.
+ (if (eq (gnus-retrieve-headers
+ (list gnus-newsgroup-end) gnus-newsgroup-name limit)
+ 'nov)
+ (gnus-build-all-threads)
+ (error "Can't fetch thread from backends that don't support NOV"))
+ (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
+ (gnus-summary-limit-include-thread id)))
+
(defun gnus-summary-refer-article (message-id &optional arg)
"Fetch an article specified by MESSAGE-ID.
If ARG (the prefix), fetch the article using `gnus-refer-article-method'
`gnus-select-article-hook' is not called during the search."
;; We have to require this here to make sure that the following
;; dynamic binding isn't shadowed by autoloading.
- (require 'gnus-asynch)
+ (require 'gnus-async)
(let ((gnus-select-article-hook nil) ;Disable hook.
(gnus-article-display-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(gnus-use-article-prefetch nil)
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
+ (gnus-use-trees nil) ;Inhibit updating tree buffer.
(sum (current-buffer))
(found nil)
point)
(cond
;; Move the article.
((eq action 'move)
+ ;; Remove this article from future suppression.
+ (gnus-dup-unsuppress-article article)
(gnus-request-move-article
article ; Article to move
gnus-newsgroup-name ; From newsgroup
(save-excursion
(set-buffer gnus-group-buffer)
(when (gnus-group-goto-group (car to-groups) t)
- (gnus-group-get-new-news-this-group 1))
+ (gnus-group-get-new-news-this-group 1 t))
(pop to-groups)))
(gnus-kill-buffer copy-buf)
(defcustom gnus-summary-respool-default-method nil
"Default method for respooling an article.
If nil, use to the current newsgroup method."
- :type 'gnus-select-method-name
+ :type `(choice (gnus-select-method :value (nnml ""))
+ (const nil))
:group 'gnus-summary-mail)
(defun gnus-summary-respool-article (&optional n method)
(gnus-set-global-variables)
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
- (error "The current newsgroup does not support article deletion."))
+ (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)
(gnus-set-global-variables)
(when (and (not force)
(gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing."))
+ (error "The current newsgroup does not support article editing"))
;; Select article if needed.
(unless (eq (gnus-summary-article-number)
gnus-current-article)
(gnus-summary-select-article t))
+ (gnus-article-date-original)
(gnus-article-edit-article
- `(lambda ()
+ `(lambda (no-highlight)
(gnus-summary-edit-article-done
,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p) ,gnus-summary-buffer)))))
+ ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))
(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
-(defun gnus-summary-edit-article-done (&optional references read-only buffer)
+(defun gnus-summary-edit-article-done (&optional references read-only buffer
+ no-highlight)
"Make edits to the current article permanent."
(interactive)
;; Replace the article.
(not (gnus-request-replace-article
(cdr gnus-article-current) (car gnus-article-current)
(current-buffer))))
- (error "Couldn't replace article.")
+ (error "Couldn't replace article")
;; Update the summary buffer.
(if (and references
(equal (message-tokenize-header references " ")
(set-buffer (or buffer gnus-summary-buffer))
(gnus-summary-update-article (cdr gnus-article-current)))
;; Prettify the article buffer again.
- (save-excursion
- (set-buffer gnus-article-buffer)
- (run-hooks 'gnus-article-display-hook)
- (set-buffer gnus-original-article-buffer)
- (gnus-request-article
- (cdr gnus-article-current) (car gnus-article-current) (current-buffer)))
+ (unless no-highlight
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (run-hooks 'gnus-article-display-hook)
+ (set-buffer gnus-original-article-buffer)
+ (gnus-request-article
+ (cdr gnus-article-current)
+ (car gnus-article-current) (current-buffer))))
;; Prettify the summary buffer line.
(when (gnus-visual-p 'summary-highlight 'highlight)
(run-hooks 'gnus-visual-mark-article-hook))))
(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."
+If N is negative, unmark backward instead. The difference between N and
+the actual number of articles unmarked is returned."
(interactive "p")
(gnus-set-global-variables)
(gnus-summary-mark-as-processable n t))
(defun gnus-summary-set-bookmark (article)
"Set a bookmark in current article."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (gnus-summary-article-number))
(gnus-set-global-variables)
(when (or (not (get-buffer gnus-article-buffer))
(not gnus-current-article)
(defun gnus-summary-remove-bookmark (article)
"Remove the bookmark from the current article."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (gnus-summary-article-number))
(gnus-set-global-variables)
;; Remove old bookmark, if one exists.
(let ((old (assq article gnus-newsgroup-bookmarks)))
(defun gnus-summary-mark-article-as-unread (mark)
"Mark the current article quickly as unread with MARK."
(let ((article (gnus-summary-article-number)))
- (if (< article 0)
- (gnus-error 1 "Unmarkable article")
+ (if (<= article 0)
+ (gnus-error 1 "Can't mark negative article numbers")
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
(setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
(setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
- ;; Unsuppress duplicates?
- (when gnus-suppress-duplicates
- (gnus-dup-unsuppress-article article))
-
- (cond ((= mark gnus-ticked-mark)
- (push article gnus-newsgroup-marked))
- ((= mark gnus-dormant-mark)
- (push article gnus-newsgroup-dormant))
- (t
- (push article gnus-newsgroup-unreads)))
- (setq gnus-newsgroup-reads
- (delq (assq article gnus-newsgroup-reads)
- gnus-newsgroup-reads))))
+ (if (<= article 0)
+ (progn
+ (gnus-error 1 "Can't mark negative article numbers")
+ nil)
+ ;; Unsuppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-unsuppress-article article))
+
+ (cond ((= mark gnus-ticked-mark)
+ (push article gnus-newsgroup-marked))
+ ((= mark gnus-dormant-mark)
+ (push article gnus-newsgroup-dormant))
+ (t
+ (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-reads
+ (delq (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))
+ t)))
(defalias 'gnus-summary-mark-as-unread-forward
'gnus-summary-tick-article-forward)
(setq scored (cdr scored)))
(if (not headers)
(when (not no-error)
- (error "No expunged articles hidden."))
+ (error "No expunged articles hidden"))
(goto-char (point-min))
(gnus-summary-prepare-unthreaded (nreverse headers))
(goto-char (point-min))
(if (and not-mark
(not gnus-newsgroup-adaptive)
(not gnus-newsgroup-auto-expire)
- (not gnus-suppress-duplicates))
+ (not gnus-suppress-duplicates)
+ (or (not gnus-use-cache)
+ (eq gnus-use-cache 'passive)))
(progn
(when all
(setq gnus-newsgroup-marked nil
is non-nil or the Subject: of both articles are the same."
(interactive)
(unless (not (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing."))
+ (error "The current newsgroup does not support article editing"))
(unless (<= (length gnus-newsgroup-processable) 1)
- (error "No more than one article may be marked."))
+ (error "No more than one article may be marked"))
(save-window-excursion
(let ((gnus-article-buffer " *reparent*")
(current-article (gnus-summary-article-number))
(save-excursion
(if (eq (forward-line -1) 0)
(gnus-summary-article-number)
- (error "Beginning of summary buffer."))))))
+ (error "Beginning of summary buffer"))))))
(unless (not (eq current-article parent-article))
- (error "An article may not be self-referential."))
+ (error "An article may not be self-referential"))
(let ((message-id (mail-header-id
(gnus-summary-article-header parent-article))))
(unless (and message-id (not (equal message-id "")))
- (error "No message-id in desired parent."))
+ (error "No message-id in desired parent"))
(gnus-summary-select-article t t nil current-article)
(set-buffer gnus-original-article-buffer)
(let ((buf (format "%s" (buffer-string))))
(unless (gnus-request-replace-article
current-article (car gnus-article-current)
(current-buffer))
- (error "Couldn't replace article."))))
+ (error "Couldn't replace article"))))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-rethread-current)
- (gnus-message 3 "Article %d is now the child of article %d."
+ (gnus-message 3 "Article %d is now the child of article %d"
current-article parent-article)))))
(defun gnus-summary-toggle-threads (&optional arg)
(defun gnus-summary-edit-global-kill (article)
"Edit the \"global\" kill file."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (gnus-summary-article-number))
(gnus-set-global-variables)
(gnus-group-edit-global-kill article))
(funcall gnus-summary-highlight-line-function article face))))
(goto-char p)))
-(defun gnus-update-read-articles (group unread)
+(defun gnus-update-read-articles (group unread &optional compute)
"Update the list of read articles in GROUP."
(let* ((active (or gnus-newsgroup-active (gnus-active group)))
(entry (gnus-gethash group gnus-newsrc-hashtb))
(setq unread (cdr unread)))
(when (<= prev (cdr active))
(push (cons prev (cdr active)) read))
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
- (gnus-group-update-group ,group t))))
- ;; Enter this list into the group info.
- (gnus-info-set-read
- info (if (> (length read) 1) (nreverse read) read))
- ;; Set the number of unread articles in gnus-newsrc-hashtb.
- (gnus-get-unread-articles-in-group info (gnus-active group))
- t)))
+ (if compute
+ (if (> (length read) 1) (nreverse read) read)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
+ ;; Enter this list into the group info.
+ (gnus-info-set-read
+ info (if (> (length read) 1) (nreverse read) read))
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+ t))))
(defun gnus-offer-save-summaries ()
"Offer to save all active summary buffers."
projects / gnus / blobdiff