From: Mike McEwan <mike@lotusland.demon.co.uk>
Subject: Re: Marking new unread articles differently?
Date: 19 Aug 1998 01:52:13 +0100 [thread overview]
Message-ID: <m3n291iyiq.fsf@lotusland.demon.co.uk> (raw)
In-Reply-To: <jari.aalto@poboxes.com> (Jari Aalto+list.ding)'s message of "16 Aug 1998 21:30:17 +0300"
<jari.aalto@poboxes.com> (Jari Aalto+list.ding) writes:
> Oh, please do. Sounds like a *very* usefull features.
> jari
Wow, one interested person :-)
Well here's the patch (against gnus-5.6.37). Sorry, I reckon it's
got quite big now.
Anyways, if you apply it and you're `agentized' (I don't think it's
of much benefit to those who read online all the time), just add:
(setq gnus-mark-new-headers 't)
(setq gnus-mark-downloaded 't)
to your ~/.gnus or whatever and a `%a' somewhere in your
`gnus-group-line-format' - probably best at the end - it's a ten
character-width field. To view only threads with new/downloaded
headers do a `C-M-n', only new/downloaded do `C-u C-M-n'. All
new/downloaded marks are removed when exiting a group, optionally
they can be removed with `G n' (remove marks from this group), or `G
N' (remove marks from all groups). See the minimal doc in the patch
text for clues. `new' marks will be present for *all* unread articles
the *first* time with `gnus-mark-new-headers, I think.
A couple of little things not covered in my previous mail to this
list are the group parameter `dont-copy-marks' which when added to a
group does exactly what it implies in respect of articles copied
from other groups - no marks, apart from a `new' mark, are copied
across. Also, sometimes when I've had articles queued in my `drafts'
group ready for sending, I forget to send them because the `nndraft'
group line doesn't show in the group buffer until I do a `g'.
There's a couple of little kludges in here to make these groups show
when there's something in them.
I've probably gone a little wild here. You know how it is - start
with a little function here, a tweak there :-). My functions aren't
prefixed with `my-gnus..' either, but there just weren't enough
hooks! Please note I haven't really used this with offline news
reading, it's still a little rough I think. I'd appreciate hearing
what folks think. I'll provide some more doc if folks are
confused.Lars d'you think we (the off-liners anyway) could have
something like this?
--
Mike.
diff -ur gnus-orig/lisp/gnus-agent.el gnus/lisp/gnus-agent.el
--- gnus-orig/lisp/gnus-agent.el Sun Aug 16 17:59:43 1998
+++ gnus/lisp/gnus-agent.el Sun Aug 16 21:27:47 1998
@@ -333,7 +333,13 @@
(concat "^" (regexp-quote mail-header-separator) "\n"))
(replace-match "\n")
(gnus-agent-insert-meta-information 'mail)
- (gnus-request-accept-article "nndraft:queue")))
+ (gnus-request-accept-article "nndraft:queue")
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-group-update-group "nndraft:queue")
+ (save-excursion
+ (gnus-group-goto-group "nndraft:queue" t)
+ (gnus-group-get-new-news-this-group 1 t)))))
(defun gnus-agent-insert-meta-information (type &optional method)
"Insert meta-information into the message that says how it's to be posted.
@@ -782,7 +788,7 @@
(gnus-agent-enter-history "last-header-fetched-for-session"
(list (cons group (nth (- (length articles) 1) articles)))
(gnus-time-to-day (current-time)))
- t)))))
+ t)))))
(defsubst gnus-agent-copy-nov-line (article)
(let (b e)
@@ -801,7 +807,7 @@
(set-buffer nntp-server-buffer)
(erase-buffer)
(insert-file-contents file)
- (goto-char (point-min))
+ (goto-char (point-max))
(if (or (= (point-min) (point-max))
(progn
(forward-line -1)
@@ -892,7 +898,7 @@
gnus-newsgroup-dependencies gnus-newsgroup-headers
gnus-newsgroup-scored gnus-headers gnus-score
gnus-use-cache articles score arts
- category predicate info marks score-param)
+ category predicate info marks score-param downloaded)
;; Fetch headers.
(when (and (or (gnus-active group) (gnus-activate-group group))
(setq articles (gnus-list-of-unread-articles group))
@@ -925,13 +931,25 @@
(when arts
(gnus-agent-fetch-articles group arts)))
;; Perhaps we have some additional articles to fetch.
- (setq arts (assq 'download (gnus-info-marks
- (setq info (gnus-get-info group)))))
+ (setq info (gnus-get-info group))
+ (setq arts (assq 'download (gnus-info-marks info)))
(when (cdr arts)
(gnus-agent-fetch-articles
group (gnus-uncompress-range (cdr arts)))
- (setq marks (delq arts (gnus-info-marks info)))
- (gnus-info-set-marks info marks))))
+ (if gnus-mark-downloaded
+ (if (setq downloaded (assq 'downloaded
+ (gnus-info-marks info)))
+ (progn
+ (setq downloaded (cons 'downloaded
+ (gnus-add-to-range
+ (cdr downloaded) (cdr arts))))
+ (setq marks (delq arts (gnus-info-marks info))))
+ (setcar arts 'downloaded))
+ (gnus-info-set-marks info marks)))
+ ;; Update group line to indicate the actual number (minus cancellations)
+ ;; of headers downloaded and whether any articles marked with
+ ;; `gnus-downloadable-mark' were downloaded.
+ (gnus-group-update-group group t)))
;;;
;;; Agent Category Mode
diff -ur gnus-orig/lisp/gnus-group.el gnus/lisp/gnus-group.el
--- gnus-orig/lisp/gnus-group.el Sun Aug 16 17:59:44 1998
+++ gnus/lisp/gnus-group.el Tue Aug 18 23:56:48 1998
@@ -160,6 +160,7 @@
%n Select from where (string)
%z A string that look like `<%s:%n>' if a foreign select method is used
%d The date the group was last entered.
+%a The number of newly arrived headers since the group was last selected.
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
where X is the letter following %u. The function will be passed the
@@ -347,6 +348,12 @@
:group 'gnus-group-visual
:type 'character)
+(defcustom gnus-downloaded-mark ?*
+ "Mark used for articles that have been newly
+downloaded via `gnus-downloadable-mark' - `%'."
+ :group 'gnus-summary-marks
+ :type 'character)
+
;;; Internal variables
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
@@ -395,6 +402,7 @@
(?z gnus-tmp-news-method-string ?s)
(?m (gnus-group-new-mail gnus-tmp-group) ?c)
(?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
+ (?a (gnus-new-headers-string gnus-tmp-group) ?s)
(?u gnus-tmp-user-defined ?s)))
(defvar gnus-group-mode-line-format-alist
@@ -426,6 +434,7 @@
"\r" gnus-group-select-group
"\M-\r" gnus-group-quick-select-group
[(meta control return)] gnus-group-select-group-ephemerally
+ "\M-\C-n" gnus-group-select-group-new
"j" gnus-group-jump-to-group
"n" gnus-group-next-unread-group
"p" gnus-group-prev-unread-group
@@ -512,6 +521,8 @@
"w" gnus-group-make-web-group
"r" gnus-group-rename-group
"c" gnus-group-customize
+ "n" gnus-group-clear-new-marks
+ "N" gnus-group-clear-new-marks-all
"\177" gnus-group-delete-group
[delete] gnus-group-delete-group)
@@ -584,6 +595,10 @@
["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
["Catch up all articles" gnus-group-catchup-current-all
(gnus-group-group-name)]
+ ["Remove new article marks" gnus-group-clear-new-marks
+ (when gnus-mark-new-headers (gnus-group-group-name))]
+ ["Remove *all* new marks" gnus-group-clear-new-marks-all
+ (when gnus-mark-new-headers t)]
["Check for new articles" gnus-group-get-new-news-this-group
(gnus-group-group-name)]
["Toggle subscription" gnus-group-unsubscribe-current-group
@@ -1253,8 +1268,15 @@
(get-text-property (gnus-point-at-bol) 'gnus-unread))
(defun gnus-group-new-mail (group)
- (if (nnmail-new-mail-p (gnus-group-real-name group))
- gnus-new-mail-mark
+ (if (not (gnus-news-group-p group))
+ (if (nnmail-new-mail-p (gnus-group-real-name group))
+ gnus-new-mail-mark
+ ? )
+ (gnus-group-downloaded group)))
+
+(defun gnus-group-downloaded (group)
+ (if (assq 'downloaded (gnus-info-marks (gnus-get-info group)))
+ gnus-downloaded-mark
? ))
(defun gnus-group-level (group)
@@ -3369,6 +3391,112 @@
(if (not time)
""
(gnus-time-iso8601 time))))
+
+;;;
+;;; `new' header mark functions
+;;;
+
+(defun gnus-new-headers-string (group)
+ "Return a space padded string of numerics of the form `nnnn(nnnn)'
+where the digits preceding the `(' indicate the number of `new'
+headers that have arrived in the group since the last time it was
+selected. The suffixing space padded `(nnnn)' should only be returned
+for genuine newsgroups, and indicates the number of potentially
+downloadable headers still on the news-server (e.g. after a `g' in the
+group buffer).
+ `n/a' is returned for `nndraft' groups as indicating `new' headers
+doesn't make much sense. Perhaps there are a few other non-applicable
+backends?"
+ (if (eq (car (gnus-find-method-for-group group))
+ 'nndraft)
+ " n/a"
+ (let* ((info (gnus-get-info group))
+ (marks (gnus-info-marks info))
+ (max (cdr (gnus-active group)))
+ (last (gnus-group-get-parameter group 'last))
+ (new (gnus-uncompress-range (cdr (assq 'new marks)))))
+ ;; Group is perhaps not `active'.
+ (when (not max) (setq max 0))
+ (if (and new last)
+ (if (gnus-news-group-p group)
+ (format "%4s(%4s)" (length new) (- max last))
+ (format "%4s" (length new)))
+ (progn
+ (if (and last (gnus-news-group-p group))
+ ;; No new headers, so just indicate those potentially
+ ;; downloadable.
+ (format "%4s(%4s)" "0" (- max last))
+ (if (gnus-news-group-p group)
+ (format "%4s(%4s)" "0" "0")
+ ;; Non newsgroup with no new headers.
+ " 0")))))))
+
+(defun gnus-group-clear-new-marks-all ()
+ "Clear `new' marks from all groups in `gnus-newsrc-alist'."
+ (interactive)
+ (gnus-group-clear-new-marks t))
+
+(defun gnus-group-clear-new-marks (&optional n)
+ "Nullify all `new' header marks in the current newsgroup.
+If N is numeric, marks will be removed from the next N groups.
+If N is non-nil and non-numeric, clear marks from all groups."
+ (interactive "P")
+ (if (or (numberp n) (null n))
+ (let ((groups (gnus-group-process-prefix n)))
+ (unless groups (error "No groups selected"))
+ (while groups
+ (let*
+ ((info (gnus-get-info (car groups)))
+ (marks (gnus-info-marks info)))
+ (gnus-group-remove-mark (car groups))
+ (if (>= (gnus-group-group-level) gnus-level-zombie)
+ (gnus-message 2 "Dead groups can't be cleared of marks")
+ (progn
+ (setq marks (delq (assq 'new marks) marks))
+ (gnus-info-set-marks info marks t))
+ (gnus-group-update-group-line))
+ (setq groups (cdr groups))))
+ (gnus-group-next-unread-group 1)
+ (gnus-message 4 "\"new\" marks cleared"))
+ (let ((groups (mapcar 'car (cdr gnus-newsrc-alist))))
+ (while groups
+ (unless (eq (car (gnus-find-method-for-group (car groups)))
+ 'nndraft)
+ (let*
+ ((info (gnus-get-info (car groups)))
+ (marks (gnus-info-marks info)))
+ (setq marks (delq (assq 'new marks) marks))
+ (gnus-info-set-marks info marks t))
+ (gnus-group-update-group (car groups) t))
+ (setq groups (cdr groups)))
+ (gnus-message 4 "\"new\" marks cleared for all groups"))))
+
+(defun gnus-group-select-group-new (&optional no-threads)
+ "Select this newsgroup asking for threads with new
+headers and/or articles that have been newly downloaded via
+`gnus-downloadable-mark'. If NO-THREADS is non-nil, only
+`new' and/or `downloaded' articles will be displayed."
+ (interactive "P")
+ (let*
+ ((group (gnus-group-group-name))
+ (info (gnus-get-info group))
+ (marks (gnus-info-marks info))
+ (gnus-fetch-old-headers (if no-threads nil t))
+ (new (gnus-uncompress-range (cdr (assq 'new marks))))
+ (downloaded (gnus-uncompress-range (cdr (assq 'downloaded marks)))))
+; (num (+ (length new) (length downloaded))))
+ (when (not gnus-agent)
+ (setq new (gnus-uncompress-range
+ (cons
+ (1+ (gnus-group-get-parameter group 'last))
+ (cdr (gnus-active group))))))
+ (if (or new downloaded)
+ (progn
+ (when downloaded
+ (setq new (append downloaded new)))
+ (gnus-group-read-group nil t nil new))
+ (error "No new messages in group"))))
+
(provide 'gnus-group)
diff -ur gnus-orig/lisp/gnus-int.el gnus/lisp/gnus-int.el
--- gnus-orig/lisp/gnus-int.el Tue Aug 11 18:53:51 1998
+++ gnus/lisp/gnus-int.el Mon Aug 17 20:57:18 1998
@@ -278,11 +278,46 @@
"Request headers for ARTICLES in GROUP.
If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
(let ((gnus-command-method (gnus-find-method-for-group group)))
- (if (and gnus-use-cache (numberp (car articles)))
- (gnus-cache-retrieve-headers articles group fetch-old)
- (funcall (gnus-get-function gnus-command-method 'retrieve-headers)
- articles (gnus-group-real-name group)
- (nth 1 gnus-command-method) fetch-old))))
+ ;; Need to preserve the return value of `nov' or `headers'
+ ;; from the `retrieve-headers' function before optionally
+ ;; counting in `new' headers.
+ (prog1
+ (if (and gnus-use-cache (numberp (car articles)))
+ (gnus-cache-retrieve-headers articles group fetch-old)
+ (funcall (gnus-get-function gnus-command-method 'retrieve-headers)
+ articles (gnus-group-real-name group)
+ (nth 1 gnus-command-method) fetch-old))
+ (when (and gnus-mark-new-headers (eq (car gnus-command-method) 'nntp)
+ (if gnus-agent gnus-plugged t))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-max))
+ (let* ((info (gnus-get-info group))
+ (marks (gnus-info-marks info))
+ (last (gnus-group-get-parameter group 'last))
+ new art)
+ ;; Set `last' if it's not in the group parameters yet.
+ ;; Everything's new, first time through.
+ (when (not last)
+ (setq last
+ (gnus-group-set-parameter group 'last
+ (car (gnus-active group)))))
+ (while (and
+ (= (forward-line -1) 0)
+ (> (setq art (read (current-buffer))) last))
+ (setq new (append new (list art))))
+ (when new
+ ;; Allow new header numbers to accumulate if group
+ ;; has not been selected since the last time headers
+ ;; were retrieved.
+ (progn
+ (setq new (gnus-range-add (cdr (assq 'new marks))
+ (gnus-compress-sequence (nreverse new))))
+ (setq marks (delq (assq 'new marks) marks))
+ (setq marks (append (list (cons 'new new)) marks))
+ (gnus-info-set-marks info marks t))
+ ;; `last' can now be made ready for next time.
+ (gnus-group-set-parameter group 'last (cdr (gnus-active group))))))))))
(defun gnus-retrieve-articles (articles group)
"Request ARTICLES in GROUP."
diff -ur gnus-orig/lisp/gnus-msg.el gnus/lisp/gnus-msg.el
--- gnus-orig/lisp/gnus-msg.el Sun Aug 16 17:59:45 1998
+++ gnus/lisp/gnus-msg.el Sun Aug 16 21:27:48 1998
@@ -962,11 +962,31 @@
(concat "^" (regexp-quote mail-header-separator) "$")
nil t)
(replace-match "" t t ))
- (unless (gnus-request-accept-article group method t)
- (gnus-message 1 "Couldn't store article in group %s: %s"
- group (gnus-status-message method))
- (sit-for 2))
- (kill-buffer (current-buffer))))))))))
+ (let (group-art)
+ (if (setq group-art (gnus-request-accept-article group method t))
+ (when gnus-mark-new-headers
+ (let* ((info (gnus-get-info group))
+ (marks (gnus-info-marks info))
+ (new (cdr (assq 'new marks))))
+ (if new
+ (setq new (gnus-add-to-range new (list (cdr group-art))))
+ (setq new (list (cdr group-art))))
+ (setq marks (delq (assq 'new marks) marks))
+ (setq marks (append (list (cons 'new new)) marks))
+ (gnus-info-set-marks info marks t))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-group-update-group group)
+ (save-excursion
+ (gnus-group-goto-group group t)
+ (gnus-group-get-new-news-this-group 1 t)))
+ ;; `last' can now be made ready for next time.
+ (gnus-group-set-parameter group 'last
+ (cdr (gnus-active group))))
+ (gnus-message 1 "Couldn't store article in group %s: %s"
+ group (gnus-status-message method))
+ (sit-for 2))
+ (kill-buffer (current-buffer)))))))))))
(defun gnus-inews-insert-gcc ()
"Insert Gcc headers based on `gnus-outgoing-message-group'."
diff -ur gnus-orig/lisp/gnus-sum.el gnus/lisp/gnus-sum.el
--- gnus-orig/lisp/gnus-sum.el Sun Aug 16 17:59:46 1998
+++ gnus/lisp/gnus-sum.el Tue Aug 18 01:19:48 1998
@@ -443,6 +443,11 @@
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-new-mark ?N
+ "*Mark used for articles that are new."
+ :group 'gnus-summary-marks
+ :type 'character)
+
(defcustom gnus-unsendable-mark ?=
"*Mark used for articles that won't be sent."
:group 'gnus-summary-marks
@@ -744,12 +749,17 @@
((= mark gnus-unread-mark)
. gnus-summary-normal-unread-face)
((and (> score default) (memq mark (list gnus-downloadable-mark
- gnus-undownloaded-mark)))
+ gnus-undownloaded-mark
+ gnus-downloaded-mark
+ gnus-new-mark)))
. gnus-summary-high-unread-face)
((and (< score default) (memq mark (list gnus-downloadable-mark
- gnus-undownloaded-mark)))
+ gnus-undownloaded-mark
+ gnus-downloaded-mark
+ gnus-new-mark)))
. gnus-summary-low-unread-face)
- ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
+ ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark
+ gnus-downloaded-mark gnus-new-mark))
. gnus-summary-normal-unread-face)
((> score default)
. gnus-summary-high-read-face)
@@ -779,6 +789,16 @@
The function is called with one parameter, the article header vector,
which it may alter in any way.")
+(defcustom gnus-mark-new-headers nil
+ "*If non-nil, mark `new' headers in summary mode with `gnus-new-mark'."
+ :group 'gnus-summary
+ :type 'boolean)
+
+(defcustom gnus-mark-downloaded nil
+ "*If non-nil, mark `new' headers in summary mode with `gnus-new-mark'."
+ :group 'gnus-summary
+ :type 'boolean)
+
;;; Internal variables
(defvar gnus-scores-exclude-files nil)
@@ -930,7 +950,14 @@
"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..")
+ "List of articles in the current newsgroup that haven't been downloaded.")
+
+(defvar gnus-newsgroup-downloaded nil
+ "List of articles in the current newsgroup that have been newly downloaded
+via `gnus-downloadable-mark' - `%'.")
+
+(defvar gnus-newsgroup-new nil
+ "List of articles in the current newsgroup that are new.")
(defvar gnus-newsgroup-unsendable nil
"List of articles in the current newsgroup that won't be sent.")
@@ -975,7 +1002,8 @@
gnus-newsgroup-replied gnus-newsgroup-expirable
gnus-newsgroup-processable gnus-newsgroup-killed
gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
- gnus-newsgroup-unsendable
+ gnus-newsgroup-downloaded
+ gnus-newsgroup-new gnus-newsgroup-unsendable
gnus-newsgroup-bookmarks gnus-newsgroup-dormant
gnus-newsgroup-headers gnus-newsgroup-threads
gnus-newsgroup-prepared gnus-summary-highlight-line-function
@@ -2350,6 +2378,8 @@
(when (gnus-buffer-exists-p gnus-summary-buffer)
(set-buffer gnus-summary-buffer))
(let ((gnus-replied-mark 129)
+ (gnus-new-mark 129)
+ (gnus-downloaded-mark 129)
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
(gnus-download-mark 131)
@@ -2407,6 +2437,10 @@
(gnus-tmp-replied gnus-replied-mark)
((memq gnus-tmp-current gnus-newsgroup-saved)
gnus-saved-mark)
+ ((memq gnus-tmp-current gnus-newsgroup-new)
+ gnus-new-mark)
+ ((memq gnus-tmp-current gnus-newsgroup-downloaded)
+ gnus-downloaded-mark)
(t gnus-unread-mark)))
(gnus-tmp-from (mail-header-from gnus-tmp-header))
(gnus-tmp-name
@@ -3755,6 +3789,10 @@
gnus-replied-mark)
((memq number gnus-newsgroup-saved)
gnus-saved-mark)
+ ((memq number gnus-newsgroup-new)
+ gnus-new-mark)
+ ((memq number gnus-newsgroup-downloaded)
+ gnus-downloaded-mark)
(t gnus-unread-mark))
gnus-tmp-from (mail-header-from gnus-tmp-header)
gnus-tmp-name
@@ -3917,6 +3955,12 @@
(gnus-get-newsgroup-headers)))
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
+ ;; Workaround to re-appraise the `new' header situation if gnus is
+ ;; not `agentized'.
+ (when (not gnus-agent)
+ (setq gnus-newsgroup-new (gnus-uncompress-range
+ (cdr (assq 'new (gnus-info-marks info))))))
+
;; Kludge to avoid having cached articles nixed out in virtual groups.
(when cached
(setq gnus-newsgroup-cached cached))
@@ -4320,6 +4364,8 @@
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
(active (gnus-active group))
+ (marks (gnus-info-marks info))
+ (new (cdr (assq 'new marks)))
range)
(when entry
(setq range (gnus-compute-read-articles group articles))
@@ -4327,12 +4373,24 @@
(set-buffer gnus-group-buffer)
(gnus-undo-register
`(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-marks ',info ',marks 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)
+ ;; Remove Xref'd read articles from
+ ;; `new' ranges.
+ (when new
+ (let ((new (gnus-uncompress-range new)))
+ (while articles
+ (setq new (delq (car articles) new))
+ (setq articles (cdr articles)))
+ (setq marks (delq (assq 'new marks) marks))
+ (setq marks (append (list
+ (cons 'new (gnus-compress-sequence new)))
+ marks))
+ (gnus-info-set-marks info marks)))
;; Then we have to re-compute how many unread
;; articles there are in this group.
(when active
@@ -5070,6 +5128,10 @@
;; Make all changes in this group permanent.
(unless quit-config
(gnus-run-hooks 'gnus-exit-group-hook)
+ (when gnus-mark-new-headers
+ (setq gnus-newsgroup-new nil))
+ (when gnus-mark-downloaded
+ (setq gnus-newsgroup-downloaded nil))
(gnus-summary-update-info)
;; Do adaptive scoring, and possibly save score files.
(when gnus-newsgroup-adaptive
@@ -5992,10 +6054,62 @@
(let ((data gnus-newsgroup-data)
(marks (if (listp marks) marks
(append marks nil))) ; Transform to list.
- articles)
+ articles switch)
(while data
- (when (if reverse (not (memq (gnus-data-mark (car data)) marks))
- (memq (gnus-data-mark (car data)) marks))
+ (when (if reverse (and (not (memq (gnus-data-mark (car data)) marks))
+ (progn
+ (setq switch t)
+ (when (memq '?N marks)
+ (setq switch
+ (not (memq
+ (gnus-data-number (car data))
+ gnus-newsgroup-new))))
+ (when (memq '?> marks)
+ (setq switch
+ (not (memq
+ (gnus-data-number (car data))
+ gnus-newsgroup-downloaded))))
+ (when (and switch (memq '?# marks))
+ (setq switch
+ (not (memq
+ (gnus-data-number (car data))
+ gnus-newsgroup-processable))))
+ (when (and switch (memq '?* marks))
+ (setq switch
+ (not (memq
+ (gnus-data-number (car data))
+ gnus-newsgroup-cached))))
+ (when (and switch (memq '?A marks))
+ (setq switch
+ (not (memq
+ (gnus-data-number (car data))
+ gnus-newsgroup-replied))))
+ (when (and switch (memq '?S marks))
+ (setq switch
+ (not (memq (gnus-data-number (car data))
+ gnus-newsgroup-saved))))
+ switch))
+ (or (memq (gnus-data-mark (car data)) marks)
+ (progn
+ (or
+ (when (memq '?N marks)
+ (memq (gnus-data-number (car data))
+ gnus-newsgroup-new))
+ (when (memq '?> marks)
+ (memq (gnus-data-number (car data))
+ gnus-newsgroup-downloaded))
+ (when (memq '?# marks)
+ (memq (gnus-data-number (car data))
+ gnus-newsgroup-processable))
+ (when (memq '?* marks)
+ (memq (gnus-data-number (car data))
+ gnus-newsgroup-cached))
+ (when (memq '?A marks)
+ (memq (gnus-data-number (car data))
+ gnus-newsgroup-replied))
+ (when (memq '?S marks)
+ (memq (gnus-data-number (car data))
+ gnus-newsgroup-saved))))))
(push (gnus-data-number (car data)) articles))
(setq data (cdr data)))
(gnus-summary-limit articles))
@@ -6998,34 +7112,41 @@
(gnus-find-method-for-group to-newsgroup)))
gnus-newsrc-hashtb)))
(info (nth 2 entry))
- (to-group (gnus-info-group info)))
+ (to-group (gnus-info-group info))
+ (dont-copy-marks
+ (gnus-group-get-parameter to-group 'dont-copy-marks)))
;; Update the group that has been moved to.
(when (and info
(memq action '(move copy)))
(unless (member to-group to-groups)
(push to-group to-groups))
-
- (unless (memq article gnus-newsgroup-unreads)
+
+ (unless (or (memq article gnus-newsgroup-unreads) dont-copy-marks)
(gnus-info-set-read
info (gnus-add-to-range (gnus-info-read info)
(list (cdr art-group)))))
;; Copy any marks over to the new group.
- (let ((marks gnus-article-mark-lists)
- (to-article (cdr art-group)))
-
- ;; See whether the article is to be put in the cache.
- (when gnus-use-cache
- (gnus-cache-possibly-enter-article
- to-group to-article
- (let ((header (copy-sequence
- (gnus-summary-article-header article))))
- (mail-header-set-number header to-article)
- header)
- (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-dormant)
- (memq article gnus-newsgroup-unreads)))
-
+ (let ((marks (if dont-copy-marks '((new . new))
+ gnus-article-mark-lists))
+ (to-article (cdr art-group))
+ (gnus-newsgroup-new
+ (if (or (memq article gnus-newsgroup-unreads)
+ dont-copy-marks) (list article) nil)))
+
+ (unless dont-copy-marks
+ ;; See whether the article is to be put in the cache.
+ (when gnus-use-cache
+ (gnus-cache-possibly-enter-article
+ to-group to-article
+ (let ((header (copy-sequence
+ (gnus-summary-article-header article))))
+ (mail-header-set-number header to-article)
+ header)
+ (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-dormant)
+ (memq article gnus-newsgroup-unreads))))
+
(when (and (equal to-group gnus-newsgroup-name)
(not (memq article gnus-newsgroup-unreads)))
;; Mark this article as read in this group.
@@ -7078,8 +7199,12 @@
(set-buffer gnus-group-buffer)
(when (gnus-group-goto-group (car to-groups) t)
(gnus-group-get-new-news-this-group 1 t))
+ (when gnus-mark-new-headers
+ ;; Reset `last' regardless, in readiness for next time.
+ (gnus-group-set-parameter (car to-groups) 'last
+ (cdr (gnus-active (car to-groups)))))
(pop to-groups)))
-
+
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
@@ -7153,7 +7278,7 @@
(interactive "fImport file: ")
(let ((group gnus-newsgroup-name)
(now (current-time))
- atts lines)
+ atts lines group-art)
(unless (gnus-check-backend-function 'request-accept-article group)
(error "%s does not support article importing" group))
(or (file-readable-p file)
@@ -7179,7 +7304,26 @@
"Message-ID: " (message-make-message-id) "\n"
"Lines: " (int-to-string lines) "\n"
"Chars: " (int-to-string (nth 7 atts)) "\n\n"))
- (gnus-request-accept-article group nil t)
+ (setq group-art (gnus-request-accept-article group nil t))
+ (when gnus-mark-new-headers
+ (let* ((info (gnus-get-info group))
+ (marks (gnus-info-marks info))
+ (new (cdr (assq 'new marks))))
+ (if new
+ (setq new (gnus-add-to-range new (list (cdr group-art))))
+ (setq new (list (cdr group-art))))
+ (setq marks (delq (assq 'new marks) marks))
+ (setq marks (append (list (cons 'new new)) marks))
+ (gnus-info-set-marks info marks t))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-group-update-group group)
+ (save-excursion
+ (gnus-group-goto-group group t)
+ (gnus-group-get-new-news-this-group 1 t)))
+ ;; `last' can now be made ready for next time.
+ (gnus-group-set-parameter group 'last
+ (cdr (gnus-active group))))
(kill-buffer (current-buffer)))))
(defun gnus-summary-article-posted-p ()
@@ -7757,6 +7901,10 @@
gnus-replied-mark)
((memq article gnus-newsgroup-saved)
gnus-saved-mark)
+ ((memq article gnus-newsgroup-new)
+ gnus-new-mark)
+ ((memq article gnus-newsgroup-downloaded)
+ gnus-downloaded-mark)
(t gnus-unread-mark))
'replied)
(when (gnus-visual-p 'summary-highlight 'highlight)
diff -ur gnus-orig/lisp/gnus.el gnus/lisp/gnus.el
--- gnus-orig/lisp/gnus.el Sun Aug 16 17:59:46 1998
+++ gnus/lisp/gnus.el Sun Aug 16 21:27:48 1998
@@ -1463,7 +1463,7 @@
(bookmarks . bookmark) (dormant . dormant)
(scored . score) (saved . save)
(cached . cache) (downloadable . download)
- (unsendable . unsend)))
+ (unsendable . unsend) (new . new) (downloaded . downloaded)))
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
diff -ur gnus-orig/lisp/nnagent.el gnus/lisp/nnagent.el
--- gnus-orig/lisp/nnagent.el Sat Jul 25 01:41:38 1998
+++ gnus/lisp/nnagent.el Sun Aug 16 20:03:12 1998
@@ -110,7 +110,13 @@
(deffoo nnagent-request-post (&optional server)
(gnus-agent-insert-meta-information 'news gnus-command-method)
- (gnus-request-accept-article "nndraft:queue"))
+ (gnus-request-accept-article "nndraft:queue")
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-group-update-group "nndraft:queue")
+ (save-excursion
+ (gnus-group-goto-group "nndraft:queue" t)
+ (gnus-group-get-new-news-this-group 1 t))))
;; Use nnml functions for just about everything.
(nnoo-import nnagent
diff -ur gnus-orig/lisp/nnmail.el gnus/lisp/nnmail.el
--- gnus-orig/lisp/nnmail.el Fri Aug 14 20:42:16 1998
+++ gnus/lisp/nnmail.el Mon Aug 17 01:22:05 1998
@@ -1637,6 +1637,8 @@
(nnmail-get-value "%s-active-file" method))
(when exit-func
(funcall exit-func))
+ (when gnus-mark-new-headers
+ (nnmail-update-new-marks))
(run-hooks 'nnmail-read-incoming-hook)
(nnheader-message 3 "%s: Reading incoming mail...done" method))
;; Close the message-id cache.
@@ -1650,6 +1652,29 @@
(file-exists-p incoming)
(file-writable-p incoming)
(delete-file incoming))))))
+
+(defun nnmail-update-new-marks ()
+ "Update `new' marks in mail groups."
+ (let ((alist (nnmail-get-value "%s-group-alist" (car gnus-command-method)))
+ group)
+ (while (setq group (pop alist))
+ (let*
+ ((max (cdadr group))
+ (group (gnus-group-prefixed-name (car group) gnus-command-method))
+ (info (gnus-get-info group))
+ (marks (gnus-info-marks info))
+ (last (gnus-group-get-parameter group 'last))
+ new-arts new)
+ (when (and max last)
+ (if (> max last)
+ (progn
+ (setq new-arts (cons (1+ last) max))
+ (setq new (gnus-range-add (cdr (assq 'new marks))
+ new-arts))
+ (setq marks (delq (assq 'new marks) marks))
+ (setq marks (append (list (cons 'new new)) marks))
+ (gnus-info-set-marks info marks t)
+ (gnus-group-set-parameter group 'last max))))))))
(defun nnmail-expired-article-p (group time force &optional inhibit)
"Say whether an article that is TIME old in GROUP should be expired."
next prev parent reply other threads:[~1998-08-19 0:52 UTC|newest]
Thread overview: 115+ messages / expand[flat|nested] mbox.gz Atom feed top
1998-08-13 14:39 request: commands for subsribe/unsubsribe from/to mailing lists Jari Aalto+list.ding
[not found] ` <jari.aalto@poboxes.com>
1998-08-13 16:35 ` Jason L Tibbitts III
1998-08-13 16:56 ` Lars Magne Ingebrigtsen
1998-08-13 18:27 ` William M. Perry
1998-08-19 17:30 ` Christopher Davis
1998-08-13 16:41 ` Lars Magne Ingebrigtsen
1998-08-13 17:21 ` Bud Rogers
1998-08-17 13:06 ` Master or slave?? Lars Magne Ingebrigtsen
1998-08-19 0:52 ` Mike McEwan [this message]
1998-08-20 21:23 ` Marking new unread articles differently? Lars Magne Ingebrigtsen
1998-08-21 17:11 ` Mike McEwan
1998-08-21 19:15 ` Lars Magne Ingebrigtsen
1998-08-25 6:25 ` Matt Simmons
1998-08-26 3:46 ` Mike McEwan
1998-08-20 1:26 ` Suggestion: Command to rename all Subejcts in thread Lars Magne Ingebrigtsen
1998-08-20 8:46 ` Jari Aalto+list.ding
1998-08-20 19:41 ` Lars Magne Ingebrigtsen
1998-08-20 21:19 ` 5.6.38 Can't read drafts server? Lars Magne Ingebrigtsen
1998-08-21 6:38 ` Jari Aalto+list.ding
1998-08-21 11:52 ` Karl Kleinpaste
1998-08-21 19:09 ` Lars Magne Ingebrigtsen
1998-08-23 21:20 ` Jari Aalto+list.ding
1998-08-21 19:10 ` pop3 reading with gnus? Lars Magne Ingebrigtsen
1998-08-21 20:05 ` William M. Perry
1998-08-21 19:13 ` Suggestion: *Group* SPC to show only new articles? Lars Magne Ingebrigtsen
1998-08-22 20:57 ` patch: 5.6.38 gnus-uu, new regexp marking commands Lars Magne Ingebrigtsen
1998-08-24 7:30 ` Suggestion: *Group* SPC to show only new articles? Kai Grossjohann
1998-08-24 8:37 ` Jari Aalto+list.ding
1998-08-24 8:48 ` Kai Grossjohann
1998-08-24 10:10 ` Jari Aalto+list.ding
1998-08-24 11:41 ` Kai Grossjohann
1998-08-24 12:20 ` Francisco Solsona
1998-08-24 14:38 ` Mike McEwan
1998-08-25 5:55 ` 5.6.38 Can't read drafts server? Lars Magne Ingebrigtsen
1998-08-25 13:05 ` Jari Aalto+list.ding
1998-08-25 6:11 ` Suggestion: Topic mode get news and topic group indentation level Lars Magne Ingebrigtsen
1998-09-02 14:34 ` Hallvard's gnus-e20/19.34/Pgnus 0.13 emulation (backtrace included) Hrvoje Niksic
1998-09-02 14:35 ` Lars Magne Ingebrigtsen
1998-09-03 21:03 ` Suggestion: to problem nndraft "Can't select group" Lars Magne Ingebrigtsen
1998-09-08 19:38 ` Patch: be verbose if POP3 setup is not ok Lars Magne Ingebrigtsen
1998-09-08 21:04 ` Jari Aalto+list.ding
1998-09-09 11:35 ` Per Abrahamsen
1998-09-09 13:07 ` Jari Aalto+list.ding
1998-10-12 14:07 ` compatibility request -- `q' in *Article* buffer shouldn't quit group Hrvoje Niksic
1998-10-13 12:54 ` Robert Pluim
1998-10-22 13:16 ` I fixed it, but I need Lars ... (Was: *Group* buffer disappearance) Hrvoje Niksic
1998-11-05 18:27 ` Feature req: import/export Group parameter or Server data Simon Josefsson
1998-08-15 19:37 Marking new unread articles differently? Matt Simmons
1998-08-15 20:43 ` Lars Magne Ingebrigtsen
1998-08-15 21:03 ` SL Baur
1998-08-15 22:40 ` Lars Magne Ingebrigtsen
1998-08-15 21:14 ` Harry Putnam
1998-08-25 6:23 ` Matt Simmons
1998-08-15 21:20 ` Eze Ogwuma
1998-08-16 6:05 ` Mike McEwan
1998-08-16 18:30 ` Jari Aalto+list.ding
1998-08-17 9:04 Master or slave?? Andy Eskilsson
[not found] ` <6flnooezsi.fsf@bavur.dna.lth.se>
1998-08-17 11:27 ` Jari Aalto+list.ding
1998-08-17 14:44 ` Andy Eskilsson
1998-08-19 15:57 Suggestion: Command to rename all Subejcts in thread Jari Aalto+list.ding
1998-08-20 20:29 5.6.38 Can't read drafts server? Jari Aalto+list.ding
1998-08-21 9:35 pop3 reading with gnus? jari.aalto
1998-08-21 9:56 ` Jean-Yves Perrier
1998-08-21 10:09 ` Jari Aalto+list.ding
1998-08-21 15:49 Suggestion: *Group* SPC to show only new articles? Jari Aalto+list.ding
1998-08-22 15:12 patch: 5.6.38 gnus-uu, new regexp marking commands Jari Aalto+list.ding
1998-08-24 22:12 Suggestion: Topic mode get news and topic group indentation level Jari Aalto+list.ding
1998-09-02 13:26 Hallvard's gnus-e20/19.34/Pgnus 0.13 emulation (backtrace included) Jari Aalto+list.ding
1998-09-03 15:57 Suggestion: to problem nndraft "Can't select group" Jari Aalto+list.ding
1998-09-03 17:10 ` David S. Goldberg
1998-09-03 17:31 ` Jari Aalto+list.ding
1998-09-08 16:08 Patch: be verbose if POP3 setup is not ok Jari Aalto+list.ding
1998-10-11 6:48 compatibility request -- `q' in *Article* buffer shouldn't quit group SL Baur
1998-10-11 15:29 ` Lars Magne Ingebrigtsen
1998-10-11 17:11 ` Matt Simmons
1998-10-11 17:23 ` Hrvoje Niksic
1998-10-11 19:05 ` SL Baur
1998-10-11 19:11 ` Hrvoje Niksic
1998-10-11 20:40 ` SL Baur
1998-10-11 20:44 ` Hrvoje Niksic
1998-10-11 21:24 ` Karl Kleinpaste
1998-10-11 21:41 ` Hrvoje Niksic
1998-10-11 22:18 ` Kai Grossjohann
1998-10-12 10:08 ` Lloyd Zusman
1998-10-12 13:12 ` Lars Magne Ingebrigtsen
1998-10-12 22:17 ` Lloyd Zusman
1998-10-17 19:21 ` Lars Magne Ingebrigtsen
1998-10-12 13:39 ` Per Abrahamsen
1998-10-12 14:01 ` Jari Aalto+list.ding
1998-10-11 22:13 ` Kai Grossjohann
[not found] ` <6f7ly7i16q.fsf@dna.lth.se>
1998-10-11 15:41 ` Michael Harnois
1998-10-11 15:50 ` Hrvoje Niksic
1998-10-11 16:34 ` Michael Harnois
[not found] ` <6fiuhrgkq1.fsf@dna.lth.se>
1998-10-11 16:36 ` Michael Harnois
1998-10-11 17:08 ` Lars Magne Ingebrigtsen
1998-10-11 17:35 ` Hrvoje Niksic
1998-10-11 17:57 ` Lars Magne Ingebrigtsen
1998-10-11 18:28 ` Julian Assange
1998-10-20 18:26 Pterodactyl Gnus v0.36 is released Lars Magne Ingebrigtsen
1998-10-20 19:27 ` *Group* buffer disappearance (Re: Pterodactyl Gnus v0.36 is released) Lloyd Zusman
1998-10-21 2:58 ` I fixed it, but I need Lars ... (Was: *Group* buffer disappearance) Lloyd Zusman
1998-10-21 12:40 ` Hrvoje Niksic
1998-10-21 13:54 ` Lloyd Zusman
1998-10-21 14:22 ` Hrvoje Niksic
1998-10-21 14:55 ` Lloyd Zusman
1998-10-21 14:59 ` Hrvoje Niksic
1998-10-21 15:07 ` Lloyd Zusman
1998-10-21 15:10 ` Hrvoje Niksic
1998-10-21 15:17 ` Lloyd Zusman
1998-10-21 15:24 ` Hrvoje Niksic
1998-10-21 15:39 ` Lloyd Zusman
1998-10-21 15:48 ` Hrvoje Niksic
1998-10-21 15:56 ` Lee Willis
1998-10-22 13:10 ` Jari Aalto+list.ding
1998-11-05 16:52 Feature req: import/export Group parameter or Server data Jari Aalto+list.ding
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m3n291iyiq.fsf@lotusland.demon.co.uk \
--to=mike@lotusland.demon.co.uk \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).