groups.
If you use %o or %O, reading the active file will be slower and quite
-a bit of extra memory will be used. %D will also worsen performance.
+a bit of extra memory will be used. %D will also worsen performance.
Also note that if you change the format specification to include any
of these specs, you must probably re-start Gnus to see them go into
effect.")
highlight the line according to the `gnus-group-highlight'
variable.")
+(defvar gnus-useful-groups
+ `(("(ding) mailing list mirrored at sunsite.auc.dk"
+ "emacs.ding"
+ (nntp "sunsite.auc.dk"
+ (nntp-address "sunsite.auc.dk")))
+ ("Gnus help group"
+ "gnus-help"
+ (nndoc "gnus-help"
+ (nndoc-article-type mbox)
+ (eval `(nndoc-address
+ ,(let ((file (nnheader-find-etc-directory
+ "gnus-tut.txt" t)))
+ (unless file
+ (error "Couldn't find doc group"))
+ file))))))
+ "Alist of useful group-server pairs.")
+
+(defvar gnus-group-highlight
+ (cond
+ ((not (eq gnus-display-type 'color))
+ '((mailp . bold)
+ ((= unread 0) . italic)))
+ ((eq gnus-background-mode 'dark)
+ `(((and (not mailp) (eq level 1)) .
+ ,(custom-face-lookup "PaleTurquoise" nil nil t))
+ ((and (not mailp) (eq level 2)) .
+ ,(custom-face-lookup "turquoise" nil nil t))
+ ((and (not mailp) (eq level 3)) .
+ ,(custom-face-lookup "MediumTurquoise" nil nil t))
+ ((and (not mailp) (>= level 4)) .
+ ,(custom-face-lookup "DarkTurquoise" nil nil t))
+ ((and mailp (eq level 1)) .
+ ,(custom-face-lookup "aquamarine1" nil nil t))
+ ((and mailp (eq level 2)) .
+ ,(custom-face-lookup "aquamarine2" nil nil t))
+ ((and mailp (eq level 3)) .
+ ,(custom-face-lookup "aquamarine3" nil nil t))
+ ((and mailp (>= level 4)) .
+ ,(custom-face-lookup "aquamarine4" nil nil t))
+ ))
+ (t
+ `(((and (not mailp) (<= level 3)) .
+ ,(custom-face-lookup "ForestGreen" nil nil t))
+ ((and (not mailp) (eq level 4)) .
+ ,(custom-face-lookup "DarkGreen" nil nil t))
+ ((and (not mailp) (eq level 5)) .
+ ,(custom-face-lookup "CadetBlue4" nil nil t))
+ ((and mailp (eq level 1)) .
+ ,(custom-face-lookup "DeepPink3" nil nil t))
+ ((and mailp (eq level 2)) .
+ ,(custom-face-lookup "HotPink3" nil nil t))
+ ((and mailp (eq level 3)) .
+ ,(custom-face-lookup "dark magenta" nil nil t))
+ ((and mailp (eq level 4)) .
+ ,(custom-face-lookup "DeepPink4" nil nil t))
+ ((and mailp (> level 4)) .
+ ,(custom-face-lookup "DarkOrchid4" nil nil t))
+ )))
+ "Controls the highlighting of group buffer lines.
+
+Below is a list of `Form'/`Face' pairs. When deciding how a a
+particular group line should be displayed, each form is
+evaluated. The content of the face field after the first true form is
+used. You can change how those group lines are displayed by
+editing the face field.
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions. Hopefully this will
+change in a future release. For now, you can use the following
+variables in the Lisp expression:
+
+group: The name of the group.
+unread: The number of unread articles in the group.
+method: The select method used.
+mailp: Whether it's a mail group or not.
+level: The level of the group.
+score: The score of the group.
+ticked: The number of ticked articles.")
+
+
;;; Internal variables
+(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
+ "Function for sorting the group buffer.")
+
+(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
+ "Function for sorting the selected groups in the group buffer.")
+
(defvar gnus-group-indentation-function nil)
(defvar gnus-goto-missing-group-function nil)
(defvar gnus-group-update-group-function nil)
-(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
(defvar gnus-group-goto-next-group-function nil
"Function to override finding the next group after listing groups.")
"V" gnus-version
"s" gnus-group-save-newsrc
"z" gnus-group-suspend
- ; "Z" gnus-group-clear-dribble
"q" gnus-group-exit
"Q" gnus-group-quit
"?" gnus-group-describe-briefly
(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
"d" gnus-group-make-directory-group
"h" gnus-group-make-help-group
+ "u" gnus-group-make-useful-group
"a" gnus-group-make-archive-group
"k" gnus-group-make-kiboze-group
"m" gnus-group-make-group
"V" gnus-group-make-empty-virtual
"D" gnus-group-enter-directory
"f" gnus-group-make-doc-group
- "n" gnus-group-make-web-group
+ "w" gnus-group-make-web-group
"r" gnus-group-rename-group
"\177" gnus-group-delete-group
[delete] gnus-group-delete-group)
"r" gnus-group-sort-groups-by-rank
"m" gnus-group-sort-groups-by-method)
+ (gnus-define-keys (gnus-group-sort-map "P" gnus-group-group-map)
+ "s" gnus-group-sort-selected-groups
+ "a" gnus-group-sort-selected-groups-by-alphabet
+ "u" gnus-group-sort-selected-groups-by-unread
+ "l" gnus-group-sort-selected-groups-by-level
+ "v" gnus-group-sort-selected-groups-by-score
+ "r" gnus-group-sort-selected-groups-by-rank
+ "m" gnus-group-sort-selected-groups-by-method)
+
(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
"k" gnus-group-list-killed
"z" gnus-group-list-zombies
"f" gnus-score-flush-cache)
(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
+ "d" gnus-group-describe-group
"f" gnus-group-fetch-faq)
(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
["List all groups matching..." gnus-group-list-all-matching t]
["List active file" gnus-group-list-active t])
("Sort"
- ["Default sort" gnus-group-sort-groups
+ ["Default sort" gnus-group-sort-groups t]
+ ["Sort by method" gnus-group-sort-groups-by-method t]
+ ["Sort by rank" gnus-group-sort-groups-by-rank t]
+ ["Sort by score" gnus-group-sort-groups-by-score t]
+ ["Sort by level" gnus-group-sort-groups-by-level t]
+ ["Sort by unread" gnus-group-sort-groups-by-unread t]
+ ["Sort by name" gnus-group-sort-groups-by-alphabet t])
+ ("Sort process/prefixed"
+ ["Default sort" gnus-group-sort-selected-groups
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by method" gnus-group-sort-groups-by-method
+ ["Sort by method" gnus-group-sort-selected-groups-by-method
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by rank" gnus-group-sort-groups-by-rank
+ ["Sort by rank" gnus-group-sort-selected-groups-by-rank
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by score" gnus-group-sort-groups-by-score
+ ["Sort by score" gnus-group-sort-selected-groups-by-score
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by level" gnus-group-sort-groups-by-level
+ ["Sort by level" gnus-group-sort-selected-groups-by-level
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by unread" gnus-group-sort-groups-by-unread
+ ["Sort by unread" gnus-group-sort-selected-groups-by-unread
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by name" gnus-group-sort-groups-by-alphabet
+ ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
(or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
("Mark"
["Mark group" gnus-group-mark-group
["Add the help group" gnus-group-make-help-group t]
["Add the archive group" gnus-group-make-archive-group t]
["Make a doc group" gnus-group-make-doc-group t]
+ ["Make a web group" gnus-group-make-web-group t]
["Make a kiboze group" gnus-group-make-kiboze-group t]
["Make a virtual group" gnus-group-make-empty-virtual t]
["Add a group to a virtual" gnus-group-add-to-virtual t]
["Previous unread" gnus-group-prev-unread-group t]
["Next unread same level" gnus-group-next-unread-group-same-level t]
["Previous unread same level"
- gnus-group-previous-unread-group-same-level t]
+ gnus-group-prev-unread-group-same-level t]
["Jump to group" gnus-group-jump-to-group t]
["First unread group" gnus-group-first-unread-group t]
["Best unread group" gnus-group-best-unread-group t])
["Send a bug report" gnus-bug t]
["Send a mail" gnus-group-mail t]
["Post an article..." gnus-group-post-news t]
- ["Customize score file" gnus-score-customize t]
["Check for new news" gnus-group-get-new-news t]
["Activate all groups" gnus-activate-all-groups t]
["Delete bogus groups" gnus-group-check-bogus-groups t]
unread (cdr gnus-group-list-mode)))
(setq level (gnus-group-default-level level))
(gnus-group-setup-buffer) ;May call from out of group buffer
- (gnus-update-format-specifications)
+ (gnus-update-format-specifications nil 'group 'group-mode)
(let ((case-fold-search nil)
(props (text-properties-at (gnus-point-at-bol)))
(group (gnus-group-group-name)))
(defun gnus-group-insert-group-line-info (group)
"Insert GROUP on the current line."
(let ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (gnus-group-indentation (gnus-group-group-indentation))
active info)
(if entry
(progn
;; Insert the text.
(eval gnus-group-line-format-spec))
`(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
- gnus-unread ,(if (numberp number)
- (string-to-int gnus-tmp-number-of-unread)
- t)
- gnus-marked ,gnus-tmp-marked-mark
- gnus-indentation ,gnus-group-indentation
- gnus-level ,gnus-tmp-level))
+ gnus-unread ,(if (numberp number)
+ (string-to-int gnus-tmp-number-of-unread)
+ t)
+ gnus-marked ,gnus-tmp-marked-mark
+ gnus-indentation ,gnus-group-indentation
+ gnus-level ,gnus-tmp-level))
(when (inline (gnus-visual-p 'group-highlight 'highlight))
(forward-line -1)
(run-hooks 'gnus-group-update-hook)
(setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
(defun gnus-group-universal-argument (arg &optional groups func)
- "Perform any command on all groups accoring to the process/prefix convention."
+ "Perform any command on all groups according to the process/prefix convention."
(interactive "P")
(let ((groups (or groups (gnus-group-process-prefix arg)))
- group func)
+ func)
(if (eq (setq func (or func
(key-binding
(read-key-sequence
'undefined)
(gnus-error 1 "Undefined key")
(while groups
- (gnus-group-remove-mark (setq group (pop groups)))
+ (gnus-group-remove-mark (pop groups))
(command-execute func))))
(gnus-group-position-point))
(gnus-group-prefixed-name group method))))
(gnus-sethash
group
- `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method
- ((quit-config . ,(if quit-config quit-config
- (cons (current-buffer) 'summary))))))
+ `(-1 nil (,group
+ ,gnus-level-default-subscribed nil nil ,method
+ ((quit-config .
+ ,(if quit-config quit-config
+ (cons gnus-summary-buffer
+ gnus-current-window-configuration))))))
gnus-newsrc-hashtb)
(set-buffer gnus-group-buffer)
(unless (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
(when activate
+ (gnus-activate-group group 'scan t)
(unless (gnus-request-group group)
(error "Couldn't request group: %s"
- (nnheader-get-report (car method))))
- (gnus-activate-group group nil t))
+ (nnheader-get-report (car method)))))
(if request-only
group
(condition-case ()
(when (equal group "")
(error "Empty group name"))
- (when (string-match "[\000-\032]" group)
- (error "Control characters in group: %s" group))
-
- (let ((b (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
- (unless (gnus-ephemeral-group-p group)
- (if b
- ;; Either go to the line in the group buffer...
- (goto-char b)
- ;; ... or insert the line.
- (or
- t ;; Don't activate group.
- (gnus-active group)
- (gnus-activate-group group)
- (error "%s error: %s" group (gnus-status-message group)))
-
- (gnus-group-update-group group)
- (goto-char (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
- ;; Adjust cursor point.
- (gnus-group-position-point)))
+ (unless (gnus-ephemeral-group-p group)
+ ;; Either go to the line in the group buffer...
+ (unless (gnus-group-goto-group group)
+ ;; ... or insert the line.
+ (gnus-group-update-group group)
+ (gnus-group-goto-group group)))
+ ;; Adjust cursor point.
+ (gnus-group-position-point))
(defun gnus-group-goto-group (group &optional far)
"Goto to newsgroup GROUP.
(interactive)
(gnus-enter-server-buffer))
-(defun gnus-group-make-group (name &optional method address)
+(defun gnus-group-make-group (name &optional method address args)
"Add a new newsgroup.
The user will be prompted for a NAME, for a select METHOD, and an
ADDRESS."
(require backend))
(gnus-check-server meth)
(and (gnus-check-backend-function 'request-create-group nname)
- (gnus-request-create-group nname))
+ (gnus-request-create-group nname nil args))
t))
(defun gnus-group-delete-group (group &optional force)
(format
"Do you really want to delete %s%s? "
group (if force " and all its contents" ""))))
- () ; Whew!
+ () ; Whew!
(gnus-message 6 "Deleting group %s..." group)
(if (not (gnus-request-delete-group group force))
(gnus-error 3 "Couldn't delete group %s" group)
(gnus-group-update-group (or new-group group))
(gnus-group-position-point)))
+(defun gnus-group-make-useful-group (group method)
+ (interactive
+ (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
+ nil t)
+ gnus-useful-groups)))
+ (list (cadr entry) (caddr entry))))
+ (setq method (gnus-copy-sequence method))
+ (let (entry)
+ (while (setq entry (memq (assq 'eval method) method))
+ (setcar entry (eval (cadar entry)))))
+ (gnus-group-make-group group method))
+
(defun gnus-group-make-help-group ()
"Create the Gnus documentation group."
(interactive)
- (let ((path load-path)
- (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
- file dir)
- (and (gnus-gethash name gnus-newsrc-hashtb)
- (error "Documentation group already exists"))
- (while path
- (setq dir (file-name-as-directory (expand-file-name (pop path)))
- file nil)
- (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
- (file-exists-p
- (setq file (concat (file-name-directory
- (directory-file-name dir))
- "etc/gnus-tut.txt"))))
- (setq path nil)))
+ (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
+ (file (nnheader-find-etc-directory "gnus-tut.txt" t))
+ dir)
+ (when (gnus-gethash name gnus-newsrc-hashtb)
+ (error "Documentation group already exists"))
(if (not file)
(gnus-message 1 "Couldn't find doc group")
(gnus-group-make-group
char found)
(while (not found)
(message
- "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
+ "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: "
err)
(setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
((= char ?b) 'babyl)
'gnus-group-web-search-history))
(method
`(nnweb ,group (nnweb-search ,search)
- (nnweb-type ,(intern type)))))
+ (nnweb-type ,(intern type))
+ (nnweb-ephemeral-p t))))
(if solid
- (gnus-group-make-group group method)
+ (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search))
(gnus-group-read-ephemeral-group
group method t
(cons (current-buffer)
(defun gnus-group-sort-groups (func &optional reverse)
"Sort the group buffer according to FUNC.
If REVERSE, reverse the sorting order."
- (interactive (list gnus-group-sort-function
- current-prefix-arg))
- (let ((func (cond
- ((not (listp func)) func)
- ((null func) func)
- ((= 1 (length func)) (car func))
- (t `(lambda (t1 t2)
- ,(gnus-make-sort-function
- (reverse func)))))))
- ;; We peel off the dummy group from the alist.
- (when func
- (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
- (pop gnus-newsrc-alist))
- ;; Do the sorting.
- (setq gnus-newsrc-alist
- (sort gnus-newsrc-alist func))
- (when reverse
- (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
- ;; Regenerate the hash table.
- (gnus-make-hashtable-from-newsrc-alist)
- (gnus-group-list-groups))))
+ (interactive (list gnus-group-sort-function current-prefix-arg))
+ (funcall gnus-group-sort-alist-function
+ (gnus-make-sort-function func) reverse)
+ (gnus-group-list-groups))
+
+(defun gnus-group-sort-flat (func reverse)
+ ;; We peel off the dummy group from the alist.
+ (when func
+ (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
+ (pop gnus-newsrc-alist))
+ ;; Do the sorting.
+ (setq gnus-newsrc-alist
+ (sort gnus-newsrc-alist func))
+ (when reverse
+ (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
+ ;; Regenerate the hash table.
+ (gnus-make-hashtable-from-newsrc-alist)))
(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
"Sort the group buffer alphabetically by group name.
(interactive "P")
(gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
+;;; Selected group sorting.
+
+(defun gnus-group-sort-selected-groups (n func &optional reverse)
+ "Sort the process/prefixed groups."
+ (interactive (list current-prefix-arg gnus-group-sort-function))
+ (let ((groups (gnus-group-process-prefix n)))
+ (funcall gnus-group-sort-selected-function
+ groups (gnus-make-sort-function func) reverse)
+ (gnus-group-list-groups)))
+
+(defun gnus-group-sort-selected-flat (groups func reverse)
+ (let (entries infos)
+ ;; First find all the group entries for these groups.
+ (while groups
+ (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb))
+ entries))
+ ;; Then sort the infos.
+ (setq infos
+ (sort
+ (mapcar
+ (lambda (entry) (car entry))
+ (setq entries (nreverse entries)))
+ func))
+ (when reverse
+ (setq infos (nreverse infos)))
+ ;; Go through all the infos and replace the old entries
+ ;; with the new infos.
+ (while infos
+ (setcar entries (pop infos))
+ (pop entries))
+ ;; Update the hashtable.
+ (gnus-make-hashtable-from-newsrc-alist)))
+
+(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse)
+ "Sort the group buffer alphabetically by group name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse))
+
+(defun gnus-group-sort-selected-groups-by-unread (&optional reverse)
+ "Sort the group buffer by number of unread articles.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse))
+
+(defun gnus-group-sort-selected-groups-by-level (&optional reverse)
+ "Sort the group buffer by group level.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse))
+
+(defun gnus-group-sort-selected-groups-by-score (&optional reverse)
+ "Sort the group buffer by group score.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse))
+
+(defun gnus-group-sort-selected-groups-by-rank (&optional reverse)
+ "Sort the group buffer by group rank.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse))
+
+(defun gnus-group-sort-selected-groups-by-method (&optional reverse)
+ "Sort the group buffer alphabetically by backend name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse))
+
+;;; Sorting predicates.
+
(defun gnus-group-sort-by-alphabet (info1 info2)
"Sort alphabetically."
(string< (gnus-info-group info1) (gnus-info-group info2)))
expirable
(gnus-compress-sequence
(if expiry-wait
- ;; We set the expiry variables to the groupp
+ ;; We set the expiry variables to the group
;; parameter.
(let ((nnmail-expiry-wait-function nil)
(nnmail-expiry-wait expiry-wait))
(setq entry (gnus-gethash group gnus-newsrc-hashtb)))
(gnus-undo-register
`(progn
- (gnus-group-goto-group ,(gnus-group-group-name))
- (gnus-group-yank-group)))
+ (gnus-group-goto-group ,(gnus-group-group-name))
+ (gnus-group-yank-group)))
(push (cons (car entry) (nth 2 entry))
gnus-list-of-killed-groups))
(gnus-group-change-level
(gnus-group-insert-group-line-info group)
(gnus-undo-register
`(when (gnus-group-goto-group ,group)
- (gnus-group-kill-group 1))))
+ (gnus-group-kill-group 1))))
(forward-line -1)
(gnus-group-position-point)
(if (< (length out) 2) (car out) (nreverse out))))
\"hard\" re-reading of the active files from all servers."
(interactive "P")
(run-hooks 'gnus-get-new-news-hook)
+
+ ;; Read any slave files.
+ (unless gnus-slave
+ (gnus-master-read-slave-newsrc))
+
;; We might read in new NoCeM messages here.
(when (and gnus-use-nocem
(null arg))
(setq desc (gnus-group-get-description group))
(gnus-read-descriptions-file method))
(gnus-message 1
- (or desc (gnus-gethash group gnus-description-hashtb)
- "No description available")))))
+ (or desc (gnus-gethash group gnus-description-hashtb)
+ "No description available")))))
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-group-describe-all-groups (&optional force)
(sort (nconc (gnus-uncompress-range (cdr m))
(copy-sequence articles)) '<) t))))))
-(defun gnus-update-read-articles (group unread)
- "Update the list of read articles in GROUP."
- (let* ((active (or gnus-newsgroup-active (gnus-active group)))
- (entry (gnus-gethash group gnus-newsrc-hashtb))
- (info (nth 2 entry))
- (prev 1)
- (unread (sort (copy-sequence unread) '<))
- read)
- (if (or (not info) (not active))
- ;; There is no info on this group if it was, in fact,
- ;; killed. Gnus stores no information on killed groups, so
- ;; there's nothing to be done.
- ;; One could store the information somewhere temporarily,
- ;; perhaps... Hmmm...
- ()
- ;; Remove any negative articles numbers.
- (while (and unread (< (car unread) 0))
- (setq unread (cdr unread)))
- ;; Remove any expired article numbers
- (while (and unread (< (car unread) (car active)))
- (setq unread (cdr unread)))
- ;; Compute the ranges of read articles by looking at the list of
- ;; unread articles.
- (while unread
- (if (/= (car unread) prev)
- (setq read (cons (if (= prev (1- (car unread))) prev
- (cons prev (1- (car unread)))) read)))
- (setq prev (1+ (car unread)))
- (setq unread (cdr unread)))
- (when (<= prev (cdr active))
- (setq read (cons (cons prev (cdr active)) read)))
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ,info ,(gnus-info-marks info))
- (gnus-info-set-read ,info ,(gnus-info-read info))
- (gnus-get-unread-articles-in-group ,info (gnus-active ,group))))
- ;; Enter this list into the group info.
- (gnus-info-set-read
- info (if (> (length read) 1) (nreverse read) read))
- ;; Set the number of unread articles in gnus-newsrc-hashtb.
- (gnus-get-unread-articles-in-group info (gnus-active group))
- t)))
-
(provide 'gnus-group)
;;; gnus-group.el ends here
projects / gnus / blobdiff