Function: gnus-update-marks

gnus-update-marks is a byte-compiled function defined in gnus-sum.el.gz.

Signature

(gnus-update-marks)

Documentation

Enter the various lists of marked articles into the newsgroup info list.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-sum.el.gz
(defun gnus-update-marks ()
  "Enter the various lists of marked articles into the newsgroup info list."
  (let ((types gnus-article-mark-lists)
	(info (gnus-get-info gnus-newsgroup-name))
	type list newmarked symbol delta-marks)
    (when info
      ;; Add all marks lists to the list of marks lists.
      (while (setq type (pop types))
	(setq list (symbol-value
		    (setq symbol
			  (intern (format "gnus-newsgroup-%s" (car type))))))

	(when list
	  ;; Get rid of the entries of the articles that have the
	  ;; default score.
	  (when (and (eq (cdr type) 'score)
		     gnus-save-score
		     list)
	    (let* ((arts list)
		   (prev (cons nil list))
		   (all prev))
	      (while arts
		(if (or (not (consp (car arts)))
			(= (cdar arts) gnus-summary-default-score))
		    (setcdr prev (cdr arts))
		  (setq prev arts))
		(setq arts (cdr arts)))
	      (setq list (cdr all)))))

	;; When exiting the group, everything that's previously been
	;; unseen is now seen.
	(when (eq (cdr type) 'seen)
	  (setq list (range-concat list gnus-newsgroup-unseen)))

	(when (eq (gnus-article-mark-to-type (cdr type)) 'list)
	  (setq list (range-compress-list (set symbol (sort list #'<)))))

	(when (and (gnus-check-backend-function
		    'request-set-mark gnus-newsgroup-name)
		   (not (gnus-article-unpropagatable-p (cdr type))))
	  (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
		 ;; Don't do anything about marks for articles we
		 ;; didn't actually get any headers for.
		 (del
		  (range-list-intersection
		   gnus-newsgroup-articles
		   (range-remove (copy-tree old) list)))
		 (add
		  (range-list-intersection
		   gnus-newsgroup-articles
		   (range-remove (copy-tree list) old))))
	    (when add
	      (push (list add 'add (list (cdr type))) delta-marks))
	    (when del
	      ;; Don't delete marks from outside the active range.
	      ;; This shouldn't happen, but is a sanity check.
	      (setq del (range-intersection
			 (gnus-active gnus-newsgroup-name) del))
	      (push (list del 'del (list (cdr type))) delta-marks))))

	(when (or list
		  (eq (cdr type) 'unexist))
	  (push (cons (cdr type) list) newmarked)))

      (when delta-marks
	(unless (gnus-check-group gnus-newsgroup-name)
	  (error "Can't open server for %s" gnus-newsgroup-name))
	(gnus-request-set-mark gnus-newsgroup-name delta-marks))

      ;; Enter these new marks into the info of the group.
      (if (nthcdr 3 info)
	  (setcar (nthcdr 3 info) newmarked)
	;; Add the marks lists to the end of the info.
	(when newmarked
	  (setcdr (nthcdr 2 info) (list newmarked))))

      ;; Cut off the end of the info if there's nothing else there.
      (let ((i 5))
	(while (and (> i 2)
		    (not (nth i info)))
          (when (nthcdr (decf i) info)
	    (setcdr (nthcdr i info) nil)))))))