;; copying, restoring, etc.
;;
;; Todo:
+;; * When moving an article for expiry, copy all the marks except 'expire
+;; from the original article.
;; * Add a hook for when moving messages from new/ to cur/, to support
;; nnmail's duplicate detection.
;; * Improve generated Xrefs, so crossposts are detectable.
(put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
(put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0)
(put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--condcase 'lisp-indent-function 2)
)
]
(setq pos (match-end 0))))
string)
+(defmacro nnmaildir--condcase (errsym body &rest handler)
+ `(condition-case ,errsym
+ (let ((system-messages-locale "C")) ,body)
+ (error . ,handler)))
+
(defun nnmaildir--emlink-p (err)
(and (eq (car err) 'file-error)
- (string= (caddr err) "too many links")))
+ (string= (downcase (caddr err)) "too many links")))
+
+(defun nnmaildir--enoent-p (err)
+ (and (eq (car err) 'file-error)
+ (string= (downcase (caddr err)) "no such file or directory")))
(defun nnmaildir--eexist-p (err)
(eq (car err) 'file-already-exists))
;; and failed.
(signal 'error `("Corrupt internal nnmaildir data" ,path-open)))
(setq path-link (concat numdir (number-to-string number-link)))
- (condition-case err
+ (nnmaildir--condcase err
(progn
(add-name-to-file path-open path-link)
(throw 'return number-link))
- (error
- (cond
- ((nnmaildir--emlink-p err)
- (setq make-new-file t
- number-open number-link))
- ((nnmaildir--eexist-p err)
- (let ((attr (file-attributes path-link)))
- (if (/= (nth 10 attr) ino-open)
- (setq number-open number-link
- number-link 0))))
- (t (signal (car err) (cdr err))))))))))
+ (cond
+ ((nnmaildir--emlink-p err)
+ (setq make-new-file t
+ number-open number-link))
+ ((nnmaildir--eexist-p err)
+ (let ((attr (file-attributes path-link)))
+ (if (/= (nth 10 attr) ino-open)
+ (setq number-open number-link
+ number-link 0))))
+ (t (signal (car err) (cdr err)))))))))
(defun nnmaildir--update-nov (server group article)
(let ((nnheader-file-coding-system 'binary)
(throw 'return nil))
(when (save-match-data (string-match "[\0/\t]" gname))
(setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Illegal characters (null, tab, or /) in group name: "
+ (concat "Invalid characters (null, tab, or /) in group name: "
gname))
(throw 'return nil))
(setq groups (nnmaildir--srv-groups nnmaildir--cur-server))
(throw 'return nil))
(when (save-match-data (string-match "[\0/\t]" new-name))
(setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Illegal characters (null, tab, or /) in group name: "
+ (concat "Invalid characters (null, tab, or /) in group name: "
new-name))
(throw 'return nil))
(if (string-equal gname new-name) (throw 'return t))
t)))
(defun nnmaildir-request-move-article (article gname server accept-form
- &optional last)
+ &optional last move-is-internal)
(let ((group (nnmaildir--prepare server gname))
pgname suffix result nnmaildir--file deactivate-mark)
(catch 'return
nnmaildir--cur-server)
"24-hour timer expired")
(throw 'return nil))))
- (condition-case nil
- (add-name-to-file nnmaildir--file tmpfile)
+ (condition-case nil (add-name-to-file nnmaildir--file tmpfile)
(error
(write-region (point-min) (point-max) tmpfile nil 'no-message nil
'excl)
(unix-sync))) ;; no fsync :(
- (cancel-timer 24h)
+ (nnheader-cancel-timer 24h)
(condition-case err
(add-name-to-file tmpfile curfile)
(error
(not (string-equal target pgname))) ;; Move it.
(erase-buffer)
(nnheader-insert-file-contents nnmaildir--file)
- (gnus-request-accept-article target nil nil 'no-encode))
+ (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))
(setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
permarkfile (concat mdir ":")
mfile (concat mdir (nnmaildir--art-prefix article)))
- (condition-case err
- (add-name-to-file permarkfile mfile)
- (error
- (cond
- ((nnmaildir--eexist-p err))
- ((and (eq (car err) 'file-error)
- (string= (caddr err) "no such file or directory"))
- (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)))))))
+ (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)
;; fill-column: 77
;; End:
+;;; arch-tag: 0c4e44cd-dfde-4040-888e-5597ec771849
;;; nnmaildir.el ends here
projects / elisp / gnus.git- / blobdiff