Mercurial > emacs
changeset 110171:a05bc4ad2d3f
mm-util.el: Just return the image directories, not all directories in the path in addition to the image directories; Maintain a cache of the image directories. This means that the `g' command in Gnus doesn't have to stat dozens of directories each time; nnmh.el: Only recurse down into subdirectories if the link count is more than 2. This results in a 100x speed up on my nnmh spool, and that's from an SSD disk, and not over nfs.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Sat, 04 Sep 2010 00:45:13 +0000 |
| parents | 5e7ec1dda5c0 |
| children | f400055a098b |
| files | lisp/gnus/ChangeLog lisp/gnus/mm-util.el lisp/gnus/nnmh.el |
| diffstat | 3 files changed, 47 insertions(+), 23 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Sat Sep 04 00:36:13 2010 +0000 +++ b/lisp/gnus/ChangeLog Sat Sep 04 00:45:13 2010 +0000 @@ -1,5 +1,15 @@ +2010-09-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnmh.el (nnmh-request-list-1): Optimize for speed. + 2010-09-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + * mm-util.el (mm-image-load-path): Just return the image directories, + not all directories in the path in addition to the image directories. + (mm-image-load-path): Maintain a cache of the image directories so that + the `g' command in Gnus doesn't have to stat dozens of directories each + time. + * gnus-html.el (gnus-html-put-image): Allow images to be removed. (gnus-html-wash-tags): Add a new `i' command to insert images. (gnus-html-insert-image): New command and keystroke.
--- a/lisp/gnus/mm-util.el Sat Sep 04 00:36:13 2010 +0000 +++ b/lisp/gnus/mm-util.el Sat Sep 04 00:45:13 2010 +0000 @@ -1429,16 +1429,23 @@ ;; Reset the umask. (set-default-file-modes umask))))) +(defvar mm-image-load-path-cache nil) + (defun mm-image-load-path (&optional package) - (let (dir result) - (dolist (path load-path (nreverse result)) - (when (and path - (file-directory-p - (setq dir (concat (file-name-directory - (directory-file-name path)) - "etc/images/" (or package "gnus/"))))) - (push dir result)) - (push path result)))) + (if (and mm-image-load-path-cache + (equal load-path (car mm-image-load-path-cache))) + (cdr mm-image-load-path-cache) + (let (dir result) + (dolist (path load-path) + (when (and path + (file-directory-p + (setq dir (concat (file-name-directory + (directory-file-name path)) + "etc/images/" (or package "gnus/"))))) + (push dir result))) + (setq result (nreverse result) + mm-image-load-path-cache (cons load-path result)) + result))) ;; Fixme: This doesn't look useful where it's used. (if (fboundp 'detect-coding-region)
--- a/lisp/gnus/nnmh.el Sat Sep 04 00:36:13 2010 +0000 +++ b/lisp/gnus/nnmh.el Sat Sep 04 00:45:13 2010 +0000 @@ -207,21 +207,29 @@ (defun nnmh-request-list-1 (dir) (setq dir (expand-file-name dir)) ;; Recurse down all directories. - (let ((dirs (and (file-readable-p dir) - (nnheader-directory-files dir t nil t))) - rdir) + (let ((files (nnheader-directory-files dir t nil t)) + (max 0) + min rdir attributes num) ;; Recurse down directories. - (while (setq rdir (pop dirs)) - (when (and (file-directory-p rdir) + (dolist (rdir files) + (setq attributes (file-attributes rdir)) + (when (null (nth 0 attributes)) + (setq file (file-name-nondirectory rdir)) + (when (string-match "^[0-9]+$" file) + (setq num (string-to-number file)) + (setq max (max max num)) + (when (or (null min) + (< num min)) + (setq min num)))) + (when (and (eq (nth 0 attributes) t) ; Is a directory + (> (nth 1 attributes) 2) ; Has sub-directories (file-readable-p rdir) (not (equal (file-truename rdir) (file-truename dir)))) - (nnmh-request-list-1 rdir)))) - ;; For each directory, generate an active file line. - (unless (string= (expand-file-name nnmh-toplev) dir) - (let ((files (mapcar 'string-to-number - (directory-files dir nil "^[0-9]+$" t)))) - (when files + (nnmh-request-list-1 rdir))) + ;; For each directory, generate an active file line. + (unless (string= (expand-file-name nnmh-toplev) dir) + (when min (with-current-buffer nntp-server-buffer (goto-char (point-max)) (insert @@ -233,14 +241,13 @@ (file-truename (file-name-as-directory (expand-file-name nnmh-toplev)))) dir) - (mm-string-to-multibyte ;Why? Isn't it multibyte already? + (mm-string-to-multibyte ;Why? Isn't it multibyte already? (mm-encode-coding-string (nnheader-replace-chars-in-string (substring dir (match-end 0)) ?/ ?.) nnmail-pathname-coding-system))) - (apply 'max files) - (apply 'min files))))))) + max min)))))) t) (deffoo nnmh-request-newgroups (date &optional server)