From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/16120 Path: main.gmane.org!not-for-mail From: Mike McEwan Newsgroups: gmane.emacs.gnus.general Subject: Re: Marking new unread articles differently? Date: 19 Aug 1998 01:52:13 +0100 Sender: owner-ding@hpc.uh.edu Message-ID: References: NNTP-Posting-Host: coloc-standby.netfonds.no Mime-Version: 1.0 (generated by tm-edit 7.108) Content-Type: text/plain; charset=US-ASCII X-Trace: main.gmane.org 1035155043 25957 80.91.224.250 (20 Oct 2002 23:04:03 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sun, 20 Oct 2002 23:04:03 +0000 (UTC) Return-Path: Original-Received: from gwyn.tux.org (gwyn.tux.org [207.96.122.8]) by altair.xemacs.org (8.9.1/8.9.1) with ESMTP id SAA25987 for ; Tue, 18 Aug 1998 18:01:56 -0700 Original-Received: from sina.hpc.uh.edu (Sina.HPC.UH.EDU [129.7.3.5]) by gwyn.tux.org (8.8.8/8.8.8) with ESMTP id UAA06069 for ; Tue, 18 Aug 1998 20:55:24 -0400 Original-Received: from sina.hpc.uh.edu (lists@Sina.HPC.UH.EDU [129.7.3.5]) by sina.hpc.uh.edu (8.7.3/8.7.3) with ESMTP id TAK01494; Tue, 18 Aug 1998 19:55:23 -0500 (CDT) Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Tue, 18 Aug 1998 19:53:23 -0500 (CDT) Original-Received: from sclp3.sclp.com (root@sclp3.sclp.com [209.195.19.139]) by sina.hpc.uh.edu (8.7.3/8.7.3) with ESMTP id TAA01476 for ; Tue, 18 Aug 1998 19:53:06 -0500 (CDT) Original-Received: from post.mail.demon.net (post-11.mail.demon.net [194.217.242.40]) by sclp3.sclp.com (8.8.5/8.8.5) with SMTP id UAA09281 for ; Tue, 18 Aug 1998 20:52:56 -0400 (EDT) Original-Received: from (lotusland.demon.co.uk) [158.152.62.156] by post.mail.demon.net with smtp (Exim 1.82 #2) id 0z8wUa-0001Az-00; Wed, 19 Aug 1998 00:52:49 +0000 Original-Received: from mike by lotusland.demon.co.uk with local (Exim 2.02 #1) id 0z8wU1-00011l-00 for ding@gnus.org; Wed, 19 Aug 1998 01:52:13 +0100 Original-To: ding@gnus.org In-Reply-To: (Jari Aalto+list.ding)'s message of "16 Aug 1998 21:30:17 +0300" Original-Lines: 838 X-Mailer: Gnus v5.6.37/XEmacs 20.4 - "Emerald" Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:16120 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:16120 (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."