Gnus development mailing list
 help / color / mirror / Atom feed
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."


  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).