Function: nnmaildir-request-expire-articles

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

Signature

(nnmaildir-request-expire-articles RANGES &optional GNAME SERVER FORCE)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnmaildir.el.gz
(defun nnmaildir-request-expire-articles (ranges &optional gname server force)
  (let ((no-force (not force))
	(group (nnmaildir--prepare server gname))
	pgname time boundary target dir nlist
	didnt nnmaildir--file nnmaildir-article-file-name
	deactivate-mark)
    (catch 'return
      (unless group
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (if gname (concat "No such group: " gname) "No current group"))
	(throw 'return (gnus-uncompress-range ranges)))
      (setq gname (nnmaildir--grp-name group)
	    pgname (nnmaildir--pgname nnmaildir--cur-server gname))
      (if (nnmaildir--param pgname 'read-only)
	  (throw 'return (gnus-uncompress-range ranges)))
      (setq time (nnmaildir--param pgname 'expire-age))
      (unless time
	(setq time (or (and nnmail-expiry-wait-function
			    (funcall nnmail-expiry-wait-function gname))
		       nnmail-expiry-wait))
	(if (eq time 'immediate)
	    (setq time 0)
	  (if (numberp time)
	      (setq time (round (* time 86400))))))
      (when no-force
	(unless (integerp time) ;; handle 'never
	  (throw 'return (gnus-uncompress-range ranges)))
	(setq boundary (time-since time)))
      (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
	    dir (nnmaildir--srvgrp-dir dir gname)
	    dir (nnmaildir--cur dir)
	    nlist (nnmaildir--grp-nlist group)
	    ranges (reverse ranges))
      (nnmaildir--with-move-buffer
	(nnmaildir--nlist-iterate
	 nlist ranges
	 (lambda (article)
	   (setq nnmaildir--file (nnmaildir--art-prefix article)
		 nnmaildir--file (concat dir nnmaildir--file
					 (nnmaildir--art-suffix article))
		 time (file-attributes nnmaildir--file))
	   (cond
	    ((null time)
	     (nnmaildir--expired-article group article))
	    ((and no-force
		  (time-less-p boundary
			       (file-attribute-modification-time time)))
	     (setq didnt (cons (nnmaildir--art-num article) didnt)))
	    (t
	     (setq nnmaildir-article-file-name nnmaildir--file
		   target (if force nil
			    (save-excursion
			      (save-restriction
				(nnmaildir--param pgname 'expire-group)))))
	     (when (and (stringp target)
			(not (string-equal target pgname))) ;; Move it.
	       (erase-buffer)
	       (nnheader-insert-file-contents nnmaildir--file)
	       (let ((group-art (gnus-request-accept-article
				 target nil nil 'no-encode)))
		 (when (consp group-art)
		   ;; Maybe also copy: dormant forward reply save tick
		   ;; (gnus-add-mark? gnus-request-set-mark?)
		   (gnus-group-mark-article-read target (cdr group-art)))))
	     (if (equal target pgname)
		 ;; Leave it here.
		 (setq didnt (cons (nnmaildir--art-num article) didnt))
	       (nnmaildir--unlink nnmaildir--file)
	       (nnmaildir--expired-article group article))))))
	(erase-buffer))
      didnt)))