Function: nnmaildir-request-set-mark

nnmaildir-request-set-mark is a byte-compiled function defined in nnmaildir.el.gz.

Signature

(nnmaildir-request-set-mark GNAME ACTIONS &optional SERVER)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnmaildir.el.gz
(defun nnmaildir-request-set-mark (gname actions &optional server)
  (let* ((group (nnmaildir--prepare server gname))
	 (curdir (nnmaildir--cur
		  (nnmaildir--srvgrp-dir
		   (nnmaildir--srv-dir nnmaildir--cur-server)
		   gname)))
	 (coding-system-for-write nnheader-file-coding-system)
	 (buffer-file-coding-system nil)
	 (file-coding-system-alist nil)
	 marksdir nlist
	 ranges all-marks todo-marks mdir mfile
	 pgname ls permarkfile deactivate-mark
	 (del-mark
	  (lambda (mark)
	    (let ((prefix (nnmaildir--art-prefix nnmaildir--article))
		  (suffix (nnmaildir--art-suffix nnmaildir--article))
		  (flag (nnmaildir--mark-to-flag mark)))
	      (when flag
		;; If this mark corresponds to a flag, remove the flag from
		;; the file name.
		(nnmaildir--article-set-flags
		 nnmaildir--article (nnmaildir--remove-flag flag suffix)
		 curdir))
	      ;; We still want to delete the hardlink in the marks dir if
	      ;; present, regardless of whether this mark has a maildir flag or
	      ;; not, to avoid getting out of sync.
	      (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
		    mfile (concat mfile prefix))
	      (nnmaildir--unlink mfile))))
	 (del-action (lambda (article)
		       (let ((nnmaildir--article article))
			 (mapcar del-mark todo-marks))))
	 (add-action
	  (lambda (article)
	    (mapcar
	     (lambda (mark)
	       (let ((prefix (nnmaildir--art-prefix article))
		     (suffix (nnmaildir--art-suffix article))
		     (flag (nnmaildir--mark-to-flag mark)))
		 (if flag
		     ;; If there is a corresponding maildir flag, just rename
		     ;; the file.
		     (nnmaildir--article-set-flags
		      article (nnmaildir--add-flag flag suffix) curdir)
		   ;; Otherwise, use nnmaildir-specific marks dir.
		   (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
			 permarkfile (concat mdir ":")
			 mfile (concat mdir prefix))
		   (nnmaildir--condcase err (add-name-to-file permarkfile mfile)
		     (cond
		      ((nnmaildir--eexist-p err))
		      ((nnmaildir--enoent-p err)
		       (nnmaildir--mkdir mdir)
		       (nnmaildir--mkfile permarkfile)
		       (add-name-to-file permarkfile mfile))
		      ((nnmaildir--emlink-p err)
		       (let ((permarkfilenew (concat permarkfile "{new}")))
			 (nnmaildir--mkfile permarkfilenew)
			 (rename-file permarkfilenew permarkfile 'replace)
			 (add-name-to-file permarkfile mfile)))
		      (t (signal (car err) (cdr err))))))))
	     todo-marks)))
	 (set-action (lambda (article)
		       (funcall add-action article)
		       (let ((nnmaildir--article article))
			 (mapcar (lambda (mark)
				   (unless (memq mark todo-marks)
				     (funcall del-mark mark)))
				 all-marks)))))
    (catch 'return
      (unless group
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "No such group: " gname))
	(dolist (action actions)
	  (setq ranges (range-concat ranges (car action))))
	(throw 'return ranges))
      (setq nlist (nnmaildir--grp-nlist group)
	    marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
	    marksdir (nnmaildir--srvgrp-dir marksdir gname)
	    marksdir (nnmaildir--nndir marksdir)
	    marksdir (nnmaildir--marks-dir marksdir)
	    gname (nnmaildir--grp-name group)
            pgname (nnmaildir--pgname nnmaildir--cur-server gname)
            ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
	    all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
            all-marks (seq-uniq
		       ;; get mark names from mark dirs and from flag
		       ;; mappings
		       (append
			(mapcar #'cdr nnmaildir-flag-mark-mapping)
			(mapcar #'intern all-marks))))
      (dolist (action actions)
	(setq ranges (car action)
	      todo-marks (caddr action))
	(dolist (mark todo-marks)
	  (cl-pushnew mark all-marks :test #'equal))
	(if (numberp (cdr ranges)) (setq ranges (list ranges)))
	(nnmaildir--nlist-iterate nlist ranges
				  (cond ((eq 'del (cadr action)) del-action)
					((eq 'add (cadr action)) add-action)
					((eq 'set (cadr action)) set-action))))
      nil)))