Commit d737e497 authored by Stefan Monnier's avatar Stefan Monnier

* lisp/gnus/nnmaildir.el: Fix O(n^2) problem when leaving a group

Use lexical-binding.

(nnmaildir-close-group): Use a hash-table rather than a list to keep
track of the files we have seen.

* lisp/gnus/nnheader.el (nnheader-parse-naked-head):
Use make-full-mail-header.
parent 32f01492
Pipeline #4792 passed with stage
in 75 minutes and 4 seconds
......@@ -209,7 +209,7 @@ on your system, you could say something like:
;; about twice as fast, even though it looks messier. You
;; can't have everything, I guess. Speed and elegance don't
;; always go hand in hand.
(vector
(make-full-mail-header
;; Number.
(or number 0)
;; Subject.
......
;;; 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)))
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment