Function: nnmaildir-request-accept-article

nnmaildir-request-accept-article is a byte-compiled function defined in nnmaildir.el.gz.

Signature

(nnmaildir-request-accept-article GNAME &optional SERVER LAST)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnmaildir.el.gz
(defun nnmaildir-request-accept-article (gname &optional server _last)
  (let ((group (nnmaildir--prepare server gname))
	(coding-system-for-write nnheader-file-coding-system)
	(buffer-file-coding-system nil)
	(file-coding-system-alist nil)
	srv-dir dir file time tmpfile curfile 24h article)
    (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))
      (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname)
			      'read-only)
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "Read-only group: " gname))
	(throw 'return nil))
      (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
	    dir (nnmaildir--srvgrp-dir srv-dir gname)
	    time (current-time)
	    file (format-time-string "%s." time))
      (unless (string-equal nnmaildir--delivery-time file)
	(setq nnmaildir--delivery-time file
	      nnmaildir--delivery-count 0))
      (setq file (concat file (format-time-string "M%6N" time)))
      (setq file (concat file nnmaildir--delivery-pid)
	    file (concat file "Q" (number-to-string nnmaildir--delivery-count))
	    file (concat file "." (nnmaildir--system-name))
	    tmpfile (concat (nnmaildir--tmp dir) file)
	    curfile (concat (nnmaildir--cur dir) file ":2,"))
      (when (file-exists-p tmpfile)
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "File exists: " tmpfile))
	(throw 'return nil))
      (when (file-exists-p curfile)
	(setf (nnmaildir--srv-error nnmaildir--cur-server)
	      (concat "File exists: " curfile))
	(throw 'return nil))
      (setq nnmaildir--delivery-count (1+ nnmaildir--delivery-count)
	    24h (run-with-timer 86400 nil
				(lambda ()
				  (nnmaildir--unlink tmpfile)
				  (setf (nnmaildir--srv-error
					  nnmaildir--cur-server)
					"24-hour timer expired")
				  (throw 'return nil))))
      (condition-case nil (add-name-to-file nnmaildir--file tmpfile)
	(error
	 (write-region (point-min) (point-max) tmpfile nil 'no-message nil
		       'excl)
	 (when (fboundp 'unix-sync)
	   (unix-sync)))) ;; no fsync :(
      (cancel-timer 24h)
      (condition-case err
	  (add-name-to-file tmpfile curfile)
	(error
	 (setf (nnmaildir--srv-error nnmaildir--cur-server)
	       (concat "Error linking: " (prin1-to-string err)))
	 (nnmaildir--unlink tmpfile)
	 (throw 'return nil)))
      (nnmaildir--unlink tmpfile)
      (setq article (make-nnmaildir--art :prefix file :suffix ":2,"))
      (if (nnmaildir--grp-add-art nnmaildir--cur-server group article)
	  (cons gname (nnmaildir--art-num article))))))