:type '(choice (const :tag "disable")
integer))
+(defcustom gnus-summary-default-high-score 0
+ "*Default threshold for a high scored article.
+An article will be highlighted as high scored if its score is greater
+than this score."
+ :group 'gnus-score-default
+ :type 'integer)
+
+(defcustom gnus-summary-default-low-score 0
+ "*Default threshold for a low scored article.
+An article will be highlighted as low scored if its score is smaller
+than this score."
+ :group 'gnus-score-default
+ :type 'integer)
+
(defcustom gnus-summary-zcore-fuzz 0
"*Fuzziness factor for the zcore in the summary buffer.
Articles with scores closer than this to `gnus-summary-default-score'
(defcustom gnus-summary-highlight
'(((= mark gnus-canceled-mark)
. gnus-summary-cancelled-face)
- ((and (> score default)
+ ((and (> score default-high)
(or (= mark gnus-dormant-mark)
(= mark gnus-ticked-mark)))
. gnus-summary-high-ticked-face)
- ((and (< score default)
+ ((and (< score default-low)
(or (= mark gnus-dormant-mark)
(= mark gnus-ticked-mark)))
. gnus-summary-low-ticked-face)
((or (= mark gnus-dormant-mark)
(= mark gnus-ticked-mark))
. gnus-summary-normal-ticked-face)
- ((and (> score default) (= mark gnus-ancient-mark))
+ ((and (> score default-high) (= mark gnus-ancient-mark))
. gnus-summary-high-ancient-face)
- ((and (< score default) (= mark gnus-ancient-mark))
+ ((and (< score default-low) (= mark gnus-ancient-mark))
. gnus-summary-low-ancient-face)
((= mark gnus-ancient-mark)
. gnus-summary-normal-ancient-face)
- ((and (> score default) (= mark gnus-unread-mark))
+ ((and (> score default-high) (= mark gnus-unread-mark))
. gnus-summary-high-unread-face)
- ((and (< score default) (= mark gnus-unread-mark))
+ ((and (< score default-low) (= mark gnus-unread-mark))
. gnus-summary-low-unread-face)
- ((and (memq article gnus-newsgroup-incorporated)
- (= mark gnus-unread-mark))
- . gnus-summary-incorporated-face)
((= mark gnus-unread-mark)
. gnus-summary-normal-unread-face)
- ((and (> score default) (memq mark (list gnus-downloadable-mark
+ ((and (> score default-high) (memq mark (list gnus-downloadable-mark
gnus-undownloaded-mark)))
. gnus-summary-high-unread-face)
- ((and (< score default) (memq mark (list gnus-downloadable-mark
+ ((and (< score default-low) (memq mark (list gnus-downloadable-mark
gnus-undownloaded-mark)))
. gnus-summary-low-unread-face)
- ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
+ ((and (memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
+ (memq article gnus-newsgroup-unreads))
. gnus-summary-normal-unread-face)
- ((> score default)
+ ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
+ . gnus-summary-normal-read-face)
+ ((> score default-high)
. gnus-summary-high-read-face)
- ((< score default)
+ ((< score default-low)
. gnus-summary-low-read-face)
(t
. gnus-summary-normal-read-face))
You can use the following variables in the FORM field.
-score: The articles score
-default: The default article score.
-below: The score below which articles are automatically marked as read.
-mark: The articles mark."
+score: The article's score
+default: The default article score.
+default-high: The default score for high scored articles.
+default-low: The default score for low scored articles.
+below: The score below which articles are automatically marked as read.
+mark: The articles mark."
:group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
:group 'gnus-summary
:type 'regexp)
+(defcustom gnus-read-all-available-headers nil
+ "Whether Gnus should parse all headers made available to it.
+This is mostly relevant for slow backends where the user may
+wish to widen the summary buffer to include all headers
+that were fetched. Say, for nnultimate groups."
+ :group 'gnus-summary
+ :type '(choice boolean regexp))
;;; Internal variables
"S" gnus-summary-limit-include-expunged
"C" gnus-summary-catchup
"H" gnus-summary-catchup-to-here
+ "h" gnus-summary-catchup-from-here
"\C-c" gnus-summary-catchup-all
"k" gnus-summary-kill-same-subject-and-select
"K" gnus-summary-kill-same-subject
["Fetch current thread" gnus-summary-refer-thread t]
["Fetch article with id..." gnus-summary-refer-article t]
["Setup Mailing List Params" gnus-mailing-list-insinuate t]
- ["Redisplay" gnus-summary-show-article t])))
+ ["Redisplay" gnus-summary-show-article t]
+ ["Raw article" gnus-summary-show-raw-article t])))
(easy-menu-define
gnus-summary-article-menu gnus-summary-mode-map ""
(cons "Article" innards))
'(:help "Mark unread articles in this group as read"))]
["Catchup all" gnus-summary-catchup-all t]
["Catchup to here" gnus-summary-catchup-to-here t]
+ ["Catchup from here" gnus-summary-catchup-from-here t]
["Catchup region" gnus-summary-mark-region-as-read t]
["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
("Mark Various"
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
(let ((params (gnus-group-find-parameter group))
+ (vars '(quit-config)) ; Ignore quit-config.
elem)
(while params
(setq elem (car params)
(and (consp elem) ; Has to be a cons.
(consp (cdr elem)) ; The cdr has to be a list.
(symbolp (car elem)) ; Has to be a symbol in there.
- (not (memq (car elem) '(quit-config))) ; Ignore quit-config.
+ (not (memq (car elem) vars))
(ignore-errors ; So we set it.
+ (push (car elem) vars)
(make-local-variable (car elem))
(set (car elem) (eval (nth 1 elem))))))))
(setq thread (gnus-remove-thread id)))
(setq old-pos (gnus-point-at-bol))
(setq current (save-excursion
- (and (zerop (forward-line -1))
+ (and (re-search-backward "[\r\n]" nil t)
(gnus-summary-article-number))))
;; If this is a gathered thread, we have to go some re-gathering.
(when (stringp (car thread))
;; Subject.
(progn
(goto-char p)
- (if (search-forward "\nsubject: " nil t)
+ (if (search-forward "\nsubject:" nil t)
(nnheader-header-value)
"(none)"))
;; From.
(progn
(goto-char p)
- (if (or (search-forward "\nfrom: " nil t)
- (search-forward "\nfrom:" nil t))
+ (if (search-forward "\nfrom:" nil t)
(nnheader-header-value)
"(nobody)"))
;; Date.
(progn
(goto-char p)
- (if (search-forward "\ndate: " nil t)
- (nnheader-header-value)
- ""))
+ (if (search-forward "\ndate:" nil t)
+ (nnheader-header-value) ""))
;; Message-ID.
(progn
(goto-char p)
;; References.
(progn
(goto-char p)
- (if (search-forward "\nreferences: " nil t)
+ (if (search-forward "\nreferences:" nil t)
(progn
(setq end (point))
(prog1
;; Get the references from the in-reply-to header if there
;; were no references and the in-reply-to header looks
;; promising.
- (if (and (search-forward "\nin-reply-to: " nil t)
+ (if (and (search-forward "\nin-reply-to:" nil t)
(setq in-reply-to (nnheader-header-value))
(string-match "<[^>]+>" in-reply-to))
(let (ref2)
;; Xref.
(progn
(goto-char p)
- (and (search-forward "\nxref: " nil t)
+ (and (search-forward "\nxref:" nil t)
(nnheader-header-value)))
;; Extra.
(when gnus-extra-headers
(while extra
(goto-char p)
(when (search-forward
- (concat "\n" (symbol-name (car extra)) ": ") nil t)
+ (concat "\n" (symbol-name (car extra)) ":") nil t)
(push (cons (car extra) (nnheader-header-value)) out))
(pop extra))
out))))
(mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
(cur nntp-server-buffer)
(dependencies (or dependencies gnus-newsgroup-dependencies))
+ (allp (cond
+ ((eq gnus-read-all-available-headers t)
+ t)
+ ((stringp gnus-read-all-available-headers)
+ (string-match gnus-read-all-available-headers group))
+ (t
+ nil)))
number headers header)
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(while (not (eobp))
(condition-case ()
- (while (and sequence (not (eobp)))
+ (while (and (or sequence allp)
+ (not (eobp)))
(setq number (read cur))
- (while (and sequence
- (< (car sequence) number))
- (setq sequence (cdr sequence)))
- (and sequence
- (eq number (car sequence))
- (progn
- (setq sequence (cdr sequence))
- (setq header (inline
- (gnus-nov-parse-line
- number dependencies force-new))))
- (push header headers))
+ (when (not allp)
+ (while (and sequence
+ (< (car sequence) number))
+ (setq sequence (cdr sequence))))
+ (when (and (or allp
+ (and sequence
+ (eq number (car sequence))))
+ (progn
+ (setq sequence (cdr sequence))
+ (setq header (inline
+ (gnus-nov-parse-line
+ number dependencies force-new)))))
+ (push header headers))
(forward-line 1))
(error
(gnus-error 4 "Strange nov line (%d)"
(nreverse headers)
;;;!!! FIXME: temporary fix for an infloop on nnimap.
(if (eq 'nnimap (car (gnus-find-method-for-group group)))
- (when (gnus-retrieve-headers sequence group)
+ (when (eq (gnus-retrieve-headers sequence group) 'headers)
(gnus-get-newsgroup-headers))
(gnus-retrieve-parsed-headers sequence group))))))))
(gnus-summary-position-point))))
(defun gnus-summary-limit-include-thread (id)
- "Display all the hidden articles that in the current thread."
+ "Display all the hidden articles that is in the thread with ID in it.
+When called interactively, ID is the Message-ID of the current
+article."
(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-limit-include-matching-articles
+ "subject"
+ (regexp-quote (gnus-simplify-subject-re
+ (mail-header-subject (gnus-id-to-header id)))))
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-include-matching-articles (header regexp)
+ "Display all the hidden articles that have HEADERs that match REGEXP."
+ (interactive (list (read-string "Match on header: ")
+ (read-string "Regexp: ")))
+ (let ((articles (gnus-find-matching-articles header regexp)))
+ (prog1
+ (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
(gnus-summary-position-point))))
(defun gnus-summary-limit-include-dormant ()
(gnus-summary-position-point)
t)))
+(defun gnus-find-matching-articles (header regexp)
+ "Return a list of all articles that match REGEXP on HEADER.
+This search includes all articles in the current group that Gnus has
+fetched headers for, whether they are displayed or not."
+ (let ((articles nil)
+ (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
+ (case-fold-search t))
+ (dolist (header gnus-newsgroup-headers)
+ (when (string-match regexp (funcall func header))
+ (push (mail-header-number header) articles)))
+ (nreverse articles)))
+
(defun gnus-summary-find-matching (header regexp &optional backward unread
not-case-fold)
"Return a list of all articles that match REGEXP on HEADER.
If UNREAD is non-nil, only unread articles will
be taken into consideration. If NOT-CASE-FOLD, case won't be folded
in the comparisons."
- (let ((data (if (eq backward 'all) gnus-newsgroup-data
- (gnus-data-find-list
- (gnus-summary-article-number) (gnus-data-list backward))))
- (case-fold-search (not not-case-fold))
+ (let ((case-fold-search (not not-case-fold))
articles d func)
(if (consp header)
(if (eq (car header) 'extra)
(unless (fboundp (intern (concat "mail-header-" header)))
(error "%s is not a valid header" header))
(setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
- (while data
- (setq d (car data))
- (and (or (not unread) ; We want all articles...
- (gnus-data-unread-p d)) ; Or just unreads.
- (vectorp (gnus-data-header d)) ; It's not a pseudo.
- (string-match regexp (funcall func (gnus-data-header d))) ; Match.
- (push (gnus-data-number d) articles)) ; Success!
- (setq data (cdr data)))
+ (dolist (d (if (eq backward 'all)
+ gnus-newsgroup-data
+ (gnus-data-find-list
+ (gnus-summary-article-number)
+ (gnus-data-list backward))))
+ (when (and (or (not unread) ; We want all articles...
+ (gnus-data-unread-p d)) ; Or just unreads.
+ (vectorp (gnus-data-header d)) ; It's not a pseudo.
+ (string-match regexp
+ (funcall func (gnus-data-header d)))) ; Match.
+ (push (gnus-data-number d) articles))) ; Success!
(nreverse articles)))
(defun gnus-summary-execute-command (header regexp command &optional backward)
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-position-point))
+(defun gnus-summary-show-raw-article ()
+ "Show the raw article without any article massaging functions being run."
+ (interactive)
+ (gnus-summary-show-article t))
+
(defun gnus-summary-verbose-headers (&optional arg)
"Toggle permanent full header display.
If ARG is a positive number, turn header display on.
(erase-buffer)
(nnheader-insert-file-contents file)
(goto-char (point-min))
- (unless (nnheader-article-p)
+ (if (nnheader-article-p)
+ (save-restriction
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (narrow-to-region (point-min) (1- (point)))
+ (goto-char (point-min))
+ (unless (re-search-forward "^date:" nil t)
+ (goto-char (point-max))
+ (insert "Date: " (message-make-date (nth 5 atts)) "\n")))
;; This doesn't look like an article, so we fudge some headers.
(setq atts (file-attributes file)
lines (count-lines (point-min) (point-max)))
(gnus-summary-position-point)
t))))
-(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
+(defun gnus-summary-catchup (&optional all quietly to-here not-mark reverse)
"Mark all unread articles in this newsgroup as read.
If prefix argument ALL is non-nil, ticked and dormant articles will
also be marked as read.
If QUIETLY is non-nil, no questions will be asked.
If TO-HERE is non-nil, it should be a point in the buffer. All
-articles before this point will be marked as read.
+articles before (after, if REVERSE is set) this point will be marked as read.
Note that this function will only catch up the unread article
in the current summary buffer limitation.
The number of articles marked as read is returned."
;; We actually mark all articles as canceled, which we
;; have to do when using auto-expiry or adaptive scoring.
(gnus-summary-show-all-threads)
- (when (gnus-summary-first-subject (not all) t)
- (while (and
- (if to-here (< (point) to-here) t)
- (gnus-summary-mark-article-as-read gnus-catchup-mark)
- (gnus-summary-find-next (not all) nil nil t))))
+ (if (and to-here reverse)
+ (progn
+ (goto-char to-here)
+ (while (and
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)
+ (gnus-summary-find-next (not all) nil nil t))))
+ (when (gnus-summary-first-subject (not all) t)
+ (while (and
+ (if to-here (< (point) to-here) t)
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)
+ (gnus-summary-find-next (not all) nil nil t)))))
(gnus-set-mode-line 'summary))
t))
(gnus-summary-position-point)))
(gnus-summary-catchup all t beg)))))
(gnus-summary-position-point))
+(defun gnus-summary-catchup-from-here (&optional all)
+ "Mark all unticked articles after the current one as read.
+If ALL is non-nil, also mark ticked and dormant articles as read."
+ (interactive "P")
+ (save-excursion
+ (gnus-save-hidden-threads
+ (let ((beg (point)))
+ ;; We check that there are unread articles.
+ (when (or all (gnus-summary-find-next))
+ (gnus-summary-catchup all t beg nil t)))))
+ (gnus-summary-position-point))
+
(defun gnus-summary-catchup-all (&optional quietly)
"Mark all articles in this newsgroup as read."
(interactive "P")
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
(gnus-summary-save-article arg t))
- (gnus-configure-windows 'pipe))
+ (let ((buffer (get-buffer "*Shell Command Output*")))
+ (if (and buffer
+ (with-current-buffer buffer (> (point-max) (point-min))))
+ (gnus-configure-windows 'pipe))))
(defun gnus-summary-save-article-mail (&optional arg)
"Append the current article to an mail file.
(mark (or (gnus-summary-article-mark) gnus-unread-mark))
(inhibit-read-only t))
;; Eval the cars of the lists until we find a match.
- (let ((default gnus-summary-default-score))
+ (let ((default gnus-summary-default-score)
+ (default-high gnus-summary-default-high-score)
+ (default-low gnus-summary-default-low-score))
(while (and list
(not (eval (caar list))))
(setq list (cdr list))))
(defun gnus-offer-save-summaries ()
"Offer to save all active summary buffers."
- (save-excursion
- (let ((buflist (buffer-list))
- buffers bufname)
- ;; Go through all buffers and find all summaries.
- (while buflist
- (and (setq bufname (buffer-name (car buflist)))
- (string-match "Summary" bufname)
- (save-excursion
- (set-buffer bufname)
- ;; We check that this is, indeed, a summary buffer.
- (and (eq major-mode 'gnus-summary-mode)
- ;; Also make sure this isn't bogus.
- gnus-newsgroup-prepared
- ;; Also make sure that this isn't a dead summary buffer.
- (not gnus-dead-summary-mode)))
- (push bufname buffers))
- (setq buflist (cdr buflist)))
- ;; Go through all these summary buffers and offer to save them.
- (when buffers
+ (let (buffers)
+ ;; Go through all buffers and find all summaries.
+ (dolist (buffer (buffer-list))
+ (when (and (setq buffer (buffer-name buffer))
+ (string-match "Summary" buffer)
+ (save-excursion
+ (set-buffer buffer)
+ ;; We check that this is, indeed, a summary buffer.
+ (and (eq major-mode 'gnus-summary-mode)
+ ;; Also make sure this isn't bogus.
+ gnus-newsgroup-prepared
+ ;; Also make sure that this isn't a
+ ;; dead summary buffer.
+ (not gnus-dead-summary-mode))))
+ (push buffer buffers)))
+ ;; Go through all these summary buffers and offer to save them.
+ (when buffers
+ (save-excursion
(map-y-or-n-p
"Update summary buffer %s? "
(lambda (buf)
(incf i))
(if (not new)
(message "No gnus is bad news.")
+ (setq new (nreverse new))
(gnus-summary-insert-articles new)
(setq gnus-newsgroup-unreads
(append gnus-newsgroup-unreads new))
projects / elisp / gnus.git- / blobdiff