Function: nnml-request-expire-articles

nnml-request-expire-articles is a byte-compiled function defined in nnml.el.gz.

Signature

(nnml-request-expire-articles ARTICLES GROUP &optional SERVER FORCE)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnml.el.gz
(deffoo nnml-request-expire-articles (articles group &optional server force)
  (nnml-possibly-change-directory group server)
  (let* ((file-name-coding-system nnmail-pathname-coding-system)
	 (active-articles
	  (nnml-directory-articles nnml-current-directory))
	 (is-old t)
	 article rest mod-time number target)
    (nnmail-activate 'nnml)

    (setq active-articles (sort active-articles #'<))
    ;; Articles not listed in active-articles are already gone,
    ;; so don't try to expire them.
    (setq articles (gnus-sorted-intersection articles active-articles))

    (while (and articles is-old)
      (if (and (setq article (nnml-article-to-file
			      (setq number (pop articles))))
	       (setq mod-time (file-attribute-modification-time
			       (file-attributes article)))
	       (nnml-deletable-article-p group number)
	       (setq is-old (nnmail-expired-article-p group mod-time force
						      nnml-inhibit-expiry)))
	  (progn
	    ;; Allow a special target group.
	    (setq target nnmail-expiry-target)
	    (unless (eq target 'delete)
	      (with-temp-buffer
		(nnml-request-article number group server (current-buffer))
		(let (nnml-current-directory
		      nnml-current-group
		      nnml-article-file-alist)
		  (when (functionp target)
		    (setq target (funcall target group)))
		  (when (and target (not (eq target 'delete)))
		    (if (or (gnus-request-group target)
			    (gnus-request-create-group target))
			(nnmail-expiry-target-group target group)
		      (setq target nil)))))
	      ;; Maybe directory is changed during nnmail-expiry-target-group.
	      (nnml-possibly-change-directory group server))
	    (if target
		(progn
		  (nnheader-message 5 "Deleting article %s in %s"
				    number group)
		  (condition-case ()
		      (funcall nnmail-delete-file-function article)
		    (file-error
		     (push number rest)))
		  (setq active-articles (delq number active-articles))
		  (nnml-nov-delete-article group number))
	      (push number rest)))
	(push number rest)))
    (let ((active (nth 1 (assoc-string group nnml-group-alist))))
      (when active
	(setcar active (or (and active-articles
				(apply #'min active-articles))
			   (1+ (cdr active)))))
      (nnmail-save-active nnml-group-alist nnml-active-file))
    (nnml-save-nov)
    (nconc rest articles)))