diff options
Diffstat (limited to 'lisp/gnus/nnmaildir.el')
| -rw-r--r-- | lisp/gnus/nnmaildir.el | 38 |
1 files changed, 22 insertions, 16 deletions
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 9cf766ee465..68c31dc4510 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1,4 +1,4 @@ -;;; nnmaildir.el --- maildir backend for Gnus +;;; nnmaildir.el --- maildir backend for Gnus -*- lexical-binding:t -*- ;; This file is in the public domain. @@ -261,7 +261,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir--param (pgname param) (setq param (gnus-group-find-parameter pgname param 'allow-list)) (if (vectorp param) (setq param (aref param 0))) - (eval param)) + (eval param t)) (defmacro nnmaildir--with-nntp-buffer (&rest body) (declare (debug (body))) @@ -269,15 +269,15 @@ This variable is set by `nnmaildir-request-article'.") ,@body)) (defmacro nnmaildir--with-work-buffer (&rest body) (declare (debug (body))) - `(with-current-buffer (get-buffer-create " *nnmaildir work*") + `(with-current-buffer (gnus-get-buffer-create " *nnmaildir work*") ,@body)) (defmacro nnmaildir--with-nov-buffer (&rest body) (declare (debug (body))) - `(with-current-buffer (get-buffer-create " *nnmaildir nov*") + `(with-current-buffer (gnus-get-buffer-create " *nnmaildir nov*") ,@body)) (defmacro nnmaildir--with-move-buffer (&rest body) (declare (debug (body))) - `(with-current-buffer (get-buffer-create " *nnmaildir move*") + `(with-current-buffer (gnus-get-buffer-create " *nnmaildir move*") ,@body)) (defsubst nnmaildir--subdir (dir subdir) @@ -492,7 +492,7 @@ This variable is set by `nnmaildir-request-article'.") (setq nov-mid 0)) (goto-char (point-min)) (delete-char 1) - (setq nov (nnheader-parse-naked-head) + (setq nov (nnheader-parse-head t) field (or (mail-header-lines nov) 0))) (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:)) (setq nov-mid field)) @@ -690,7 +690,7 @@ This variable is set by `nnmaildir-request-article'.") "You must set \"directory\" in the select method") (throw 'return nil)) (setq dir (cadr dir) - dir (eval dir) + dir (eval dir t) ;FIXME: Why `eval'? dir (expand-file-name dir) dir (file-name-as-directory dir)) (unless (file-exists-p dir) @@ -717,13 +717,13 @@ This variable is set by `nnmaildir-request-article'.") (if x (progn (setq x (cadr x) - x (eval x)) + x (eval x t)) ;FIXME: Why `eval'? (setf (nnmaildir--srv-target-prefix server) x)) (setq x (assq 'create-directory defs)) (if x (progn (setq x (cadr x) - x (eval x) + x (eval x t) ;FIXME: Why `eval'? x (file-name-as-directory x)) (setf (nnmaildir--srv-target-prefix server) x)) (setf (nnmaildir--srv-target-prefix server) ""))) @@ -1428,7 +1428,7 @@ This variable is set by `nnmaildir-request-article'.") (nnmaildir--with-move-buffer (erase-buffer) (nnheader-insert-file-contents nnmaildir--file) - (setq result (eval accept-form))) + (setq result (eval accept-form t))) (unless (or (null result) (nnmaildir--param pgname 'read-only)) (nnmaildir--unlink nnmaildir--file) (nnmaildir--expired-article group article)) @@ -1544,7 +1544,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir-request-expire-articles (ranges &optional gname server force) (let ((no-force (not force)) (group (nnmaildir--prepare server gname)) - pgname time boundary high low target dir nlist + pgname time boundary target dir nlist didnt nnmaildir--file nnmaildir-article-file-name deactivate-mark) (catch 'return @@ -1720,18 +1720,23 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir-close-group (gname &optional server) (let ((group (nnmaildir--prepare server gname)) - pgname ls dir msgdir files flist dirs) + pgname ls dir msgdir files dirs + (fset (make-hash-table :test #'equal))) (if (null group) (progn (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "No such group: " gname)) nil) + ;; Delete the now obsolete NOV files. + ;; FIXME: This can take a somewhat long time, so maybe it's better + ;; to do it asynchronously (i.e. in an idle timer). (setq pgname (nnmaildir--pgname nnmaildir--cur-server gname) ls (nnmaildir--group-ls nnmaildir--cur-server pgname) dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir dir gname) msgdir (if (nnmaildir--param pgname 'read-only) (nnmaildir--new dir) (nnmaildir--cur dir)) + ;; The dir with the NOV files. dir (nnmaildir--nndir dir) dirs (cons (nnmaildir--nov-dir dir) (funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]" @@ -1744,14 +1749,15 @@ This variable is set by `nnmaildir-request-article'.") (save-match-data (dolist (file files) (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file) - (push (match-string 1 file) flist))) + (puthash (match-string 1 file) t fset))) + ;; Not sure why, but we specifically avoid deleting the `:' file. + (puthash ":" t fset) (dolist (dir dirs) (setq files (cdr dir) dir (file-name-as-directory (car dir))) (dolist (file files) - (unless (or (member file flist) (string= file ":")) - (setq file (concat dir file)) - (delete-file file)))) + (unless (gethash file fset) + (delete-file (concat dir file))))) t))) (defun nnmaildir-close-server (&optional server _defs) |