Function: nnmaildir--scan

nnmaildir--scan is a byte-compiled function defined in nnmaildir.el.gz.

Signature

(nnmaildir--scan GNAME SCAN-MSGS GROUPS METHOD SRV-DIR SRV-LS)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnmaildir.el.gz
(defun nnmaildir--scan (gname scan-msgs groups _method srv-dir srv-ls)
  (catch 'return
    (let ((36h-ago (time-since 129600))
	  absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls
	  files num dir flist group x)
      (setq absdir (nnmaildir--srvgrp-dir srv-dir gname)
	    nndir (nnmaildir--nndir absdir))
      (unless (file-exists-p absdir)
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "No such directory: " absdir))
	(throw 'return nil))
      (setq tdir (nnmaildir--tmp absdir)
	    ndir (nnmaildir--new absdir)
	    cdir (nnmaildir--cur absdir)
	    nattr (file-attributes ndir)
	    cattr (file-attributes cdir))
      (unless (and (file-exists-p tdir) nattr cattr)
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "Not a maildir: " absdir))
	(throw 'return nil))
      (setq group (nnmaildir--prepare nil gname)
	    pgname (nnmaildir--pgname nnmaildir--cur-server gname))
      (if group
	  (setq isnew nil)
	(setq isnew t
	      group (make-nnmaildir--grp :name gname :index 0))
	(nnmaildir--mkdir nndir)
	(nnmaildir--mkdir (nnmaildir--nov-dir   nndir))
	(nnmaildir--mkdir (nnmaildir--marks-dir nndir)))
      (setq read-only (nnmaildir--param pgname 'read-only)
	    ls (or (nnmaildir--param pgname 'directory-files) srv-ls))
      (unless read-only
	(setq x (file-attribute-device-number (file-attributes tdir)))
	(unless (and (equal x (file-attribute-device-number nattr))
		     (equal x (file-attribute-device-number cattr)))
	  (setf (nnmaildir--srv-error nnmaildir--cur-server)
		(concat "Maildir spans filesystems: " absdir))
	  (throw 'return nil))
	(dolist (file (funcall ls tdir 'full "\\`[^.]" 'nosort))
	  (setq x (file-attributes file))
	  (if (or (> (file-attribute-link-number x) 1)
		  (time-less-p (file-attribute-access-time x) 36h-ago))
	      (delete-file file))))
      (or scan-msgs
	  isnew
	  (throw 'return t))
      (setq nattr (file-attribute-modification-time nattr))
      (if (equal nattr (nnmaildir--grp-new group))
	  (setq nattr nil))
      (if read-only (setq dir (and (or isnew nattr) ndir))
	(when (or isnew nattr)
	  (dolist (file  (funcall ls ndir nil "\\`[^.]" 'nosort))
	    (setq x (concat ndir file))
	    (and (time-less-p (file-attribute-modification-time
			       (file-attributes x))
			      nil)
		 (rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
	  (setf (nnmaildir--grp-new group) nattr))
	(setq cattr (file-attribute-modification-time (file-attributes cdir)))
	(if (equal cattr (nnmaildir--grp-cur group))
	    (setq cattr nil))
	(setq dir (and (or isnew cattr) cdir)))
      (unless dir (throw 'return t))
      (setq files (funcall ls dir nil "\\`[^.]" 'nosort)
	    files (save-match-data
		    (mapcar
		     (lambda (f)
		       (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" f)
		       (cons (match-string 1 f) (match-string 2 f)))
		     files)))
      (when isnew
	(setq num (length files))
	(setf (nnmaildir--grp-flist group) (gnus-make-hashtable num))
	(setf (nnmaildir--grp-mlist group) (gnus-make-hashtable num))
	(setf (nnmaildir--grp-mmth group) (gnus-make-hashtable 1))
	(setq num (nnmaildir--param pgname 'nov-cache-size))
	(if (numberp num) (if (< num 1) (setq num 1))
	  (setq num 16
		cdir (nnmaildir--marks-dir nndir)
		ndir (nnmaildir--subdir cdir "tick")
		cdir (nnmaildir--subdir cdir "read"))
	  (dolist (prefix-suffix files)
	    (let ((prefix (car prefix-suffix))
		  (suffix (cdr prefix-suffix)))
	      ;; increase num for each unread or ticked article
	      (when (or
		     ;; first look for marks in suffix, if it's valid...
		     (when (and (stringp suffix)
				(string-prefix-p ":2," suffix))
		       (or
			(not (string-match-p
			      (string (nnmaildir--mark-to-flag 'read)) suffix))
			(string-match-p
			 (string (nnmaildir--mark-to-flag 'tick)) suffix)))
		     ;; then look in marks directories
		     (not (file-exists-p (concat cdir prefix)))
		     (file-exists-p (concat ndir prefix)))
		(cl-incf num)))))
	(setf (nnmaildir--grp-cache group) (make-vector num nil))
        (let ((inhibit-quit t))
          (puthash gname group groups))
	(or scan-msgs (throw 'return t)))
      (setq flist (nnmaildir--grp-flist group)
	    files (mapcar
		   (lambda (file)
		     (and (null (nnmaildir--flist-art flist (car file)))
			  file))
		   files)
	    files (delq nil files)
	    files (mapcar #'nnmaildir--parse-filename files)
	    files (sort files #'nnmaildir--sort-files))
      (dolist (file files)
	(setq file (if (consp file) file (aref file 3))
	      x (make-nnmaildir--art :prefix (car file) :suffix (cdr file)))
	(nnmaildir--grp-add-art nnmaildir--cur-server group x))
      (if read-only (setf (nnmaildir--grp-new group) nattr)
	(setf (nnmaildir--grp-cur group) cattr)))
    t))