;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
:type '(choice number
(sexp :menu-tag "other" t)))
+(defcustom gnus-refer-thread-use-nnir nil
+ "*Use nnir to search an entire server when referring threads. A
+nil value will only search for thread-related articles in the
+current group."
+ :version "24.1"
+ :group 'gnus-thread
+ :type 'boolean)
+
(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
This variable can either be the symbols `first' (place point on the
first subject), `unread' (place point on the subject line of the first
unread article), `best' (place point on the subject line of the
-higest-scored article), `unseen' (place point on the subject line of
+highest-scored article), `unseen' (place point on the subject line of
the first unseen article), `unseen-or-unread' (place point on the subject
line of the first unseen article or, if all articles have been seen, on the
subject line of the first unread article), or a function to be called to
(const unread)
(const first)
(const unseen)
- (const unseen-or-unread)))
+ (const unseen-or-unread)
+ (function :tag "Function to call")))
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
:group 'gnus-summary-maneuvering
:type 'boolean)
-(defcustom gnus-auto-center-summary 2
+(defcustom gnus-auto-center-summary
+ (max (or (bound-and-true-p scroll-margin) 0) 2)
"*If non-nil, always center the current summary buffer.
In particular, if `vertical' do only vertical recentering. If non-nil
and non-`vertical', do both horizontal and vertical recentering."
:type 'boolean
:group 'gnus-summary-marks)
-(defcustom gnus-propagate-marks nil
- "If non-nil, Gnus will store and retrieve marks from the backends.
-This means that marks will be stored both in .newsrc.eld and in
-the backend, and will slow operation down somewhat."
- :type 'boolean
- :group 'gnus-summary-marks)
-
(defcustom gnus-alter-articles-to-read-function nil
"Function to be called to alter the list of articles to be selected."
:type '(choice (const nil) function)
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
(?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
(?L gnus-tmp-lines ?s)
- (?Z (or ,(gnus-macroexpand-all
- '(nnir-article-rsv (mail-header-number gnus-tmp-header)))
+ (?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header))
0) ?d)
- (?G (or ,(gnus-macroexpand-all
- '(nnir-article-group (mail-header-number gnus-tmp-header)))
+ (?G (or (nnir-article-group (mail-header-number gnus-tmp-header))
"") ?s)
- (?g (or ,(gnus-macroexpand-all
- '(gnus-group-short-name
- (nnir-article-group (mail-header-number gnus-tmp-header))))
+ (?g (or (gnus-group-short-name
+ (nnir-article-group (mail-header-number gnus-tmp-header)))
"") ?s)
(?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
(defvar gnus-newsgroup-forwarded nil
"List of articles that have been forwarded in the current newsgroup.")
-(defvar gnus-newsgroup-recent nil
- "List of articles that have are recent in the current newsgroup.")
-
(defvar gnus-newsgroup-expirable nil
"Sorted list of articles in the current newsgroup that can be expired.")
(defvar gnus-newsgroup-seen nil
"Range of seen articles in the current newsgroup.")
+(defvar gnus-newsgroup-unexist nil
+ "Range of unexistent articles in the current newsgroup.")
+
(defvar gnus-newsgroup-articles nil
"List of articles in the current newsgroup.")
gnus-newsgroup-saved
gnus-newsgroup-replied
gnus-newsgroup-forwarded
- gnus-newsgroup-recent
gnus-newsgroup-expirable
gnus-newsgroup-killed
gnus-newsgroup-unseen
gnus-newsgroup-seen
+ gnus-newsgroup-unexist
gnus-newsgroup-cached
gnus-newsgroup-downloadable
gnus-newsgroup-undownloaded
This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
-\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+\(REGEXP . FUNCTION), FUNCTION will be applied only to the newsgroups
whose names match REGEXP.
For example:
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
[tab] gnus-summary-widget-forward
+ [backtab] gnus-summary-widget-backward
"t" gnus-summary-toggle-header
"g" gnus-summary-show-article
"l" gnus-summary-goto-last-article
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
[tab] gnus-summary-widget-forward
+ [backtab] gnus-summary-widget-backward
"P" gnus-summary-print-article
"S" gnus-sticky-article
"M" gnus-mailing-list-insinuate
["Unshar and save" gnus-uu-decode-unshar-and-save t]
["Save" gnus-uu-decode-save t]
["Binhex" gnus-uu-decode-binhex t]
- ["Postscript" gnus-uu-decode-postscript t]
+ ["PostScript" gnus-uu-decode-postscript t]
["All MIME parts" gnus-summary-save-parts t])
("Cache"
["Enter article" gnus-cache-enter-article t]
'gnus-summary-tool-bar-retro)
"Specifies the Gnus summary tool bar.
-It can be either a list or a symbol refering to a list. See
+It can be either a list or a symbol referring to a list. See
`gmm-tool-bar-from-list' for the format of the list. The
default key map is `gnus-summary-mode-map'.
'gnus-summary-mode-map)))
(when map
;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
- ;; uses it's value.
+ ;; uses its value.
(setq gnus-summary-tool-bar-map map))))
(set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
-(defun gnus-score-set-default (var value)
- "A version of set that updates the GNU Emacs menu-bar."
- (set var value)
- ;; It is the message that forces the active status to be updated.
- (message ""))
-
(defun gnus-make-score-map (type)
"Make a summary score map of type TYPE."
(if t
(declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ())
(defvar bookmark-make-record-function)
\f
+(defvar bidi-paragraph-direction)
(defun gnus-summary-mode (&optional group)
"Major mode for reading articles.
(setq buffer-read-only t ;Disable modification
show-trailing-whitespace nil)
(setq truncate-lines t)
+ ;; Force paragraph direction to be left-to-right. Don't make it
+ ;; bound globally in old Emacsen and XEmacsen.
+ (set (make-local-variable 'bidi-paragraph-direction) 'left-to-right)
(add-to-invisibility-spec '(gnus-sum . t))
(gnus-summary-set-display-table)
(gnus-set-default-directory)
"Say whether this article is a sparse article or not."
`(memq ,article gnus-newsgroup-ancient))
-(defun gnus-article-parent-p (number)
- "Say whether this article is a parent or not."
- (let ((data (gnus-data-find-list number)))
- (and (cdr data) ; There has to be an article after...
- (< (gnus-data-level (car data)) ; And it has to have a higher level.
- (gnus-data-level (nth 1 data))))))
-
(defun gnus-article-children (number)
"Return a list of all children to NUMBER."
(let* ((data (gnus-data-find-list number))
"Say whether this article is intangible or not."
'(get-text-property (point) 'gnus-intangible))
-(defun gnus-article-read-p (article)
- "Say whether ARTICLE is read or not."
- (not (or (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-spam-marked)
- (memq article gnus-newsgroup-unreads)
- (memq article gnus-newsgroup-unselected)
- (memq article gnus-newsgroup-dormant))))
-
;; Some summary mode macros.
(defmacro gnus-summary-article-number ()
(current-buffer))))))
(defun gnus-summary-setup-buffer (group)
- "Initialize summary buffer."
+ "Initialize summary buffer.
+If the setup was successful, non-nil is returned."
(let ((buffer (gnus-summary-buffer-name group))
(dead-name (concat "*Dead Summary "
(gnus-group-decoded-name group) "*")))
(push (eval (car locals)) vlist))
(setq locals (cdr locals)))
(setq vlist (nreverse vlist)))
- (with-current-buffer gnus-group-buffer
+ (with-temp-buffer
(setq gnus-newsgroup-name name
gnus-newsgroup-marked marked
gnus-newsgroup-spam-marked spam
gnus-newsgroup-name)) 'nntp)
(gnus-group-real-name gnus-newsgroup-name))))
(concat gnus-summary-newsgroup-prefix newsgroups)))))
- (inline (gnus-summary-extract-address-component gnus-tmp-from)))))
+ (gnus-string-mark-left-to-right
+ (inline
+ (gnus-summary-extract-address-component gnus-tmp-from))))))
(defun gnus-summary-insert-line (gnus-tmp-header
gnus-tmp-level gnus-tmp-current
gnus-forwarded-mark)
((memq gnus-tmp-current gnus-newsgroup-saved)
gnus-saved-mark)
- ((memq gnus-tmp-number gnus-newsgroup-recent)
- gnus-recent-mark)
((memq gnus-tmp-number gnus-newsgroup-unseen)
gnus-unseen-mark)
(t gnus-no-mark)))
"Start reading news in newsgroup GROUP.
If SHOW-ALL is non-nil, already read articles are also listed.
If NO-ARTICLE is non-nil, no article is selected initially.
-If NO-DISPLAY, don't generate a summary buffer."
+If NO-DISPLAY, don't generate the summary buffer contents.
+If KILL-BUFFER, it should be a buffer that's killed once the new
+summary buffer has been generated.
+If BACKWARD, move point to the previous group in the group buffer
+If SELECT-ARTICLES, only select those articles from GROUP."
(let (result)
(while (and group
(null (setq result
;; (when (and (not (gnus-group-native-p group))
;; (not (gnus-gethash group gnus-newsrc-hashtb)))
;; (error "Dead non-native groups can't be entered"))
- (gnus-message 5 "Retrieving newsgroup: %s..."
+ (gnus-message 7 "Retrieving newsgroup: %s..."
(gnus-group-decoded-name group))
(let* ((new-group (gnus-summary-setup-buffer group))
(quit-config (gnus-group-quit-config group))
(setq gnus-newsgroup-prepared t)
(gnus-run-hooks 'gnus-summary-prepared-hook)
(unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group))
+ (gnus-group-update-group group nil t))
t)))))
(defun gnus-summary-auto-select-subject ()
result))
(defun gnus-sort-gathered-threads (threads)
- "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
+ "Sort subthreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
(let ((result threads))
(while threads
(when (stringp (caar threads))
(car headers))))
(defun gnus-parent-headers (in-headers &optional generation)
- "Return the headers of the GENERATIONeth parent of HEADERS."
+ "Return the headers of the GENERATIONth parent of HEADERS."
(unless generation
(setq generation 1))
(let ((parent t)
gnus-forwarded-mark)
((memq number gnus-newsgroup-saved)
gnus-saved-mark)
- ((memq number gnus-newsgroup-recent)
- gnus-recent-mark)
((memq number gnus-newsgroup-unseen)
gnus-unseen-mark)
(t gnus-no-mark))
(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
"Fetch headers of ARTICLES."
(let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
- (gnus-message 5 "Fetching headers for %s..." name)
+ (gnus-message 7 "Fetching headers for %s..." name)
(prog1
(if (eq 'nov
(setq gnus-headers-retrieved-by
(gnus-get-newsgroup-headers-xover
articles force-new dependencies gnus-newsgroup-name t)
(gnus-get-newsgroup-headers dependencies force-new))
- (gnus-message 5 "Fetching headers for %s...done" name))))
+ (gnus-message 7 "Fetching headers for %s...done" name))))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
;; Init the dependencies hash table.
(setq gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles)))
- (gnus-set-global-variables)
+ (if (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-set-global-variables)
+ (set-default 'gnus-newsgroup-name gnus-newsgroup-name))
;; Retrieve the headers and read them in.
(setq gnus-newsgroup-headers (gnus-fetch-headers articles))
(memq article gnus-newsgroup-forwarded))
((eq type 'seen)
(not (memq article gnus-newsgroup-unseen)))
- ((eq type 'recent)
- (memq article gnus-newsgroup-recent))
(t t))))
(defun gnus-articles-to-read (group &optional read-all)
"Find out what articles the user wants to read."
(let* ((only-read-p t)
(articles
+ (gnus-list-range-difference
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
(setq only-read-p nil)
(gnus-sorted-nunion
(gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
- gnus-newsgroup-unreads)))
+ gnus-newsgroup-unreads))
+ (cdr (assq 'unexist (gnus-info-marks (gnus-get-info group))))))
(scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
(scored (length scored-list))
(number (length articles))
(read-string
(if only-read-p
(format
- "How many articles from %s (available %d, default %d): "
- (gnus-group-decoded-name
- (gnus-group-real-name gnus-newsgroup-name))
- number default)
- (format
- "How many articles from %s (%d available): "
+ "How many articles from %s (available %d, default %d): "
(gnus-group-decoded-name
(gnus-group-real-name gnus-newsgroup-name))
- default))
+ number default)
+ (format
+ "How many articles from %s (%d default): "
+ (gnus-group-decoded-name
+ (gnus-group-real-name gnus-newsgroup-name))
+ default))
nil
nil
(number-to-string default))))
(setq articles (cdr articles)))
out))
-(defun gnus-uncompress-marks (marks)
- "Uncompress the mark ranges in MARKS."
- (let ((uncompressed '(score bookmark))
- out)
- (while marks
- (if (memq (caar marks) uncompressed)
- (push (car marks) out)
- (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
- (setq marks (cdr marks)))
- out))
-
(defun gnus-article-mark-to-type (mark)
"Return the type of MARK."
(or (cadr (assq mark gnus-article-special-mark-lists))
(setq mark (car marks)
mark-type (gnus-article-mark-to-type mark)
var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
-
;; We set the variable according to the type of the marks list,
;; and then adjust the marks to a subset of the active articles.
(cond
(and (numberp (car articles))
(> min (car articles)))))
(pop articles))
- (set var articles))))))))
+ (set var articles))
+ ((eq mark 'unexist)
+ (set var (cdr marks)))))))))
(defun gnus-update-missing-marks (missing)
"Go through the list of MISSING articles and remove them from the mark lists."
(entry (gnus-group-entry group))
(info (nth 2 entry))
(active (gnus-active group))
+ (set-marks
+ (gnus-method-option-p
+ (gnus-find-method-for-group group)
+ 'server-marks))
range)
(if (not entry)
;; Group that Gnus doesn't know exists, but still allow the
;; backend to set marks.
- (gnus-request-set-mark
- group (list (list (gnus-compress-sequence (sort articles #'<))
- 'add '(read))))
+ (when set-marks
+ (gnus-request-set-mark
+ group (list (list (gnus-compress-sequence (sort articles #'<))
+ 'add '(read)))))
;; Normal, subscribed groups.
(setq range (gnus-compute-read-articles group articles))
(with-current-buffer gnus-group-buffer
(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-request-set-mark ,group (list (list ',range 'del '(read))))
+ (when ,set-marks
+ (gnus-request-set-mark
+ ,group (list (list ',range 'del '(read)))))
(gnus-group-update-group ,group t))))
;; Add the read articles to the range.
(gnus-info-set-read info range)
- (gnus-request-set-mark group (list (list range 'add '(read))))
+ (when set-marks
+ (gnus-request-set-mark group (list (list range 'add '(read)))))
;; Then we have to re-compute how many unread
;; articles there are in this group.
(when active
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
"Find article ID and insert the summary line for that article.
OLD-HEADER can either be a header or a line number to insert
-the subject line on."
+the subject line on.
+If USE-OLD-HEADER is non-nil, then OLD-HEADER should be a header,
+and OLD-HEADER will be used when the summary line is inserted,
+too, instead of trying to fetch new headers."
(let* ((line (and (numberp old-header) old-header))
(old-header (and (vectorp old-header) old-header))
(header (cond ((and old-header use-old-header)
;; 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.
- (when (> number gnus-newsgroup-end)
+ (unless (and gnus-newsgroup-end (< number gnus-newsgroup-end))
(setq gnus-newsgroup-end number))
- (when (< number gnus-newsgroup-begin)
+ (unless (and gnus-newsgroup-begin (> number gnus-newsgroup-begin))
(setq gnus-newsgroup-begin number))
(setq gnus-newsgroup-unselected
(delq number gnus-newsgroup-unselected)))
(defun gnus-summary-find-for-reselect ()
"Return the number of an article to stay on across a reselect.
The current article is considered, then following articles, then previous
-articles. An article is sought which is not cancelled and isn't a temporary
+articles. An article is sought which is not canceled and isn't a temporary
insertion from another group. If there's no such then return a dummy 0."
(let (found)
(dolist (rev '(nil t))
t)))
(unless (listp (cdr gnus-newsgroup-killed))
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
- (let ((headers gnus-newsgroup-headers))
+ (let ((headers gnus-newsgroup-headers)
+ (ephemeral-p (gnus-ephemeral-group-p group))
+ info)
+ (unless ephemeral-p
+ (setq info (copy-sequence (gnus-get-info group))
+ info (delq (gnus-info-params info) info)))
;; Set the new ranges of read articles.
(with-current-buffer gnus-group-buffer
(gnus-undo-force-boundary))
(gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
;; Do not switch windows but change the buffer to work.
(set-buffer gnus-group-buffer)
- (unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group)))))))
+ (unless ephemeral-p
+ (gnus-group-update-group
+ group nil
+ (equal info
+ (setq info (copy-sequence (gnus-get-info group))
+ info (delq (gnus-info-params info) info))))))))))
(defun gnus-summary-save-newsrc (&optional force)
"Save the current number of read/marked articles in the dribble buffer.
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
(gnus-group-is-exiting-p t)
(article-buffer gnus-article-buffer)
+ (original-article-buffer gnus-original-article-buffer)
(mode major-mode)
(group-point nil)
(buf (current-buffer))
(gnus-summary-update-info))
(gnus-close-group group)
;; Make sure where we were, and go to next newsgroup.
- (set-buffer gnus-group-buffer)
+ (when (buffer-live-p (get-buffer gnus-group-buffer))
+ (set-buffer gnus-group-buffer))
(unless quit-config
(gnus-group-jump-to-group group))
(gnus-run-hooks 'gnus-summary-exit-hook)
(gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
- (set-buffer gnus-group-buffer)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
(if quit-config
(gnus-handle-ephemeral-exit quit-config)
(goto-char group-point)
(unless (eq major-mode 'gnus-sticky-article-mode)
(gnus-kill-buffer article-buffer)
(setq gnus-article-current nil))))
- (gnus-kill-buffer gnus-original-article-buffer))
+ (gnus-kill-buffer original-article-buffer))
;; Clear the current group name.
(unless quit-config
(run-hooks 'gnus-summary-prepare-exit-hook)
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
+ (gnus-article-stop-animations)
+ (gnus-stop-downloads)
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
(gnus-kill-buffer gnus-original-article-buffer)
(setq gnus-article-current nil))
;; Return to the group buffer.
- (gnus-configure-windows 'group 'force)
(if (not gnus-kill-summary-on-exit)
- (gnus-deaden-summary)
+ (progn
+ (gnus-deaden-summary)
+ (gnus-configure-windows 'group 'force))
+ (gnus-configure-windows 'group 'force)
(gnus-close-group group)
(gnus-kill-buffer gnus-summary-buffer))
(unless gnus-single-article-buffer
;; Clear the current group name.
(setq gnus-newsgroup-name nil)
(unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group))
+ (gnus-group-update-group group nil t))
(when (equal (gnus-group-group-name) group)
(gnus-group-next-unread-group 1))
(when quit-config
(defun gnus-handle-ephemeral-exit (quit-config)
"Handle movement when leaving an ephemeral group.
The state which existed when entering the ephemeral is reset."
- (if (not (buffer-name (car quit-config)))
- (gnus-configure-windows 'group 'force)
+ (if (not (buffer-live-p (car quit-config)))
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-configure-windows 'group 'force))
(set-buffer (car quit-config))
+ (unless (eq (cdr quit-config) 'group)
+ (setq gnus-current-select-method
+ (gnus-find-method-for-group gnus-newsgroup-name)))
(cond ((eq major-mode 'gnus-summary-mode)
(gnus-set-global-variables))
((eq major-mode 'gnus-article-mode)
gnus-buttonized-mime-types)))
(gnus-summary-select-article nil 'force)))
-(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.
"Limit the summary buffer to articles that have authors that match a regexp.
If NOT-MATCHING, excluding articles that have authors that match a regexp."
(interactive
- (list (read-string (if current-prefix-arg
- "Exclude author (regexp): "
- "Limit to author (regexp): "))
+ (list (let* ((header (gnus-summary-article-header))
+ (default (and header (car (mail-header-parse-address
+ (mail-header-from header))))))
+ (read-string (concat (if current-prefix-arg
+ "Exclude author (regexp"
+ "Limit to author (regexp")
+ (if default
+ (concat ", default \"" default "\"): ")
+ "): "))
+ nil nil
+ default))
current-prefix-arg))
(gnus-summary-limit-to-subject from "from" not-matching))
'list gnus-newsgroup-headers
(gnus-fetch-headers articles nil t)
'gnus-article-sort-by-number))
+ (setq gnus-newsgroup-articles
+ (gnus-sorted-nunion gnus-newsgroup-articles articles))
(gnus-summary-limit (append articles gnus-newsgroup-limit))))
(defun gnus-summary-limit-exclude-dormant ()
(gnus-summary-position-point)
n)))
+(defun gnus-delete-duplicate-headers (headers)
+ ;; First remove leading duplicates.
+ (while (and (> (length headers) 1)
+ (= (mail-header-number (car headers))
+ (mail-header-number (cadr headers))))
+ (pop headers))
+ ;; Then the rest.
+ (let ((result headers))
+ (while (> (length headers) 1)
+ (if (= (mail-header-number (car headers))
+ (mail-header-number (cadr headers)))
+ (setcdr headers (cddr headers))
+ (pop headers)))
+ result))
+
(defun gnus-summary-refer-thread (&optional limit)
- "Fetch all articles in the current thread.
-If no backend-specific 'request-thread function is available
-fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil
-fetch what's specified by the `gnus-refer-thread-limit'
-variable."
+ "Fetch all articles in the current thread. For backends that
+know how to search for threads (currently only 'nnimap) a
+non-numeric prefix arg will use nnir to search the entire
+server; without a prefix arg only the current group is
+searched. If the variable `gnus-refer-thread-use-nnir' is
+non-nil the prefix arg has the reverse meaning. If no
+backend-specific 'request-thread function is available fetch
+LIMIT (the numerical prefix) old headers. If LIMIT is
+non-numeric or nil fetch the number specified by the
+`gnus-refer-thread-limit' variable."
(interactive "P")
(gnus-warp-to-article)
(let* ((header (gnus-summary-article-header))
(gnus-inhibit-demon t)
(gnus-summary-ignore-duplicates t)
(gnus-read-all-available-headers t)
- (limit (if limit (prefix-numeric-value limit)
- gnus-refer-thread-limit)))
- (setq gnus-newsgroup-headers
- (gnus-merge
- 'list gnus-newsgroup-headers
- (if (gnus-check-backend-function
- 'request-thread gnus-newsgroup-name)
- (gnus-request-thread header)
- (let* ((last (if (numberp limit)
- (min (+ (mail-header-number header)
- limit)
- gnus-newsgroup-highest)
- gnus-newsgroup-highest))
- (subject (gnus-simplify-subject
- (mail-header-subject header)))
- (refs (split-string (or (mail-header-references header)
- "")))
- (gnus-parse-headers-hook
- (lambda () (goto-char (point-min))
- (keep-lines
- (regexp-opt (append refs (list id subject)))))))
- (gnus-fetch-headers (list last) (if (numberp limit)
- (* 2 limit) limit) t)))
- 'gnus-article-sort-by-number))
- (gnus-summary-limit-include-thread id)))
+ (gnus-refer-thread-use-nnir
+ (if (and (not (null limit)) (listp limit))
+ (not gnus-refer-thread-use-nnir) gnus-refer-thread-use-nnir))
+ (new-headers
+ (if (gnus-check-backend-function
+ 'request-thread gnus-newsgroup-name)
+ (gnus-request-thread header gnus-newsgroup-name)
+ (let* ((limit (if (numberp limit) (prefix-numeric-value limit)
+ gnus-refer-thread-limit))
+ (last (if (numberp limit)
+ (min (+ (mail-header-number header)
+ limit)
+ gnus-newsgroup-highest)
+ gnus-newsgroup-highest))
+ (subject (gnus-simplify-subject
+ (mail-header-subject header)))
+ (refs (split-string (or (mail-header-references header)
+ "")))
+ (gnus-parse-headers-hook
+ `(lambda () (goto-char (point-min))
+ (keep-lines
+ (regexp-opt ',(append refs (list id subject)))))))
+ (gnus-fetch-headers (list last) (if (numberp limit)
+ (* 2 limit) limit) t))))
+ article-ids)
+ (when (listp new-headers)
+ (dolist (header new-headers)
+ (push (mail-header-number header) article-ids)
+ (when (member (mail-header-number header) gnus-newsgroup-unselected)
+ (push (mail-header-number header) gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unselected
+ (delete (mail-header-number header)
+ gnus-newsgroup-unselected))))
+ (setq gnus-newsgroup-headers
+ (gnus-delete-duplicate-headers
+ (gnus-merge
+ 'list gnus-newsgroup-headers new-headers
+ 'gnus-article-sort-by-number)))
+ (setq gnus-newsgroup-articles
+ (gnus-sorted-nunion gnus-newsgroup-articles (nreverse article-ids)))
+ (gnus-summary-limit-include-thread id)))
+ (gnus-summary-show-thread))
(defun gnus-summary-refer-article (message-id)
"Fetch an article specified by MESSAGE-ID."
(interactive "sMessage-ID: ")
+ (gnus-warp-to-article)
(when (and (stringp message-id)
(not (zerop (length message-id))))
(setq message-id (gnus-replace-in-string message-id " " ""))
(dolist (method gnus-refer-article-method)
(push (if (eq 'current method)
gnus-current-select-method
- method)
+ (if (eq 'nnir (car method))
+ (list
+ 'nnir
+ (or (cadr method)
+ (gnus-method-to-server gnus-current-select-method)))
+ method))
out))
(nreverse out)))
;; One single select method.
(select-window (gnus-get-buffer-window gnus-article-buffer))
(widget-forward arg))
+(defun gnus-summary-widget-backward (arg)
+ "Move point to the previous field or button in the article.
+With optional ARG, move across that many fields."
+ (interactive "p")
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (select-window (gnus-get-buffer-window gnus-article-buffer))
+ (unless (widget-at (point))
+ (goto-char (point-max)))
+ (widget-backward arg))
+
(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."
(gnus-summary-update-secondary-mark (cdr gnus-article-current))))))
((not arg)
;; Select the article the normal way.
- (gnus-summary-select-article nil 'force))
+ (if (eq mm-text-html-renderer 'shr)
+ (progn
+ (require 'shr)
+ (let ((shr-ignore-cache t))
+ (gnus-summary-select-article nil 'force)))
+ (gnus-summary-select-article nil 'force)))
((equal arg '(16))
;; C-u C-u g
(let ((gnus-inhibit-article-treatments t))
;; Destroy any MIME parts.
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
+ (gnus-article-stop-animations)
+ (gnus-stop-downloads)
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
(gnus-add-marked-articles
to-group 'expire (list to-article) info))
- (when to-marks
+ (when (and to-marks
+ (gnus-method-option-p
+ (gnus-find-method-for-group to-group)
+ 'server-marks))
(gnus-request-set-mark
to-group (list (list (list to-article) 'add to-marks)))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string (gnus-get-info to-group))
- ")"))))
+ ")")
+ (concat "^(gnus-group-set-info '(\""
+ (regexp-quote to-group) "\""))))
;; Update the Xref header in this article to point to
;; the new crossposted article we have just created.
'request-expire-articles gnus-newsgroup-name))
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
- (expirable (if total
- (progn
- ;; We need to update the info for
- ;; this group for `gnus-list-of-read-articles'
- ;; to give us the right answer.
- (gnus-run-hooks 'gnus-exit-group-hook)
- (gnus-summary-update-info)
- (gnus-list-of-read-articles gnus-newsgroup-name))
- (setq gnus-newsgroup-expirable
- (sort gnus-newsgroup-expirable '<))))
+ (expirable
+ (gnus-list-range-difference
+ (if total
+ (progn
+ ;; We need to update the info for
+ ;; this group for `gnus-list-of-read-articles'
+ ;; to give us the right answer.
+ (gnus-run-hooks 'gnus-exit-group-hook)
+ (gnus-summary-update-info)
+ (gnus-list-of-read-articles gnus-newsgroup-name))
+ (setq gnus-newsgroup-expirable
+ (sort gnus-newsgroup-expirable '<)))
+ gnus-newsgroup-unexist))
(expiry-wait (if now 'immediate
(gnus-group-find-parameter
gnus-newsgroup-name 'expiry-wait)))
;; There are expirable articles in this group, so we run them
;; through the expiry process.
(gnus-message 6 "Expiring articles...")
- (unless (gnus-check-group gnus-newsgroup-name)
- (error "Can't open server for %s" gnus-newsgroup-name))
- ;; The list of articles that weren't expired is returned.
- (save-excursion
- (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)))
- (unless 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))
- (dolist (article expirable)
- (when (and (not (memq article es))
- (gnus-data-find article))
- (gnus-summary-mark-article article gnus-canceled-mark)
- (run-hook-with-args 'gnus-summary-article-expire-hook
- 'delete
- (gnus-data-header
- (assoc article (gnus-data-list nil)))
- gnus-newsgroup-name
- nil
- nil))))))
+ (when (gnus-check-group gnus-newsgroup-name)
+ ;; The list of articles that weren't expired is returned.
+ (save-excursion
+ (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)))
+ (unless 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))
+ (dolist (article expirable)
+ (when (and (not (memq article es))
+ (gnus-data-find article))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (run-hook-with-args 'gnus-summary-article-expire-hook
+ 'delete
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ nil
+ nil)))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
(setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
(setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
(setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
+ (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
(cond ((= mark gnus-ticked-mark)
(setq gnus-newsgroup-marked
(gnus-add-to-sorted-list gnus-newsgroup-marked
gnus-forwarded-mark)
((memq article gnus-newsgroup-saved)
gnus-saved-mark)
- ((memq article gnus-newsgroup-recent)
- gnus-recent-mark)
((memq article gnus-newsgroup-unseen)
gnus-unseen-mark)
(t gnus-no-mark))
(beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
(eoi (when end
(if (fboundp 'next-single-char-property-change)
+ ;; Note: XEmacs version of n-s-c-p-c may return nil
(or (next-single-char-property-change end 'invisible)
(point-max))
(while (progn
;; This is a pseudo-article.
(if (assq 'name header)
(gnus-copy-file (cdr (assq 'name header)))
- (gnus-message 1 "Article %d is unsaveable" article))
+ (gnus-message 1 "Article %d is unsavable" article))
;; This is a real article.
(save-window-excursion
(gnus-summary-select-article decode decode nil article)
(not (setq header (car (gnus-get-newsgroup-headers nil t)))))
() ; Malformed head.
(unless (gnus-summary-article-sparse-p (mail-header-number header))
+ (when (and (bound-and-true-p gnus-registry-enabled)
+ (not (gnus-ephemeral-group-p (car where))))
+ (gnus-registry-handle-action
+ (mail-header-id header) nil
+ (gnus-group-prefixed-name (car where) gnus-override-method)
+ (mail-header-subject header)
+ (mail-header-from header)))
(when (and (stringp id)
(or
(not (string= (gnus-group-real-name group)
(save-excursion
(let (setmarkundo)
;; Propagate the read marks to the backend.
- (when (and (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group group)
- 'server-marks))
+ (when (and (gnus-method-option-p
+ (gnus-find-method-for-group group)
+ 'server-marks)
(gnus-check-backend-function 'request-set-mark group))
(let ((del (gnus-remove-from-range (gnus-info-read info) read))
(add (gnus-remove-from-range read (gnus-info-read info))))
;; Go through all these summary buffers and offer to save them.
(when buffers
(save-excursion
- (map-y-or-n-p
- "Update summary buffer %s? "
- (lambda (buf)
- (switch-to-buffer buf)
- (gnus-summary-exit))
- buffers)))))
+ (if (eq gnus-interactive-exit 'quiet)
+ (dolist (buffer buffers)
+ (switch-to-buffer buffer)
+ (gnus-summary-exit))
+ (map-y-or-n-p
+ "Update summary buffer %s? "
+ (lambda (buf)
+ (switch-to-buffer buf)
+ (gnus-summary-exit))
+ buffers))))))
(defun gnus-summary-setup-default-charset ()
"Setup newsgroup default charset."
gnus-newsgroup-headers
(gnus-fetch-headers articles)
'gnus-article-sort-by-number))
+ (setq gnus-newsgroup-articles
+ (gnus-sorted-nunion gnus-newsgroup-articles articles))
;; Suppress duplicates?
(when gnus-suppress-duplicates
(gnus-dup-suppress-articles))
;; Some nntp servers lie about their active range. When
;; this happens, the active range can be in the millions.
;; Use a compressed range to avoid creating a huge list.
- (gnus-range-difference (list gnus-newsgroup-active) old))
+ (gnus-range-difference
+ (gnus-range-difference (list gnus-newsgroup-active) old)
+ gnus-newsgroup-unexist))
(setq len (gnus-range-length older))
(cond
((null older) nil)
(gnus-group-decoded-name gnus-newsgroup-name)
(if initial "max" "default")
len)
- (if initial
- (cons (number-to-string initial)
- 0)))))
+ nil nil
+ (and initial
+ (number-to-string initial)))))
(unless (string-match "^[ \t]*$" input)
(setq all (string-to-number input))
(if (< all len)
(defun gnus-summary-insert-new-articles ()
"Insert all new articles in this group."
(interactive)
- (prog1
- (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
- (old-high gnus-newsgroup-highest)
- (nnmail-fetched-sources (list t))
- i new)
- (setq gnus-newsgroup-active
- (gnus-copy-sequence
- (gnus-activate-group gnus-newsgroup-name 'scan)))
- (setq i (cdr gnus-newsgroup-active)
- gnus-newsgroup-highest i)
- (while (> i old-high)
- (push i new)
- (decf i))
- (if (not new)
- (message "No gnus is bad news")
- (gnus-summary-insert-articles new)
- (setq gnus-newsgroup-unreads
- (gnus-sorted-nunion gnus-newsgroup-unreads new))
- (gnus-summary-limit (gnus-sorted-nunion old new))))
- (gnus-summary-position-point)))
+ (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
+ (old-high gnus-newsgroup-highest)
+ (nnmail-fetched-sources (list t))
+ (new-active (gnus-activate-group gnus-newsgroup-name 'scan))
+ i new)
+ (unless new-active
+ (error "Couldn't fetch new data"))
+ (setq gnus-newsgroup-active (gnus-copy-sequence new-active))
+ (setq i (cdr gnus-newsgroup-active)
+ gnus-newsgroup-highest i)
+ (while (> i old-high)
+ (push i new)
+ (decf i))
+ (if (not new)
+ (message "No gnus is bad news")
+ (gnus-summary-insert-articles new)
+ (setq gnus-newsgroup-unreads
+ (gnus-sorted-nunion gnus-newsgroup-unreads new))
+ (gnus-summary-limit (gnus-sorted-nunion old new))))
+ (gnus-summary-position-point))
;;; Bookmark support for Gnus.
(declare-function bookmark-make-record-default
projects / gnus / blobdiff