;;; 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."
+ :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.
'mail-decode-encoded-address-string
"Function used to decode addresses with encoded words.")
-(defcustom gnus-extra-headers '(To Newsgroups)
+(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups)
"*Extra headers to parse."
- :version "21.1"
+ :version "24.1" ; added Cc Keywords Gcc
:group 'gnus-summary
:type '(repeat symbol))
:type 'boolean
:group 'gnus-summary-marks)
-(defcustom gnus-propagate-marks t
+(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."
(?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.")
gnus-newsgroup-saved
gnus-newsgroup-replied
gnus-newsgroup-forwarded
- gnus-newsgroup-recent
gnus-newsgroup-expirable
gnus-newsgroup-killed
gnus-newsgroup-unseen
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:
(while (re-search-forward regexp nil t)
(replace-match (or newtext ""))))
-(defun gnus-simplify-buffer-fuzzy ()
+(defun gnus-simplify-buffer-fuzzy (regexp)
"Simplify string in the buffer fuzzily.
The string in the accessible portion of the current buffer is simplified.
It is assumed to be a single-line subject.
(while (not (eq modified-tick (buffer-modified-tick)))
(setq modified-tick (buffer-modified-tick))
(cond
- ((listp gnus-simplify-subject-fuzzy-regexp)
- (mapc 'gnus-simplify-buffer-fuzzy-step
- gnus-simplify-subject-fuzzy-regexp))
- (gnus-simplify-subject-fuzzy-regexp
- (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
+ ((listp regexp)
+ (mapc 'gnus-simplify-buffer-fuzzy-step regexp))
+ (regexp
+ (gnus-simplify-buffer-fuzzy-step regexp)))
(gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
(gnus-simplify-buffer-fuzzy-step
"^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
"Simplify a subject string fuzzily.
See `gnus-simplify-buffer-fuzzy' for details."
(save-excursion
- (gnus-set-work-buffer)
- (let ((case-fold-search t))
- ;; Remove uninteresting prefixes.
- (when (and gnus-simplify-ignored-prefixes
- (string-match gnus-simplify-ignored-prefixes subject))
- (setq subject (substring subject (match-end 0))))
- (insert subject)
- (inline (gnus-simplify-buffer-fuzzy))
- (buffer-string))))
+ (let ((regexp gnus-simplify-subject-fuzzy-regexp))
+ (gnus-set-work-buffer)
+ (let ((case-fold-search t))
+ ;; Remove uninteresting prefixes.
+ (when (and gnus-simplify-ignored-prefixes
+ (string-match gnus-simplify-ignored-prefixes subject))
+ (setq subject (substring subject (match-end 0))))
+ (insert subject)
+ (inline (gnus-simplify-buffer-fuzzy regexp))
+ (buffer-string)))))
(defsubst gnus-simplify-subject-fully (subject)
"Simplify a subject string according to `gnus-summary-gather-subject-limit'."
"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))
(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)
(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) "*")))
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)))
((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
(t (format "%dM" (/ c (* 1024.0 1024)))))))
-(defcustom gnus-summary-user-date-format-alist
+(defcustom gnus-user-date-format-alist
'(((gnus-seconds-today) . "Today, %H:%M")
((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M")
(604800 . "%A %H:%M") ; That's one week
:version "24.1"
:group 'gnus-summary-format
:type '(alist :key-type sexp :value-type string))
-(make-obsolete-variable 'gnus-user-date-format-alist
- 'gnus-summary-user-date-format-alist "24.1")
(defun gnus-user-date (messy-date)
- "Format the messy-date according to `gnus-summary-user-date-format-alist'.
+ "Format the messy-date according to `gnus-user-date-format-alist'.
Returns \" ? \" if there's bad input or if another error occurs.
Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
(condition-case ()
;;If we don't find something suitable we'll use this one
(my-format "%b %d '%y"))
(let* ((difference (- now messy-date))
- (templist gnus-summary-user-date-format-alist)
+ (templist gnus-user-date-format-alist)
(top (eval (caar templist))))
(while (if (numberp top) (< top difference) (not top))
(progn
"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))
(cdr (assq number gnus-newsgroup-scored))
(memq number gnus-newsgroup-processable))))))
+(defun gnus-group-get-list-identifiers (group)
+ "Get list identifier regexp for GROUP."
+ (or (gnus-parameter-list-identifier group)
+ (if (consp gnus-list-identifiers)
+ (mapconcat 'identity gnus-list-identifiers " *\\|")
+ gnus-list-identifiers)))
+
(defun gnus-summary-remove-list-identifiers ()
"Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
- (let ((regexp (if (consp gnus-list-identifiers)
- (mapconcat 'identity gnus-list-identifiers " *\\|")
- gnus-list-identifiers))
- changed subject)
+ (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name))
+ changed subject)
(when regexp
(setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)"))
(dolist (header gnus-newsgroup-headers)
(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.
(when gnus-agent
(gnus-agent-get-undownloaded-list))
;; Remove list identifiers from subject
- (when gnus-list-identifiers
- (gnus-summary-remove-list-identifiers))
+ (gnus-summary-remove-list-identifiers)
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
- (gnus-group-auto-expirable-p group))
+ (and (gnus-group-auto-expirable-p group)
+ (not (gnus-group-read-only-p group))))
;; Set up the article buffer now, if necessary.
(unless (and gnus-single-article-buffer
(equal gnus-article-buffer "*Article*"))
(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* ((articles
+ (let* ((only-read-p t)
+ (articles
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
(gnus-uncompress-range (gnus-active group)))
(gnus-cache-articles-in-group group))
;; Select only the "normal" subset of articles.
+ (setq only-read-p nil)
(gnus-sorted-nunion
(gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
gnus-newsgroup-unreads)))
(let* ((cursor-in-echo-area nil)
(initial (gnus-parameter-large-newsgroup-initial
gnus-newsgroup-name))
+ (default (if only-read-p
+ (or initial gnus-large-newsgroup)
+ number))
(input
(read-string
- (format
- "How many articles from %s (%s %d): "
- (gnus-group-decoded-name gnus-newsgroup-name)
- (if initial "max" "default")
- number)
- (if initial
- (cons (number-to-string initial)
- 0)))))
+ (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 default): "
+ (gnus-group-decoded-name
+ (gnus-group-real-name gnus-newsgroup-name))
+ default))
+ nil
+ nil
+ (number-to-string default))))
(if (string-match "^[ \t]*$" input) number input)))
((and (> scored marked) (< scored number)
(> (- scored number) 20))
(read-string
(format "%s %s (%d scored, %d total): "
"How many articles from"
- (gnus-group-decoded-name group)
+ (gnus-group-decoded-name
+ (gnus-group-real-name gnus-newsgroup-name))
scored number))))
(if (string-match "^[ \t]*$" input)
number input)))
'request-set-mark gnus-newsgroup-name)
(not (gnus-article-unpropagatable-p (cdr type))))
(let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
- (del (gnus-remove-from-range (gnus-copy-sequence old) list))
- (add (gnus-remove-from-range
- (gnus-copy-sequence list) old)))
+ ;; Don't do anything about marks for articles we
+ ;; didn't actually get any headers for.
+ (del
+ (gnus-list-range-intersection
+ gnus-newsgroup-articles
+ (gnus-remove-from-range (gnus-copy-sequence old) list)))
+ (add
+ (gnus-list-range-intersection
+ gnus-newsgroup-articles
+ (gnus-remove-from-range
+ (gnus-copy-sequence list) old))))
(when add
(push (list add 'add (list (cdr type))) delta-marks))
(when del
- ;; Don't delete marks from outside the active range. This
- ;; shouldn't happen, but is a sanity check.
+ ;; Don't delete marks from outside the active range.
+ ;; This shouldn't happen, but is a sanity check.
(setq del (gnus-sorted-range-intersection
(gnus-active gnus-newsgroup-name) del))
(push (list del 'del (list (cdr type))) delta-marks))))
(entry (gnus-group-entry group))
(info (nth 2 entry))
(active (gnus-active group))
+ (set-marks
+ (or gnus-propagate-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)
(1+ (point-at-eol))
(gnus-delete-line))))))
;; Remove list identifiers from subject.
- (when gnus-list-identifiers
- (let ((gnus-newsgroup-headers (list header)))
- (gnus-summary-remove-list-identifiers)))
+ (let ((gnus-newsgroup-headers (list header)))
+ (gnus-summary-remove-list-identifiers))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(setq gnus-newsgroup-sparse
(defun gnus-summary-select-article-buffer ()
"Reconfigure windows to show the article buffer.
-If `gnus-widen-article-buffer' is set, show only the article
+If `gnus-widen-article-window' is set, show only the article
buffer."
(interactive)
(if (not (gnus-buffer-live-p gnus-article-buffer))
(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)))
+ (buf (current-buffer))
+ ;; `gnus-single-article-buffer' is nil buffer-locally in
+ ;; ephemeral group of which summary buffer will be killed,
+ ;; but the global value may be non-nil.
+ (single-article-buffer gnus-single-article-buffer))
(unless quit-config
;; Do adaptive scoring, and possibly save score files.
(when gnus-newsgroup-adaptive
(gnus-configure-windows 'group 'force)))
;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
+ (unless single-article-buffer
(when (gnus-buffer-live-p article-buffer)
(with-current-buffer article-buffer
;; Don't kill sticky article buffers
(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)
(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)))
+ (if (not (buffer-live-p (car quit-config)))
(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)
;; Somehow or other, we may now have selected a different
;; window. Make point go back to the summary buffer.
(when (eq current-summary (current-buffer))
- (select-window (get-buffer-window current-summary)))
+ ;; FIXME: This burps when get-buffer-window returns nil.
+ (select-window (get-buffer-window current-summary 0)))
(gnus-summary-walk-group-buffer
gnus-newsgroup-name cmd unread backward point))))))))
'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))
- ((or (equal arg '(16))
- (eq arg t))
+ (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))
(gnus-summary-select-article nil 'force)))
;; Destroy any MIME parts.
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
+ (gnus-article-stop-animations)
(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
+ (or gnus-propagate-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.
;; 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
(interactive)
(save-excursion
(goto-char (point-min))
- (let ((end nil))
+ (let ((end nil)
+ (count 0))
(while (not end)
+ (incf count)
+ (when (zerop (mod count 1000))
+ (message "Hiding all threads... %d" count))
(when (or (not predicate)
(gnus-map-articles
predicate (gnus-summary-article-children)))
(let ((ol (gnus-make-overlay starteol (point) nil t nil)))
(gnus-overlay-put ol 'invisible 'gnus-sum)
(gnus-overlay-put ol 'evaporate t)))
- (gnus-summary-goto-subject article))
+ (gnus-summary-goto-subject article)
+ (when (> start (point))
+ (message "Hiding the thread moved us backwards, aborting!")
+ (goto-char (point-max))))
(goto-char start)
nil))))
;; 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)
mm-file-name-rewrite-functions
(file-name-nondirectory
(or
- (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (mail-content-type-get
- (mm-handle-type handle) 'name)
+ (mm-handle-filename handle)
(format "%s.%d.%d" gnus-newsgroup-name
(cdr gnus-article-current)
gnus-summary-save-parts-counter))))
(save-excursion
(let (setmarkundo)
;; Propagate the read marks to the backend.
- (when (and gnus-propagate-marks
+ (when (and (or gnus-propagate-marks
+ (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))
(when gnus-agent
(gnus-agent-get-undownloaded-list))
;; Remove list identifiers from subject
- (when gnus-list-identifiers
- (gnus-summary-remove-list-identifiers))
+ (gnus-summary-remove-list-identifiers)
;; First and last article in this newsgroup.
(when gnus-newsgroup-headers
(setq gnus-newsgroup-begin
(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