;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
;;; 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.
+
+Useful functions to put in this list include: `gnus-simplify-subject-re',
+`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'."
+ :group 'gnus-thread
+ :type '(repeat function))
+
(defcustom gnus-simplify-ignored-prefixes nil
"*Regexp, matches for which are removed from subject lines when simplifying fuzzily."
:group 'gnus-thread
(defcustom gnus-summary-thread-gathering-function
'gnus-gather-threads-by-subject
- "Function used for gathering loose threads.
+ "*Function used for gathering loose threads.
There are two pre-defined functions: `gnus-gather-threads-by-subject',
which only takes Subjects into consideration; and
`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-article-headers
:type 'boolean)
+(defcustom gnus-summary-ignore-duplicates nil
+ "*If non-nil, ignore articles with identical Message-ID headers."
+ :group 'gnus-summary
+ :type 'boolean)
+
(defcustom gnus-single-article-buffer t
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
"*Variable used to suggest where articles are to be moved to.
It uses the same syntax as the `gnus-split-methods' variable."
:group 'gnus-summary-mail
- :type '(repeat (choice (list function)
- (cons regexp (repeat string))
- sexp)))
+ :type '(repeat (choice (list :value (fun) function)
+ (cons :value ("" "") regexp (repeat string))
+ (sexp :value nil))))
(defcustom gnus-unread-mark ?
"*Mark used for unread articles."
: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
:type 'boolean)
(defcustom gnus-summary-dummy-line-format
- "* %(: :%) %S\n"
+ " %(: :%) %S\n"
"*The format specification for the dummy roots in the summary buffer.
It works along the same lines as a normal formatting string,
with some simple extensions.
:type 'function)
(defcustom gnus-summary-expunge-below nil
- "All articles that have a score less than this variable will be expunged."
+ "All articles that have a score less than this variable will be expunged.
+This variable is local to the summary buffers."
:group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
(defcustom gnus-thread-expunge-below nil
"All threads that have a total score less than this variable will be expunged.
See `gnus-thread-score-function' for en explanation of what a
-\"thread score\" is."
+\"thread score\" is.
+
+This variable is local to the summary buffers."
:group 'gnus-treading
:group 'gnus-score-default
:type '(choice (const :tag "off" nil)
:group 'gnus-summary-various
:type 'hook)
+(defcustom gnus-summary-prepared-hook nil
+ "*A hook called as the last thing after the summary buffer has been generated."
+ :group 'gnus-summary-various
+ :type 'hook)
+
(defcustom gnus-summary-generate-hook nil
"*A hook run just before generating the summary buffer.
This hook is commonly used to customize threading variables and the
:group 'gnus-summary-visual
:type 'hook)
+(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)
. gnus-summary-high-unread-face)
((and (< score default) (= mark gnus-unread-mark))
. gnus-summary-low-unread-face)
- ((and (= mark gnus-unread-mark))
+ ((= mark gnus-unread-mark)
+ . gnus-summary-normal-unread-face)
+ ((and (> score default) (memq mark (list gnus-downloadable-mark
+ gnus-undownloaded-mark)))
+ . gnus-summary-high-unread-face)
+ ((and (< score default) (memq mark (list gnus-downloadable-mark
+ gnus-undownloaded-mark)))
+ . gnus-summary-low-unread-face)
+ ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
. gnus-summary-normal-unread-face)
((> score default)
. gnus-summary-high-read-face)
. gnus-summary-low-read-face)
(t
. gnus-summary-normal-read-face))
- "Controls the highlighting of summary buffer lines.
+ "*Controls the highlighting of summary buffer lines.
A list of (FORM . FACE) pairs. When deciding how a a particular
summary line should be displayed, each form is evaluated. The content
: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-scores-exclude-files nil)
-
-(defvar gnus-summary-display-table
- ;; Change the display table. Odd characters have a tendency to mess
- ;; up nicely formatted displays - we make all possible glyphs
- ;; display only a single character.
-
- ;; We start from the standard display table, if any.
- (let ((table (or (copy-sequence standard-display-table)
- (make-display-table)))
- ;; Nix out all the control chars...
- (i 32))
- (while (>= (setq i (1- i)) 0)
- (aset table i [??]))
- ;; ... but not newline and cr, of course. (cr is necessary for the
- ;; selective display).
- (aset table ?\n nil)
- (aset table ?\r nil)
- ;; We nix out any glyphs over 126 that are not set already.
- (let ((i 256))
- (while (>= (setq i (1- i)) 127)
- ;; Only modify if the entry is nil.
- (or (aref table i)
- (aset table i [??]))))
- table)
- "Display table used in summary mode buffers.")
+(defvar gnus-page-broken nil)
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
(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))
+ ;; 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))))
(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)
" " gnus-summary-next-page
"\177" gnus-summary-prev-page
[delete] gnus-summary-prev-page
+ [backspace] gnus-summary-prev-page
"\r" gnus-summary-scroll-up
"n" gnus-summary-next-unread-article
"p" gnus-summary-prev-unread-article
"\C-c\C-v\C-v" gnus-uu-decode-uu-view
"\C-d" gnus-summary-enter-digest-group
"\M-\C-d" gnus-summary-read-document
+ "\M-\C-e" gnus-summary-edit-parameters
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"\C-l" gnus-recenter
"I" gnus-summary-increase-score
"L" gnus-summary-lower-score
-
+ "\M-i" gnus-symbolic-argument
+ "h" gnus-summary-select-article-buffer
+
"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)
"t" gnus-article-hide-headers
"v" gnus-summary-verbose-headers
"m" gnus-summary-toggle-mime
- "h" gnus-article-treat-html)
+ "h" gnus-article-treat-html
+ "d" gnus-article-treat-dumbquotes)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"a" gnus-article-hide
"l" gnus-article-date-local
"e" gnus-article-date-lapsed
"o" gnus-article-date-original
+ "i" gnus-article-date-iso8601
"s" gnus-article-date-user)
(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
"l" gnus-article-strip-leading-blank-lines
"m" gnus-article-strip-multiple-blank-lines
"a" gnus-article-strip-blank-lines
+ "A" gnus-article-strip-all-blank-lines
"s" gnus-article-strip-leading-space)
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
["Citation" gnus-article-highlight-citation t])
("Date"
["Local" gnus-article-date-local t]
+ ["ISO8601" gnus-article-date-iso8601 t]
["UT" gnus-article-date-ut t]
["Original" gnus-article-date-original t]
["Lapsed" gnus-article-date-lapsed t]
["Multiple" gnus-article-strip-multiple-blank-lines t]
["Trailing" gnus-article-remove-trailing-blank-lines t]
["All of the above" gnus-article-strip-blank-lines t]
+ ["All" gnus-article-strip-all-blank-lines t]
["Leading space" gnus-article-strip-leading-space t])
["Overstrike" gnus-article-treat-overstrike t]
+ ["Dumb quotes" gnus-article-treat-dumbquotes t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
["CR" gnus-article-remove-cr t]
["Save in default format" gnus-summary-save-article t]
["Save in file" gnus-summary-save-article-file t]
["Save in Unix mail format" gnus-summary-save-article-mail t]
- ["Write to file" gnus-summary-write-article-mail t]
["Save in MH folder" gnus-summary-save-article-folder t]
["Save in VM folder" gnus-summary-save-article-vm t]
["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
("Cache"
["Enter article" gnus-cache-enter-article t]
["Remove article" gnus-cache-remove-article t])
+ ["Select article buffer" gnus-summary-select-article-buffer t]
["Enter digest buffer" gnus-summary-enter-digest-group t]
["Isearch article..." gnus-summary-isearch-article t]
["Beginning of the article" gnus-summary-beginning-of-article t]
["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]))
'request-expire-articles gnus-newsgroup-name)]
["Edit local kill file" gnus-summary-edit-local-kill t]
["Edit main kill file" gnus-summary-edit-global-kill t]
+ ["Edit group parameters" gnus-summary-edit-parameters t]
("Exit"
["Catchup and exit" gnus-summary-catchup-and-exit t]
["Catchup all and exit" gnus-summary-catchup-and-exit t]
["Rescan group" gnus-summary-rescan-group t]
["Update dribble" gnus-summary-save-newsrc t])))
- (run-hooks 'gnus-summary-menu-hook)))
+ (gnus-run-hooks 'gnus-summary-menu-hook)))
(defun gnus-score-set-default (var value)
"A version of set that updates the GNU Emacs menu-bar."
(setq truncate-lines t)
(setq selective-display t)
(setq selective-display-ellipses t) ;Display `...'
- (setq buffer-display-table gnus-summary-display-table)
+ (gnus-summary-set-display-table)
(gnus-set-default-directory)
(setq gnus-newsgroup-name group)
(make-local-variable 'gnus-summary-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
+ (make-local-variable 'gnus-summary-dummy-line-format)
+ (make-local-variable 'gnus-summary-dummy-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
(make-local-hook 'post-command-hook)
- (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
- (run-hooks 'gnus-summary-mode-hook)
+ (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
+ (make-local-hook 'pre-command-hook)
+ (add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
+ (gnus-run-hooks 'gnus-summary-mode-hook)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
(defmacro gnus-summary-article-sparse-p (article)
"Say whether this article is a sparse article or not."
- ` (memq ,article gnus-newsgroup-sparse))
+ `(memq ,article gnus-newsgroup-sparse))
(defmacro gnus-summary-article-ancient-p (article)
"Say whether this article is a sparse article or not."
(gnus-summary-last-subject))))
(defmacro gnus-summary-article-header (&optional number)
+ "Return the header of article NUMBER."
`(gnus-data-header (gnus-data-find
,(or number '(gnus-summary-article-number)))))
(defmacro gnus-summary-thread-level (&optional number)
+ "Return the level of thread that starts with article NUMBER."
`(if (and (eq gnus-summary-make-false-root 'dummy)
(get-text-property (point) 'gnus-intangible))
0
,(or number '(gnus-summary-article-number))))))
(defmacro gnus-summary-article-mark (&optional number)
+ "Return the mark of article NUMBER."
`(gnus-data-mark (gnus-data-find
,(or number '(gnus-summary-article-number)))))
(defmacro gnus-summary-article-pos (&optional number)
+ "Return the position of the line of article NUMBER."
`(gnus-data-pos (gnus-data-find
,(or number '(gnus-summary-article-number)))))
gnus-summary-default-score 0))
(defun gnus-summary-article-children (&optional number)
+ "Return a list of article numbers that are children of article NUMBER."
(let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
(level (gnus-data-level (car data)))
l children)
(nreverse children)))
(defun gnus-summary-article-parent (&optional number)
+ "Return the article number of the parent of article NUMBER."
(let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
(gnus-data-list t)))
(level (gnus-data-level (car data))))
(= mark gnus-expirable-mark))))
(defmacro gnus-article-mark (number)
+ "Return the MARK of article NUMBER.
+This macro should only be used when computing the mark the \"first\"
+time; i.e., when generating the summary lines. After that,
+`gnus-summary-article-mark' should be used to examine the
+marks of articles."
`(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)
(mouse-set-point e)
(gnus-summary-next-page nil t))
+(defun gnus-summary-set-display-table ()
+ ;; Change the display table. Odd characters have a tendency to mess
+ ;; up nicely formatted displays - we make all possible glyphs
+ ;; display only a single character.
+
+ ;; We start from the standard display table, if any.
+ (let ((table (or (copy-sequence standard-display-table)
+ (make-display-table)))
+ (i 32))
+ ;; Nix out all the control chars...
+ (while (>= (setq i (1- i)) 0)
+ (aset table i [??]))
+ ;; ... but not newline and cr, of course. (cr is necessary for the
+ ;; selective display).
+ (aset table ?\n nil)
+ (aset table ?\r nil)
+ ;; We keep TAB as well.
+ (aset table ?\t nil)
+ ;; We nix out any glyphs over 126 that are not set already.
+ (let ((i 256))
+ (while (>= (setq i (1- i)) 127)
+ ;; Only modify if the entry is nil.
+ (unless (aref table i)
+ (aset table i [??]))))
+ (setq buffer-display-table table)))
+
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer."
(let ((buffer (concat "*Summary " group "*")))
(score-file gnus-current-score-file))
(save-excursion
(set-buffer gnus-group-buffer)
- (setq gnus-newsgroup-name name)
- (setq gnus-newsgroup-marked marked)
- (setq gnus-newsgroup-unreads unread)
- (setq gnus-current-headers headers)
- (setq gnus-newsgroup-data data)
- (setq gnus-article-current gac)
- (setq gnus-summary-buffer summary)
- (setq gnus-article-buffer article-buffer)
- (setq gnus-original-article-buffer original)
- (setq gnus-reffed-article-number reffed)
- (setq gnus-current-score-file score-file)
+ (setq gnus-newsgroup-name name
+ gnus-newsgroup-marked marked
+ gnus-newsgroup-unreads unread
+ gnus-current-headers headers
+ gnus-newsgroup-data data
+ gnus-article-current gac
+ gnus-summary-buffer summary
+ gnus-article-buffer article-buffer
+ gnus-original-article-buffer original
+ gnus-reffed-article-number reffed
+ gnus-current-score-file score-file)
;; The article buffer also has local variables.
(when (gnus-buffer-live-p gnus-article-buffer)
(set-buffer gnus-article-buffer)
(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))))
'gnus-number gnus-tmp-number)
(when (gnus-visual-p 'summary-highlight 'highlight)
(forward-line -1)
- (run-hooks 'gnus-summary-update-hook)
+ (gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))))
(defun gnus-summary-update-line (&optional dont-update)
'score))
;; Do visual highlighting.
(when (gnus-visual-p 'summary-highlight 'highlight)
- (run-hooks 'gnus-summary-update-hook)))))
+ (gnus-run-hooks 'gnus-summary-update-hook)))))
(defvar gnus-tmp-new-adopts nil)
(let (result)
(while (and group
(null (setq result
- (gnus-summary-read-group-1
- group show-all no-article
- kill-buffer no-display)))
+ (let ((gnus-auto-select-next nil))
+ (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)))
(kill-buffer (current-buffer))
(if (not quit-config)
(progn
+ ;; Update the info -- marks might need to be removed,
+ ;; for instance.
+ (gnus-summary-update-info)
(set-buffer gnus-group-buffer)
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1))
(gnus-copy-sequence
(gnus-active gnus-newsgroup-name)))
;; You can change the summary buffer in some way with this hook.
- (run-hooks 'gnus-select-group-hook)
+ (gnus-run-hooks 'gnus-select-group-hook)
;; Set any local variables in the group parameters.
(gnus-summary-set-local-parameters gnus-newsgroup-name)
(gnus-update-format-specifications
((and gnus-newsgroup-scored show-all)
(gnus-summary-limit-include-expunged t))))
;; Function `gnus-apply-kill-file' must be called in this hook.
- (run-hooks 'gnus-apply-kill-hook)
+ (gnus-run-hooks 'gnus-apply-kill-hook)
(if (and (zerop (buffer-size))
(not no-display))
(progn
(and gnus-show-threads
gnus-thread-hide-subtree
(gnus-summary-hide-all-threads))
+ (when kill-buffer
+ (gnus-kill-or-deaden-summary kill-buffer))
;; Show first unread article if requested.
(if (and (not no-article)
(not no-display)
;; article in the group.
(goto-char (point-min))
(gnus-summary-position-point)
- (gnus-set-mode-line 'summary)
- (gnus-configure-windows 'summary 'force))
- (when kill-buffer
- (gnus-kill-or-deaden-summary kill-buffer))
+ (gnus-configure-windows 'summary 'force)
+ (gnus-set-mode-line 'summary))
(when (get-buffer-window gnus-group-buffer t)
;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
(select-window (get-buffer-window gnus-group-buffer t))
(when (gnus-group-goto-group group)
(recenter))
- (select-window owin))))
- ;; Mark this buffer as "prepared".
- (setq gnus-newsgroup-prepared t)
- t))))
+ (select-window owin)))
+ ;; Mark this buffer as "prepared".
+ (setq gnus-newsgroup-prepared t)
+ (gnus-run-hooks 'gnus-summary-prepared-hook)
+ t)))))
(defun gnus-summary-prepare ()
"Generate the summary buffer."
(erase-buffer)
(setq gnus-newsgroup-data nil
gnus-newsgroup-data-reverse nil)
- (run-hooks 'gnus-summary-generate-hook)
+ (gnus-run-hooks 'gnus-summary-generate-hook)
;; Generate the buffer, either with threads or without.
(when gnus-newsgroup-headers
(gnus-summary-prepare-threads
(setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
;; Call hooks for modifying summary buffer.
(goto-char (point-min))
- (run-hooks 'gnus-summary-prepare-hook)))
+ (gnus-run-hooks 'gnus-summary-prepare-hook)))
(defsubst gnus-general-simplify-subject (subject)
"Simply subject by the same rules as gnus-gather-threads-by-subject."
(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)
(defun gnus-summary-simplify-subject-query ()
"Query where the respool algorithm would put this article."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-select-article)
(message (gnus-general-simplify-subject (gnus-summary-article-subject))))
(defun gnus-thread-loop-p (root thread)
"Say whether ROOT is in THREAD."
- (let ((th (cdr thread)))
- (while (and th
- (not (eq (caar th) root)))
- (pop th))
- (if th
- ;; We have found a loop.
- (let (ref-dep)
- (setcdr thread (delq (car th) (cdr thread)))
- (if (boundp (setq ref-dep (intern "none"
- gnus-newsgroup-dependencies)))
- (setcdr (symbol-value ref-dep)
- (nconc (cdr (symbol-value ref-dep))
- (list (car th))))
- (set ref-dep (list nil (car th))))
- 1)
- ;; Recurse down into the sub-threads and look for loops.
- (apply '+
- (mapcar
- (lambda (thread) (gnus-thread-loop-p root thread))
- (cdr thread))))))
+ (let ((stack (list thread))
+ (infloop 0)
+ th)
+ (while (setq thread (pop stack))
+ (setq th (cdr thread))
+ (while (and th
+ (not (eq (caar th) root)))
+ (pop th))
+ (if th
+ ;; We have found a loop.
+ (let (ref-dep)
+ (setcdr thread (delq (car th) (cdr thread)))
+ (if (boundp (setq ref-dep (intern "none"
+ gnus-newsgroup-dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (car th))))
+ (set ref-dep (list nil (car th))))
+ (setq infloop 1
+ stack nil))
+ ;; Push all the subthreads onto the stack.
+ (push (cdr thread) stack)))
+ infloop))
(defun gnus-make-threads ()
"Go through the dependency hashtb and find the roots. Return all threads."
(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))
(prog1
(save-excursion
(set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while (and (not found) (search-forward id nil t))
- (beginning-of-line)
- (setq found (looking-at
- (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
- (regexp-quote id))))
- (or found (beginning-of-line 2)))
- (when found
- (beginning-of-line)
- (and
- (setq header (gnus-nov-parse-line
- (read (current-buffer)) deps))
- (gnus-parent-id (mail-header-references header)))))
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (while (and (not found)
+ (search-forward id nil t))
+ (beginning-of-line)
+ (setq found (looking-at
+ (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
+ (regexp-quote id))))
+ (or found (beginning-of-line 2)))
+ (when found
+ (beginning-of-line)
+ (and
+ (setq header (gnus-nov-parse-line
+ (read (current-buffer)) deps))
+ (gnus-parent-id (mail-header-references header))))))
(when header
(let ((number (mail-header-number header)))
(push number gnus-newsgroup-limit)
(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))
(gnus-data-find-list
article
(gnus-data-list t)))))
+ ;; Error on the side of excessive subjects.
(error ""))
(mail-header-subject header))
- (mail-header-subject header)
- "")
+ ""
+ (mail-header-subject header))
nil (cdr (assq article gnus-newsgroup-scored))
(memq article gnus-newsgroup-processable))
(when length
"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)
'gnus-number number)
(when gnus-visual-p
(forward-line -1)
- (run-hooks 'gnus-summary-update-hook)
+ (gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))
(setq gnus-tmp-prev-subject subject)))
"Select newsgroup GROUP.
If READ-ALL is non-nil, all articles in the group are selected."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ ;;!!! Dirty hack; should be removed.
+ (gnus-summary-ignore-duplicates
+ (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
+ t
+ gnus-summary-ignore-duplicates))
(info (nth 2 entry))
articles fetched-articles cached)
;; 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))
;; All articles have to be subsets of the active articles.
(cond
;; Adjust "simple" lists.
- ((memq mark '(tick dormant expirable reply save))
+ ((memq mark '(tick dormant expire reply save))
(while articles
(when (or (< (setq article (pop articles)) min) (> article max))
(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)
(set var (delq article (symbol-value var))))))))))
(defun gnus-update-missing-marks (missing)
- "Go through the list of MISSING articles and remove them mark lists."
+ "Go through the list of MISSING articles and remove them from the mark lists."
(when missing
(let ((types gnus-article-mark-lists)
var m)
(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))
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
(subst-char-in-region (point-min) (point-max) ?\t ? t)
- (run-hooks 'gnus-parse-headers-hook)
+ (gnus-run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
in-reply-to header p lines)
(goto-char (point-min))
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (nnheader-header-value) "(none)"))
+ (funcall
+ gnus-unstructured-field-decoder (nnheader-header-value))
+ "(none)"))
;; From.
(progn
(goto-char p)
(if (search-forward "\nfrom: " nil t)
- (nnheader-header-value) "(nobody)"))
+ (funcall
+ gnus-structured-field-decoder (nnheader-header-value))
+ "(nobody)"))
;; Date.
(progn
(goto-char p)
;; Message-ID.
(progn
(goto-char p)
- (setq id (if (search-forward "\nmessage-id:" nil t)
- (buffer-substring
- (1- (or (search-forward "<" nil t) (point)))
- (or (search-forward ">" nil t) (point)))
+ (setq id (if (re-search-forward
+ "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
+ ;; We do it this way to make sure the Message-ID
+ ;; is (somewhat) syntactically valid.
+ (buffer-substring (match-beginning 1)
+ (match-end 1))
;; If there was no message-id, we just fake one
;; to make subsequent routines simpler.
(nnheader-generate-fake-message-id))))
(if (and (search-forward "\nin-reply-to: " nil t)
(setq in-reply-to (nnheader-header-value))
(string-match "<[^>]+>" in-reply-to))
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
+ (let (ref2)
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (while (string-match "<[^>]+>" in-reply-to (match-end 0))
+ (setq ref2 (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (when (> (length ref2) (length ref))
+ (setq ref ref2))))
(setq ref nil))))
;; Chars.
0
(progn
(goto-char p)
(if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
+ (if (numberp (setq lines (ignore-errors (read cur))))
lines 0)
0))
;; Xref.
(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
(if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
- ;; An article with this Message-ID has already been seen,
- ;; so we rename the Message-ID.
- (progn
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; We ignore this one, except we add
+ ;; any additional Xrefs (in case the two articles
+ ;; came from different servers).
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep)))
+ "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ ;; We rename the Message-ID.
(set
(setq id-dep (intern (setq id (nnmail-message-id))
dependencies))
(mail-header-set-id header id))
(setcar (symbol-value id-dep) header))
(set id-dep (list header)))
- (when header
+ (when header
(if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
(setcdr (symbol-value ref-dep)
(nconc (cdr (symbol-value ref-dep))
(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
(setq ref
(buffer-substring
(1+ (point))
- (search-backward "<" beg t)))
+ (or (search-backward "<" beg t) beg)))
(setq ref nil))
(goto-char beg))
(gnus-nov-field)) ; refs
(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.
(if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
- ;; An article with this Message-ID has already been seen,
- ;; so we rename the Message-ID.
- (progn
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; We ignore this one, except we add any additional
+ ;; Xrefs (in case the two articles came from different
+ ;; servers.
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep)))
+ "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ ;; We rename the Message-ID.
(set
(setq id-dep (intern (setq id (nnmail-message-id))
dependencies))
(save-excursion
(set-buffer nntp-server-buffer)
;; Allow the user to mangle the headers before parsing them.
- (run-hooks 'gnus-parse-headers-hook)
+ (gnus-run-hooks 'gnus-parse-headers-hook)
(goto-char (point-min))
(while (not (eobp))
(condition-case ()
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
"Find article ID and insert the summary line for that article."
- (let ((header (if (and old-header use-old-header)
- old-header (gnus-read-header id)))
+ (let ((header (cond ((and old-header use-old-header)
+ old-header)
+ ((and (numberp id)
+ (gnus-number-to-header id))
+ (gnus-number-to-header id))
+ (t
+ (gnus-read-header id))))
(number (and (numberp id) id))
pos d)
(when header
(delq (setq number (mail-header-number header))
gnus-newsgroup-sparse))
(setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
+ (push number gnus-newsgroup-limit)
(gnus-rebuild-thread (mail-header-id header))
(gnus-summary-goto-subject number nil t))
(when (and (numberp number)
"Return a list of articles to be worked upon. The prefix argument,
the list of process marked articles, and the current article will be
taken into consideration."
- (cond
- (n
- ;; A numerical prefix has been given.
- (setq n (prefix-numeric-value n))
- (let ((backward (< n 0))
- (n (abs (prefix-numeric-value n)))
- articles article)
- (save-excursion
- (while
- (and (> n 0)
- (push (setq article (gnus-summary-article-number))
- articles)
- (if backward
- (gnus-summary-find-prev nil article)
- (gnus-summary-find-next nil article)))
- (decf n)))
- (nreverse articles)))
- ((gnus-region-active-p)
- ;; Work on the region between point and mark.
- (let ((max (max (point) (mark)))
- articles article)
- (save-excursion
- (goto-char (min (point) (mark)))
- (while
- (and
- (push (setq article (gnus-summary-article-number)) articles)
- (gnus-summary-find-next nil article)
- (< (point) max)))
- (nreverse articles))))
- (gnus-newsgroup-processable
- ;; There are process-marked articles present.
- ;; Save current state.
- (gnus-summary-save-process-mark)
- ;; Return the list.
- (reverse gnus-newsgroup-processable))
- (t
- ;; Just return the current article.
- (list (gnus-summary-article-number)))))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (cond
+ (n
+ ;; A numerical prefix has been given.
+ (setq n (prefix-numeric-value n))
+ (let ((backward (< n 0))
+ (n (abs (prefix-numeric-value n)))
+ articles article)
+ (save-excursion
+ (while
+ (and (> n 0)
+ (push (setq article (gnus-summary-article-number))
+ articles)
+ (if backward
+ (gnus-summary-find-prev nil article)
+ (gnus-summary-find-next nil article)))
+ (decf n)))
+ (nreverse articles)))
+ ((and (gnus-region-active-p) (mark))
+ (message "region active")
+ ;; Work on the region between point and mark.
+ (let ((max (max (point) (mark)))
+ articles article)
+ (save-excursion
+ (goto-char (min (min (point) (mark))))
+ (while
+ (and
+ (push (setq article (gnus-summary-article-number)) articles)
+ (gnus-summary-find-next nil article)
+ (< (point) max)))
+ (nreverse articles))))
+ (gnus-newsgroup-processable
+ ;; There are process-marked articles present.
+ ;; Save current state.
+ (gnus-summary-save-process-mark)
+ ;; Return the list.
+ (reverse gnus-newsgroup-processable))
+ (t
+ ;; Just return the current article.
+ (list (gnus-summary-article-number))))))
(defun gnus-summary-save-process-mark ()
"Push the current set of process marked articles on the stack."
(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."
;; Various summary commands
+(defun gnus-summary-select-article-buffer ()
+ "Reconfigure windows to show article buffer."
+ (interactive)
+ (if (not (gnus-buffer-live-p gnus-article-buffer))
+ (error "There is no article buffer for this summary buffer")
+ (gnus-configure-windows 'article)
+ (select-window (get-buffer-window gnus-article-buffer))))
+
(defun gnus-summary-universal-argument (arg)
"Perform any operation on all articles that are process/prefixed."
(interactive "P")
- (gnus-set-global-variables)
(let ((articles (gnus-summary-work-articles arg))
func article)
(if (eq
"Exit and then reselect the current newsgroup.
The prefix argument ALL means to select all articles."
(interactive "P")
- (gnus-set-global-variables)
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
(let ((current-subject (gnus-summary-article-number))
(defun gnus-summary-update-info (&optional non-destructive)
(save-excursion
(let ((group gnus-newsgroup-name))
- (when gnus-newsgroup-kill-headers
- (setq gnus-newsgroup-killed
- (gnus-compress-sequence
- (nconc
- (gnus-set-sorted-intersection
- (gnus-uncompress-range gnus-newsgroup-killed)
- (setq gnus-newsgroup-unselected
- (sort gnus-newsgroup-unselected '<)))
- (setq gnus-newsgroup-unreads
- (sort gnus-newsgroup-unreads '<)))
- t)))
- (unless (listp (cdr gnus-newsgroup-killed))
- (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
- (let ((headers gnus-newsgroup-headers))
- (when (and (not gnus-save-score)
- (not non-destructive))
- (setq gnus-newsgroup-scored nil))
- ;; Set the new ranges of read articles.
- (gnus-update-read-articles
- group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
- ;; Set the current article marks.
- (gnus-update-marks)
- ;; Do the cross-ref thing.
- (when gnus-use-cross-reference
- (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
- ;; Do adaptive scoring, and possibly save score files.
- (when gnus-newsgroup-adaptive
- (gnus-score-adaptive))
- (when gnus-use-scoring
- (gnus-score-save))
- ;; Do not switch windows but change the buffer to work.
- (set-buffer gnus-group-buffer)
- (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-group-update-group group))))))
+ (when group
+ (when gnus-newsgroup-kill-headers
+ (setq gnus-newsgroup-killed
+ (gnus-compress-sequence
+ (nconc
+ (gnus-set-sorted-intersection
+ (gnus-uncompress-range gnus-newsgroup-killed)
+ (setq gnus-newsgroup-unselected
+ (sort gnus-newsgroup-unselected '<)))
+ (setq gnus-newsgroup-unreads
+ (sort gnus-newsgroup-unreads '<)))
+ t)))
+ (unless (listp (cdr gnus-newsgroup-killed))
+ (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
+ (let ((headers gnus-newsgroup-headers))
+ (when (and (not gnus-save-score)
+ (not non-destructive))
+ (setq gnus-newsgroup-scored nil))
+ ;; Set the new ranges of read articles.
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-force-boundary))
+ (gnus-update-read-articles
+ group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
+ ;; Set the current article marks.
+ (gnus-update-marks)
+ ;; Do the cross-ref thing.
+ (when gnus-use-cross-reference
+ (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
+ ;; Do 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)))))))
(defun gnus-summary-save-newsrc (&optional force)
"Save the current number of read/marked articles in the dribble buffer.
(interactive)
(gnus-set-global-variables)
(gnus-kill-save-kill-buffer)
+ (gnus-async-halt-prefetch)
(let* ((group gnus-newsgroup-name)
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
(mode major-mode)
+ (group-point nil)
(buf (current-buffer)))
- (run-hooks 'gnus-summary-prepare-exit-hook)
+ (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-original-article-buffer)
(gnus-dup-enter-articles))
(when gnus-use-trees
(gnus-tree-close group))
+ ;; Remove entries for this group.
+ (nnmail-purge-split-history (gnus-group-real-name group))
;; Make all changes in this group permanent.
(unless quit-config
- (run-hooks 'gnus-exit-group-hook)
- (gnus-summary-update-info))
+ (gnus-run-hooks 'gnus-exit-group-hook)
+ (gnus-summary-update-info)
+ ;; Do adaptive scoring, and possibly save score files.
+ (when gnus-newsgroup-adaptive
+ (gnus-score-adaptive))
+ (when gnus-use-scoring
+ (gnus-score-save)))
(gnus-close-group group)
- ;; Make sure where I was, and go to next newsgroup.
+ ;; Make sure where we were, and go to next newsgroup.
(set-buffer gnus-group-buffer)
(unless quit-config
(gnus-group-jump-to-group group))
- (run-hooks 'gnus-summary-exit-hook)
- (unless quit-config
+ (gnus-run-hooks 'gnus-summary-exit-hook)
+ (unless (or quit-config
+ ;; If this group has disappeared from the summary
+ ;; buffer, don't skip forwards.
+ (not (string= group (gnus-group-group-name))))
(gnus-group-next-unread-group 1))
+ (setq group-point (point))
(if temporary
nil ;Nothing to do.
;; If we have several article buffers, we kill them at exit.
;; Clear the current group name.
(if (not quit-config)
(progn
- (gnus-group-jump-to-group group)
- (gnus-group-next-unread-group 1)
+ (goto-char group-point)
(gnus-configure-windows 'group 'force))
(gnus-handle-ephemeral-exit quit-config))
(unless quit-config
(defun gnus-summary-exit-no-update (&optional no-questions)
"Quit reading current newsgroup without updating read article info."
(interactive)
- (gnus-set-global-variables)
(let* ((group gnus-newsgroup-name)
(quit-config (gnus-group-quit-config group)))
(when (or no-questions
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
+ (gnus-async-halt-prefetch)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(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."
(defun gnus-kill-or-deaden-summary (buffer)
"Kill or deaden the summary BUFFER."
- (when (and (buffer-name buffer)
- (not gnus-single-article-buffer))
- (save-excursion
- (set-buffer buffer)
- (gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer)))
- (cond (gnus-kill-summary-on-exit
- (when (and gnus-use-trees
- (and (get-buffer buffer)
- (buffer-name (get-buffer buffer))))
+ (save-excursion
+ (when (and (buffer-name buffer)
+ (not gnus-single-article-buffer))
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-kill-buffer gnus-article-buffer)
+ (gnus-kill-buffer gnus-original-article-buffer)))
+ (cond (gnus-kill-summary-on-exit
+ (when (and gnus-use-trees
+ (and (get-buffer buffer)
+ (buffer-name (get-buffer buffer))))
+ (save-excursion
+ (set-buffer (get-buffer buffer))
+ (gnus-tree-close gnus-newsgroup-name)))
+ (gnus-kill-buffer buffer))
+ ((and (get-buffer buffer)
+ (buffer-name (get-buffer buffer)))
(save-excursion
- (set-buffer (get-buffer buffer))
- (gnus-tree-close gnus-newsgroup-name)))
- (gnus-kill-buffer buffer))
- ((and (get-buffer buffer)
- (buffer-name (get-buffer buffer)))
- (save-excursion
- (set-buffer buffer)
- (gnus-deaden-summary)))))
+ (set-buffer buffer)
+ (gnus-deaden-summary))))))
(defun gnus-summary-wake-up-the-dead (&rest args)
"Wake up the 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))
initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
previous group instead."
(interactive "P")
- (gnus-set-global-variables)
;; Stop pre-fetching.
(gnus-async-halt-prefetch)
(let ((current-group gnus-newsgroup-name)
(progn
(gnus-message 5 "Returning to the group buffer")
(setq entered t)
- (set-buffer current-buffer)
- (gnus-summary-exit)
- (run-hooks 'gnus-group-no-more-groups-hook))
+ (when (gnus-buffer-live-p current-buffer)
+ (set-buffer current-buffer)
+ (gnus-summary-exit))
+ (gnus-run-hooks 'gnus-group-no-more-groups-hook))
;; We try to enter the target group.
(gnus-group-jump-to-group target-group)
(let ((unreads (gnus-group-group-unread)))
(if (and (or (eq t unreads)
(and unreads (not (zerop unreads))))
(gnus-summary-read-group
- target-group nil no-article current-buffer))
+ target-group nil no-article
+ (and (buffer-name current-buffer) current-buffer)))
(setq entered t)
(setq current-group target-group
target-group nil)))))))
"Make the summary buffer take up the entire Emacs frame.
Given a prefix, will force an `article' buffer configuration."
(interactive "P")
- (gnus-set-global-variables)
(if arg
(gnus-configure-windows 'article 'force)
(gnus-configure-windows 'summary 'force)))
(if gnus-summary-display-article-function
(funcall gnus-summary-display-article-function article all-header)
(gnus-article-prepare article all-header))
- (run-hooks 'gnus-select-article-hook)
+ (gnus-run-hooks 'gnus-select-article-hook)
(when (and gnus-current-article
(not (zerop gnus-current-article)))
(gnus-summary-goto-subject gnus-current-article))
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)
If SUBJECT, only articles with SUBJECT are selected.
If BACKWARD, the previous article is selected instead of the next."
(interactive "P")
- (gnus-set-global-variables)
(cond
;; Is there such an article?
((and (gnus-summary-search-forward unread subject backward)
If MOVE, move to the previous unread article if point is at
the beginning of the buffer."
(interactive "P")
- (gnus-set-global-variables)
(let ((article (gnus-summary-article-number))
(article-window (get-buffer-window gnus-article-buffer t))
endp)
"Scroll up (or down) one line current article.
Argument LINES specifies lines to be scrolled up (or down if negative)."
(interactive "p")
- (gnus-set-global-variables)
(gnus-configure-windows 'article)
(gnus-summary-show-thread)
(when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
(defun gnus-summary-next-same-subject ()
"Select next article which has the same subject as current one."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-next-article nil (gnus-summary-article-subject)))
(defun gnus-summary-prev-same-subject ()
"Select previous article which has the same subject as current one."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-prev-article nil (gnus-summary-article-subject)))
(defun gnus-summary-next-unread-same-subject ()
"Select next unread article which has the same subject as current one."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-next-article t (gnus-summary-article-subject)))
(defun gnus-summary-prev-unread-same-subject ()
"Select previous unread article which has the same subject as current one."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-prev-article t (gnus-summary-article-subject)))
(defun gnus-summary-first-unread-article ()
"Select the first unread article.
Return nil if there are no unread articles."
(interactive)
- (gnus-set-global-variables)
(prog1
(when (gnus-summary-first-subject t)
(gnus-summary-show-thread)
"Select the first article.
Return nil if there are no articles."
(interactive)
- (gnus-set-global-variables)
(prog1
(when (gnus-summary-first-subject)
(gnus-summary-show-thread)
(defun gnus-summary-best-unread-article ()
"Select the unread article with the highest score."
(interactive)
- (gnus-set-global-variables)
(let ((best -1000000)
(data gnus-newsgroup-data)
article score)
(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 ()
(interactive)
(prog1
(when gnus-last-article
- (gnus-summary-goto-article gnus-last-article))
+ (gnus-summary-goto-article gnus-last-article nil t))
(gnus-summary-position-point)))
(defun gnus-summary-pop-article (number)
(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))
"Limit the summary buffer to the next N articles.
If not given a prefix, use the process marked articles instead."
(interactive "P")
- (gnus-set-global-variables)
(prog1
(let ((articles (gnus-summary-work-articles n)))
(setq gnus-newsgroup-processable nil)
"Restore the previous limit.
If given a prefix, remove all limits."
(interactive "P")
- (gnus-set-global-variables)
(when total
(setq gnus-newsgroup-limits
(list (mapcar (lambda (h) (mail-header-number h))
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))
- (gnus-set-global-variables)
+ (interactive "sMarks: \nP")
(prog1
(let ((data gnus-newsgroup-data)
(marks (if (listp marks) marks
(defun gnus-summary-limit-to-score (&optional score)
"Limit to articles with score at or above SCORE."
(interactive "P")
- (gnus-set-global-variables)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
(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 (list (mail-header-id (gnus-summary-article-header))))
+ (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."
+ "Display all the hidden articles that are marked as dormant.
+Note that this command only works on a subset of the articles currently
+fetched for this group."
(interactive)
- (gnus-set-global-variables)
(unless gnus-newsgroup-dormant
(error "There are no dormant articles in this group"))
(prog1
(defun gnus-summary-limit-exclude-dormant ()
"Hide all dormant articles."
(interactive)
- (gnus-set-global-variables)
(prog1
(gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
(gnus-summary-position-point)))
(defun gnus-summary-limit-exclude-childless-dormant ()
"Hide all dormant articles that have no children."
(interactive)
- (gnus-set-global-variables)
(let ((data (gnus-data-list t))
articles d children)
;; Find all articles that are either not dormant or have
'<)
(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 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)))))))))
- ))
+ (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)
+ (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.
If N is negative, go to ancestor -N instead.
The difference between N and the number of articles fetched is returned."
(interactive "p")
- (gnus-set-global-variables)
(let ((skip 1)
error header ref)
(when (not (natnump n))
(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)))
(current (gnus-summary-article-number))
(n 0))
(gnus-summary-position-point)
n)))
-(defun gnus-summary-refer-article (message-id)
- "Fetch an article specified by MESSAGE-ID."
- (interactive "sMessage-ID: ")
+(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")
+ (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'
+or `gnus-select-method', no matter what backend the article comes from."
+ (interactive "sMessage-ID: \nP")
(when (and (stringp message-id)
(not (zerop (length message-id))))
;; Construct the correct Message-ID if necessary.
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
(gnus-summary-article-sparse-p
- (mail-header-number header)))))
- (if header
- (prog1
- ;; The article is present in the buffer, to we just go to it.
- (gnus-summary-goto-article
- (mail-header-number header) nil header)
- (when sparse
- (gnus-summary-update-article (mail-header-number header))))
+ (mail-header-number header))
+ (memq (mail-header-number header)
+ gnus-newsgroup-limit)))
+ h)
+ (cond
+ ;; If the article is present in the buffer we just go to it.
+ ((and header
+ (or (not (gnus-summary-article-sparse-p
+ (mail-header-number header)))
+ sparse))
+ (prog1
+ (gnus-summary-goto-article
+ (mail-header-number header) nil t)
+ (when sparse
+ (gnus-summary-update-article (mail-header-number header)))))
+ (t
;; We fetch the article
(let ((gnus-override-method
- (and (gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method))
+ (cond ((gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method)
+ (arg
+ (or gnus-refer-article-method gnus-select-method))
+ (t nil)))
number)
;; Start the special refer-article method, if necessary.
(when (and gnus-refer-article-method
;; Fetch the header, and display the article.
(if (setq number (gnus-summary-insert-subject message-id))
(gnus-summary-select-article nil nil nil number)
- (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
+ (gnus-message 3 "Couldn't fetch article %s" message-id))))))))
+
+(defun gnus-summary-edit-parameters ()
+ "Edit the group parameters of the current group."
+ (gnus-group-edit-group gnus-newsgroup-name 'params))
(defun gnus-summary-enter-digest-group (&optional force)
"Enter an nndoc group based on the current article.
If FORCE, force a digest interpretation. If not, try
to guess what the document format is."
(interactive "P")
- (gnus-set-global-variables)
(let ((conf gnus-current-window-configuration))
(save-excursion
(gnus-summary-select-article))
gnus-current-article)))
(ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
- (list (cons 'to-group ogroup))))
+ (list (cons 'to-group ogroup))
+ (list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
dig)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
- ;;(goto-char (point-min))
- (isearch-forward regexp-p)))
+ (save-restriction
+ (widen)
+ (isearch-forward regexp-p))))
(defun gnus-summary-search-article-forward (regexp &optional backward)
"Search for an article containing REGEXP forward.
(concat ", default " gnus-last-search-regexp)
"")))
current-prefix-arg))
- (gnus-set-global-variables)
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
(setq gnus-last-search-regexp regexp))
"Search for an article containing REGEXP.
Optional argument BACKWARD means do search for backward.
`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-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)
current-prefix-arg))
(when (equal header "Body")
(setq header ""))
- (gnus-set-global-variables)
;; Hidden thread subtrees must be searched as well.
(gnus-summary-show-all-threads)
;; We don't want to change current point nor window configuration.
(defun gnus-summary-beginning-of-article ()
"Scroll the article back to the beginning."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-min))
- (when gnus-break-pages
+ (when gnus-page-broken
(gnus-narrow-to-page))))
(defun gnus-summary-end-of-article ()
"Scroll to the end of the article."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-max))
(recenter -3)
- (when gnus-break-pages
+ (when gnus-page-broken
(gnus-narrow-to-page))))
-(defun gnus-summary-print-article (&optional filename)
- "Generate and print a PostScript image of the article buffer.
+(defun gnus-summary-print-article (&optional filename n)
+ "Generate and print a PostScript image of the N next (mail) articles.
-If the optional argument FILENAME is nil, send the image to the printer.
-If FILENAME is a string, save the PostScript image in a file with that
-name. If FILENAME is a number, prompt the user for the name of the file
+If N is negative, print the N previous articles. If N is nil and articles
+have been marked with the process mark, print these instead.
+
+If the optional second argument FILENAME is nil, send the image to the
+printer. If FILENAME is a string, save the PostScript image in a file with
+that name. If FILENAME is a number, prompt the user for the name of the file
to save in."
- (interactive (list (ps-print-preprint current-prefix-arg)))
- (gnus-summary-select-article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (let ((buffer (generate-new-buffer " *print*")))
- (unwind-protect
- (progn
- (copy-to-buffer buffer (point-min) (point-max))
- (set-buffer buffer)
- (gnus-article-delete-invisible-text)
- (run-hooks 'gnus-ps-print-hook)
- (ps-print-buffer-with-faces filename))
- (kill-buffer buffer)))))
+ (interactive (list (ps-print-preprint current-prefix-arg)
+ current-prefix-arg))
+ (dolist (article (gnus-summary-work-articles n))
+ (gnus-summary-select-article nil nil 'pseudo article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (let ((buffer (generate-new-buffer " *print*")))
+ (unwind-protect
+ (progn
+ (copy-to-buffer buffer (point-min) (point-max))
+ (set-buffer buffer)
+ (gnus-article-delete-invisible-text)
+ (let ((ps-left-header
+ (list
+ (concat "("
+ (mail-header-subject gnus-current-headers) ")")
+ (concat "("
+ (mail-header-from gnus-current-headers) ")")))
+ (ps-right-header
+ (list
+ "/pagenumberstring load"
+ (concat "("
+ (mail-header-date gnus-current-headers) ")"))))
+ (gnus-run-hooks 'gnus-ps-print-hook)
+ (ps-print-buffer-with-faces filename)))
+ (kill-buffer buffer))))))
(defun gnus-summary-show-article (&optional arg)
"Force re-fetching of the current article.
If ARG (the prefix) is non-nil, show the raw article without any
article massaging functions being run."
(interactive "P")
- (gnus-set-global-variables)
(if (not arg)
;; Select the article the normal way.
(gnus-summary-select-article nil 'force)
gnus-article-display-hook
gnus-article-prepare-hook
gnus-break-pages
+ gnus-show-mime
gnus-visual)
(gnus-summary-select-article nil 'force)))
(gnus-summary-goto-subject gnus-current-article)
- ; (gnus-configure-windows 'article)
(gnus-summary-position-point))
(defun gnus-summary-verbose-headers (&optional arg)
If ARG is a positive number, turn header display on.
If ARG is a negative number, turn header display off."
(interactive "P")
- (gnus-set-global-variables)
(setq gnus-show-all-headers
(cond ((or (not (numberp arg))
(zerop arg))
If ARG is a positive number, show the entire header.
If ARG is a negative number, hide the unwanted header lines."
(interactive "P")
- (gnus-set-global-variables)
(save-excursion
(set-buffer gnus-article-buffer)
(let* ((buffer-read-only nil)
(setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
(insert-buffer-substring gnus-original-article-buffer 1 e)
(let ((article-inhibit-hiding t))
- (run-hooks 'gnus-article-display-hook))
+ (gnus-run-hooks 'gnus-article-display-hook))
(when (or (not hidden) (and (numberp arg) (< arg 0)))
(gnus-article-hide-headers)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
(interactive)
- (gnus-set-global-variables)
(gnus-article-show-all-headers))
(defun gnus-summary-toggle-mime (&optional arg)
"Toggle MIME processing.
If ARG is a positive number, turn MIME processing on."
(interactive "P")
- (gnus-set-global-variables)
(setq gnus-show-mime
(if (null arg) (not gnus-show-mime)
(> (prefix-numeric-value arg) 0)))
The numerical prefix specifies how many places to rotate each letter
forward."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
(defun gnus-summary-stop-page-breaking ()
"Stop page breaking in the current article."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(when (gnus-visual-p 'page-marker)
(let ((buffer-read-only nil))
(gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next)))))
+ (gnus-remove-text-with-property 'gnus-next))
+ (setq gnus-page-broken nil))))
(defun gnus-summary-move-article (&optional n to-newsgroup
select-method action)
(interactive "P")
(unless action
(setq action 'move))
- (gnus-set-global-variables)
;; Disable marking as read.
(let (gnus-mark-article-hook)
(save-window-excursion
(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
((eq action 'copy)
(save-excursion
(set-buffer copy-buf)
- (gnus-request-article-this-buffer article gnus-newsgroup-name)
- (gnus-request-accept-article
- to-newsgroup select-method (not articles))))
+ (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles)))))
;; Crosspost the article.
((eq action 'crosspost)
(let ((xref (message-tokenize-header
(set-buffer copy-buf)
;; First put the article in the destination group.
(gnus-request-article-this-buffer article gnus-newsgroup-name)
- (setq art-group
- (gnus-request-accept-article
- to-newsgroup select-method (not articles)))
- (setq new-xref (concat new-xref " " (car art-group)
- ":" (cdr art-group)))
- ;; Now we have the new Xrefs header, so we insert
- ;; it and replace the new article.
- (nnheader-replace-header "Xref" new-xref)
- (gnus-request-replace-article
- (cdr art-group) to-newsgroup (current-buffer))
- art-group)))))
- (if (not art-group)
- (gnus-message 1 "Couldn't %s article %s"
- (cadr (assq action names)) article)
+ (when (consp (setq art-group
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles))))
+ (setq new-xref (concat new-xref " " (car art-group)
+ ":" (cdr art-group)))
+ ;; Now we have the new Xrefs header, so we insert
+ ;; it and replace the new article.
+ (nnheader-replace-header "Xref" new-xref)
+ (gnus-request-replace-article
+ (cdr art-group) to-newsgroup (current-buffer))
+ art-group))))))
+ (cond
+ ((not art-group)
+ (gnus-message 1 "Couldn't %s article %s"
+ (cadr (assq action names)) article))
+ ((and (eq art-group 'junk)
+ (eq action 'move))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article))
+ (t
(let* ((entry
(or
(gnus-gethash (car art-group) gnus-newsrc-hashtb)
;; Copy the marks to other group.
(gnus-add-marked-articles
to-group (cdar marks) (list to-article) info))
- (setq marks (cdr marks)))))
+ (setq marks (cdr marks)))
+
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (gnus-get-info to-group))
+ ")"))))
;; Update the Xref header in this article to point to
;; the new crossposted article we have just created.
(gnus-request-replace-article
article gnus-newsgroup-name (current-buffer)))))
+ ;;;!!!Why is this necessary?
+ (set-buffer gnus-summary-buffer)
+
(gnus-summary-goto-subject article)
(when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark)))
+ (gnus-summary-mark-article article gnus-canceled-mark))))
(gnus-summary-remove-process-mark article))
;; Re-activate all groups that have been moved to.
(while to-groups
- (gnus-activate-group (pop to-groups)))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (when (gnus-group-goto-group (car to-groups) t)
+ (gnus-group-get-new-news-this-group 1 t))
+ (pop to-groups)))
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(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)
(let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
(cdr (assoc (completing-read "Server name: " ms-alist nil t)
ms-alist))))))))
- (gnus-set-global-variables)
(unless method
(error "No method given for respooling"))
(if (assoc (symbol-name
(defun gnus-summary-import-article (file)
"Import a random file into a mail newsgroup."
(interactive "fImport file: ")
- (gnus-set-global-variables)
(let ((group gnus-newsgroup-name)
(now (current-time))
atts lines)
(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
(interactive)
- (gnus-set-global-variables)
(when (gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name)
;; This backend supports expiry.
;; We need to update the info for
;; this group for `gnus-list-of-read-articles'
;; to give us the right answer.
- (run-hooks 'gnus-exit-group-hook)
+ (gnus-run-hooks 'gnus-exit-group-hook)
(gnus-summary-update-info)
(gnus-list-of-read-articles gnus-newsgroup-name))
(setq gnus-newsgroup-expirable
;; through the expiry process.
(gnus-message 6 "Expiring articles...")
;; The list of articles that weren't expired is returned.
- (if expiry-wait
- (let ((nnmail-expiry-wait-function nil)
- (nnmail-expiry-wait expiry-wait))
- (setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name)))
- (setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name)))
+ (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
This means that *all* articles that are marked as expirable will be
deleted forever, right now."
(interactive)
- (gnus-set-global-variables)
- (or gnus-expert-user
- (gnus-yes-or-no-p
- "Are you really, really, really sure you want to delete all these messages? ")
- (error "Phew!"))
+ (unless gnus-expert-user
+ (gnus-yes-or-no-p
+ "Are you really, really, really sure you want to delete all these messages? ")
+ (error "Phew!"))
(gnus-summary-expire-articles t))
;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
If N is nil and articles have been marked with the process mark,
delete these instead."
(interactive "P")
- (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)
+ (gnus-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))))
+ (gnus-run-hooks 'gnus-visual-mark-article-hook))))
(defun gnus-summary-edit-wash (key)
"Perform editing command in the article buffer."
;;; Respooling
-(defun gnus-summary-respool-query ()
+(defun gnus-summary-respool-query (&optional silent)
"Query where the respool algorithm would put this article."
(interactive)
- (gnus-set-global-variables)
(let (gnus-mark-article-hook)
(gnus-summary-select-article)
(save-excursion
(set-buffer gnus-original-article-buffer)
(save-restriction
(message-narrow-to-head)
- (message "This message would go to %s"
- (mapconcat 'car (nnmail-article-group 'identity) ", "))))))
+ (let ((groups (nnmail-article-group 'identity)))
+ (unless silent
+ (if groups
+ (message "This message would go to %s"
+ (mapconcat 'car groups ", "))
+ (message "This message would go to no groups"))
+ groups))))))
;; Summary marking commands.
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
(interactive "P")
- (gnus-set-global-variables)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((count
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
(interactive "P")
- (gnus-set-global-variables)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((count
the process mark instead. The difference between N and the actual
number of articles marked is returned."
(interactive "p")
- (gnus-set-global-variables)
(let ((backward (< n 0))
(n (abs n)))
(while (and
(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-unmark-all-processable ()
"Remove the process mark from all articles."
(interactive)
- (gnus-set-global-variables)
(save-excursion
(while gnus-newsgroup-processable
(gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-mark-forward n gnus-expirable-mark))
(defun gnus-summary-mark-article-as-replied (article)
(defun gnus-summary-set-bookmark (article)
"Set a bookmark in current article."
(interactive (list (gnus-summary-article-number)))
- (gnus-set-global-variables)
(when (or (not (get-buffer gnus-article-buffer))
(not gnus-current-article)
(not gnus-article-current)
(defun gnus-summary-remove-bookmark (article)
"Remove the bookmark from the current article."
(interactive (list (gnus-summary-article-number)))
- (gnus-set-global-variables)
;; Remove old bookmark, if one exists.
(let ((old (assq article gnus-newsgroup-bookmarks)))
(if old
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-mark-forward n gnus-dormant-mark))
(defun gnus-summary-set-process-mark (article)
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
- (gnus-set-global-variables)
(let ((backward (< n 0))
(gnus-summary-goto-unread
(and gnus-summary-goto-unread
(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")
- (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))
- (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
- (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))
+ (let* ((article (gnus-summary-article-number))
+ (old-mark (gnus-summary-article-mark article)))
+ (if (eq mark old-mark)
+ t
+ (if (<= article 0)
+ (progn
+ (gnus-error 1 "Can't mark negative article numbers")
+ nil)
+ (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))
+ (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
+ (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))
+
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (vectorp (gnus-summary-article-header article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
- ;; See whether the article is to be put in the cache.
- (and gnus-use-cache
- (vectorp (gnus-summary-article-header article))
- (save-excursion
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- (gnus-summary-article-header article)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread))
- t))
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread)
+ t))))
(defun gnus-summary-mark-article (&optional article mark no-expire)
"Mark ARTICLE with MARK. MARK can be any character.
(= mark gnus-duplicate-mark))))
(setq mark gnus-expirable-mark))
(let* ((mark (or mark gnus-del-mark))
- (article (or article (gnus-summary-article-number))))
- (unless article
- (error "No article on current line"))
- (if (or (= mark gnus-unread-mark)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark))
- (gnus-mark-article-as-unread article mark)
- (gnus-mark-article-as-read article mark))
-
- ;; See whether the article is to be put in the cache.
- (and gnus-use-cache
- (not (= mark gnus-canceled-mark))
- (vectorp (gnus-summary-article-header article))
- (save-excursion
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- (gnus-summary-article-header article)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
- (when (gnus-summary-goto-subject article nil t)
- (let ((buffer-read-only nil))
- (gnus-summary-show-thread)
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread)
- t))))
+ (article (or article (gnus-summary-article-number)))
+ (old-mark (gnus-summary-article-mark article)))
+ (if (eq mark old-mark)
+ t
+ (unless article
+ (error "No article on current line"))
+ (if (not (if (or (= mark gnus-unread-mark)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark))
+ (gnus-mark-article-as-unread article mark)
+ (gnus-mark-article-as-read article mark)))
+ t
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (not (= mark gnus-canceled-mark))
+ (vectorp (gnus-summary-article-header article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
+
+ (when (gnus-summary-goto-subject article nil t)
+ (let ((buffer-read-only nil))
+ (gnus-summary-show-thread)
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread)
+ t))))))
(defun gnus-summary-update-secondary-mark (article)
"Update the secondary (read, process, cache) mark."
(t gnus-unread-mark))
'replied)
(when (gnus-visual-p 'summary-highlight 'highlight)
- (run-hooks 'gnus-summary-update-hook))
+ (gnus-run-hooks 'gnus-summary-update-hook))
t)
(defun gnus-summary-update-mark (mark type)
(push (cons article mark) gnus-newsgroup-reads)
;; Possibly remove from cache, if that is used.
(when gnus-use-cache
- (gnus-cache-enter-remove-article article))))
+ (gnus-cache-enter-remove-article article))
+ t))
(defun gnus-mark-article-as-unread (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
(let ((mark (or mark gnus-ticked-mark)))
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
- gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
- gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
- gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+ (if (<= article 0)
+ (progn
+ (gnus-error 1 "Can't mark negative article numbers")
+ nil)
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
+ gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
+ 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))))
+ ;; 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)
(defun gnus-summary-mark-below (score mark)
"Mark articles with score less than SCORE with MARK."
(interactive "P\ncMark: ")
- (gnus-set-global-variables)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
(defun gnus-summary-kill-below (&optional score)
"Mark articles with score below SCORE as read."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-mark-below score gnus-killed-mark))
(defun gnus-summary-clear-above (&optional score)
"Clear all marks from articles with score above SCORE."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-mark-above score gnus-unread-mark))
(defun gnus-summary-tick-above (&optional score)
"Tick all articles with score above SCORE."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-mark-above score gnus-ticked-mark))
(defun gnus-summary-mark-above (score mark)
"Mark articles with score over SCORE with MARK."
(interactive "P\ncMark: ")
- (gnus-set-global-variables)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
(defun gnus-summary-limit-include-expunged (&optional no-error)
"Display all the hidden articles that were expunged for low scores."
(interactive)
- (gnus-set-global-variables)
(let ((buffer-read-only nil))
(let ((scored gnus-newsgroup-scored)
headers h)
(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))
in the current summary buffer limitation.
The number of articles marked as read is returned."
(interactive "P")
- (gnus-set-global-variables)
(prog1
(save-excursion
(when (or quietly
(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
gnus-newsgroup-dormant nil))
- (setq gnus-newsgroup-unreads nil))
+ (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable))
;; We actually mark all articles as canceled, which we
;; have to do when using auto-expiry or adaptive scoring.
(gnus-summary-show-all-threads)
"Mark all unticked articles before the current one as read.
If ALL is non-nil, also mark ticked and dormant articles as read."
(interactive "P")
- (gnus-set-global-variables)
(save-excursion
(gnus-save-hidden-threads
(let ((beg (point)))
(defun gnus-summary-catchup-all (&optional quietly)
"Mark all articles in this newsgroup as read."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-catchup t quietly))
(defun gnus-summary-catchup-and-exit (&optional all quietly)
"Mark all articles not marked as unread in this newsgroup as read, then exit.
If prefix argument ALL is non-nil, all articles are marked as read."
(interactive "P")
- (gnus-set-global-variables)
(when (gnus-summary-catchup all quietly nil 'fast)
;; Select next newsgroup or exit.
(if (eq gnus-auto-select-next 'quietly)
(defun gnus-summary-catchup-all-and-exit (&optional quietly)
"Mark all articles in this newsgroup as read, and then exit."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-catchup-and-exit t quietly))
;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
If given a prefix, mark all articles, unread as well as ticked, as
read."
(interactive "P")
- (gnus-set-global-variables)
(save-excursion
(gnus-summary-catchup all))
(gnus-summary-next-article t nil nil t))
(defun gnus-summary-rethread-current ()
"Rethread the thread the current article is part of."
(interactive)
- (gnus-set-global-variables)
(let* ((gnus-show-threads t)
(article (gnus-summary-article-number))
(id (mail-header-id (gnus-summary-article-header)))
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."))
- (gnus-summary-select-article t t nil current-article)
+ (error "No message-id in desired parent"))
+ ;; We don't want the article to be marked as read.
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil current-article))
(set-buffer gnus-original-article-buffer)
(let ((buf (format "%s" (buffer-string))))
(nnheader-temp-write nil
(insert buf)
(goto-char (point-min))
- (if (search-forward-regexp "^References: " nil t)
- (insert message-id " " )
+ (if (re-search-forward "^References: " nil t)
+ (progn
+ (re-search-forward "^[^ \t]" nil t)
+ (forward-line -1)
+ (end-of-line)
+ (insert " " message-id))
(insert "References: " message-id "\n"))
(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-update-article current-article)
(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)
"Toggle showing conversation threads.
If ARG is positive number, turn showing conversation threads on."
(interactive "P")
- (gnus-set-global-variables)
(let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
(setq gnus-show-threads
(if (null arg) (not gnus-show-threads)
(defun gnus-summary-show-all-threads ()
"Show all threads."
(interactive)
- (gnus-set-global-variables)
(save-excursion
(let ((buffer-read-only nil))
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
"Show thread subtrees.
Returns nil if no thread was there to be shown."
(interactive)
- (gnus-set-global-variables)
(let ((buffer-read-only nil)
(orig (point))
;; first goto end then to beg, to have point at beg after let
(defun gnus-summary-hide-all-threads ()
"Hide all thread subtrees."
(interactive)
- (gnus-set-global-variables)
(save-excursion
(goto-char (point-min))
(gnus-summary-hide-thread)
"Hide thread subtrees.
Returns nil if no threads were there to be hidden."
(interactive)
- (gnus-set-global-variables)
(let ((buffer-read-only nil)
(start (point))
(article (gnus-summary-article-number)))
If SILENT, don't output messages."
(interactive "p")
- (gnus-set-global-variables)
(let ((backward (< n 0))
(n (abs n)))
(while (and (> n 0)
Returns the difference between N and the number of skips actually
done."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-next-thread (- n)))
(defun gnus-summary-go-down-thread ()
Returns the difference between N and how many steps down that were
taken."
(interactive "p")
- (gnus-set-global-variables)
(let ((up (< n 0))
(n (abs n)))
(while (and (> n 0)
Returns the difference between N and how many steps down that were
taken."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-down-thread (- n)))
(defun gnus-summary-top-thread ()
"Go to the top of the thread."
(interactive)
- (gnus-set-global-variables)
(while (gnus-summary-go-up-thread))
(gnus-summary-article-number))
If the prefix argument is positive, remove any kinds of marks.
If the prefix argument is negative, tick articles instead."
(interactive "P")
- (gnus-set-global-variables)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((articles (gnus-summary-articles-in-thread)))
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
- (gnus-set-global-variables)
(let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
(article (intern (format "gnus-article-sort-by-%s" predicate)))
(gnus-thread-sort-functions
save those articles instead.
The variable `gnus-default-article-saver' specifies the saver function."
(interactive "P")
- (gnus-set-global-variables)
(let* ((articles (gnus-summary-work-articles n))
(save-buffer (save-excursion
(nnheader-set-temp-buffer " *Gnus Save*")))
If N is nil and any articles have been marked with the process mark,
pipe those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
(gnus-summary-save-article arg t))
(gnus-configure-windows 'pipe))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
(gnus-summary-save-article arg)))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
(gnus-summary-save-article arg)))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-file))
(gnus-summary-save-article arg)))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-write-to-file))
(gnus-summary-save-article arg)))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
(gnus-summary-save-article arg)))
(defun gnus-summary-pipe-message (program)
"Pipe the current article through PROGRAM."
(interactive "sProgram: ")
- (gnus-set-global-variables)
(gnus-summary-select-article)
(let ((mail-header-separator "")
(art-buf (get-buffer gnus-article-buffer)))
(cond ((assq 'execute props)
(gnus-execute-command (cdr (assq 'execute props)))))
(let ((gnus-current-article (gnus-summary-article-number)))
- (run-hooks 'gnus-mark-article-hook)))
+ (gnus-run-hooks 'gnus-mark-article-hook)))
(defun gnus-execute-command (command &optional automatic)
(save-excursion
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
(setq buffer-read-only nil)
- (let ((command (if automatic command (read-string "Command: " command))))
+ (let ((command (if automatic command
+ (read-string "Command: " (cons command 0)))))
(erase-buffer)
(insert "$ " command "\n\n")
(if gnus-view-pseudo-asynchronously
(defun gnus-summary-edit-global-kill (article)
"Edit the \"global\" kill file."
(interactive (list (gnus-summary-article-number)))
- (gnus-set-global-variables)
(gnus-group-edit-global-kill article))
(defun gnus-summary-edit-local-kill ()
"Edit a local kill file applied to the current newsgroup."
(interactive)
- (gnus-set-global-variables)
(setq gnus-current-headers (gnus-summary-article-header))
- (gnus-set-global-variables)
(gnus-group-edit-local-kill
(gnus-summary-article-number) gnus-newsgroup-name))
(not (gnus-summary-article-sparse-p (mail-header-number header))))
;; We have found the header.
header
+ ;; If this is a sparse article, we have to nix out its
+ ;; previous entry in the thread hashtb.
+ (when (and header
+ (gnus-summary-article-sparse-p (mail-header-number header)))
+ (let* ((parent (gnus-parent-id (mail-header-references header)))
+ (thread
+ (and parent
+ (gnus-gethash parent gnus-newsgroup-dependencies))))
+ (when thread
+ (delq (assq header thread) thread))))
;; We have to really fetch the header to this article.
(save-excursion
(set-buffer nntp-server-buffer)
(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."
(when buffers
(map-y-or-n-p
"Update summary buffer %s? "
- (lambda (buf) (switch-to-buffer buf) (gnus-summary-exit))
+ (lambda (buf)
+ (switch-to-buffer buf)
+ (gnus-summary-exit))
buffers)))))
+(gnus-ems-redefine)
+
(provide 'gnus-sum)
(run-hooks 'gnus-sum-load-hook)