Function: nnmaildir-request-update-info

nnmaildir-request-update-info is a byte-compiled function defined in nnmaildir.el.gz.

Signature

(nnmaildir-request-update-info GNAME INFO &optional SERVER)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnmaildir.el.gz
(defun nnmaildir-request-update-info (gname info &optional server)
  (let* ((group (nnmaildir--prepare server gname))
	 (curdir (nnmaildir--cur
		  (nnmaildir--srvgrp-dir
		   (nnmaildir--srv-dir nnmaildir--cur-server) gname)))
	 (curdir-mtime (file-attribute-modification-time (file-attributes curdir)))
	 pgname flist always-marks never-marks old-marks dir
	 all-marks marks ranges markdir read ls
	 old-mmth new-mmth mtime existing missing deactivate-mark)
    (catch 'return
      (unless group
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "No such group: " gname))
	(throw 'return nil))
      (setq gname (nnmaildir--grp-name group)
	    pgname (nnmaildir--pgname nnmaildir--cur-server gname)
	    flist (nnmaildir--grp-flist group))
      (when (zerop (nnmaildir--grp-count group))
	(setf (gnus-info-read info) nil)
	(gnus-info-set-marks info nil 'extend)
	(throw 'return info))
      (setq old-marks (cons 'read (gnus-info-read info))
	    old-marks (cons old-marks (gnus-info-marks info))
	    always-marks (nnmaildir--param pgname 'always-marks)
	    never-marks (nnmaildir--param pgname 'never-marks)
	    existing (nnmaildir--grp-nlist group)
	    existing (mapcar #'car existing)
	    existing (nreverse existing)
	    existing (range-compress-list existing)
	    missing (list (cons 1 (nnmaildir--group-maxnum
				   nnmaildir--cur-server group)))
	    missing (range-difference missing existing)
	    dir (nnmaildir--srv-dir nnmaildir--cur-server)
	    dir (nnmaildir--srvgrp-dir dir gname)
	    dir (nnmaildir--nndir dir)
	    dir (nnmaildir--marks-dir dir)
            ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
            all-marks (seq-uniq
		       ;; get mark names from mark dirs and from flag
		       ;; mappings
		       (append
			(mapcar #'cdr nnmaildir-flag-mark-mapping)
			(mapcar #'intern (funcall ls dir nil "\\`[^.]" 'nosort))))
	    new-mmth (make-hash-table :size (length all-marks))
	    old-mmth (nnmaildir--grp-mmth group))
      (dolist (mark all-marks)
	(setq markdir (nnmaildir--subdir dir (symbol-name mark))
	      ranges nil)
	(catch 'got-ranges
	  (if (memq mark never-marks) (throw 'got-ranges nil))
	  (when (memq mark always-marks)
	    (setq ranges existing)
	    (throw 'got-ranges nil))
	  ;; Find the mtime for this mark.  If this mark can be expressed as
	  ;; a filename flag, get the later of the mtimes for markdir and
	  ;; curdir, otherwise only the markdir counts.
	  (setq mtime
		(let ((markdir-mtime (file-attribute-modification-time (file-attributes markdir))))
		  (cond
		   ((null (nnmaildir--mark-to-flag mark))
		    markdir-mtime)
		   ((null markdir-mtime)
		    curdir-mtime)
		   ((null curdir-mtime)
		    ;; this should never happen...
		    markdir-mtime)
		   ((time-less-p markdir-mtime curdir-mtime)
		    curdir-mtime)
		   (t
		    markdir-mtime))))
	  (puthash mark mtime new-mmth)
	  (when (time-equal-p mtime (gethash mark old-mmth))
	    (setq ranges (assq mark old-marks))
	    (if ranges (setq ranges (cdr ranges)))
	    (throw 'got-ranges nil))
	  (let ((article-list nil))
	    ;; Consider the article marked if it either has the flag in the
	    ;; filename, or is in the markdir.  As you'd rarely remove a
	    ;; flag/mark, this should avoid losing information in the most
	    ;; common usage pattern.
	    (or
	     (let ((flag (nnmaildir--mark-to-flag mark)))
	       ;; If this mark has a corresponding maildir flag...
	       (when flag
		 (let ((regexp
			(concat "\\`[^.].*:2,[A-Z]*" (string flag))))
		   ;; ...then find all files with that flag.
		   (dolist (filename (funcall ls curdir nil regexp 'nosort))
		     (let* ((prefix (car (split-string filename ":2,")))
			    (article (nnmaildir--flist-art flist prefix)))
		       (when article
			 (push (nnmaildir--art-num article) article-list)))))))
	     ;; Also check Gnus-specific mark directory, if it exists.
	     (when (file-directory-p markdir)
	       (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
		 (let ((article (nnmaildir--flist-art flist prefix)))
		   (when article
		     (push (nnmaildir--art-num article) article-list))))))
	    (setq ranges (range-add-list ranges (sort article-list #'<)))))
	(if (eq mark 'read) (setq read ranges)
	  (if ranges (setq marks (cons (cons mark ranges) marks)))))
      (setf (gnus-info-read info) (range-concat read missing))
      (gnus-info-set-marks info marks 'extend)
      (setf (nnmaildir--grp-mmth group) new-mmth)
      info)))