procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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.

Browse source
This commit is contained in:
Lars Magne Ingebrigtsen 2010-09-04 00:45:13 +00:00 • committed by Katsumi Yamaoka
parent 8fab3e398d
commit eecdcaf581
3 changed files with 47 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lisp/gnus/ChangeLog
View file

@ -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.

25
lisp/gnus/mm-util.el
View file

@ -1429,16 +1429,23 @@ If SUFFIX is non-nil, add that at the end of the file name."
;; 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)

35
lisp/gnus/nnmh.el
View file

@ -207,21 +207,29 @@ as unread by Gnus.")
(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 @@ as unread by Gnus.")
(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)