From: Katsumi Yamaoka Date: Tue, 22 Jul 2014 06:37:31 +0000 (+0000) Subject: gnus-utils.el (gnus-recursive-directory-files): Unify hard or symbolic links (bug... X-Git-Tag: emacs-25.0.90~2636^3~53 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c448c6241fd6cef424447dbfeaee18240aece27a;p=emacs.git gnus-utils.el (gnus-recursive-directory-files): Unify hard or symbolic links (bug#18063) --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index cdfe4f4dea8..f55e04f02e6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2014-07-22 Katsumi Yamaoka + + * gnus-utils.el (gnus-recursive-directory-files): + Unify hard or symbolic links (bug#18063). + 2013-07-17 Albert Krewinkel * gnus-msg.el (gnus-configure-posting-style): diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 62977576a00..fe4d707be2e 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1910,17 +1910,25 @@ Sizes are in pixels." image))) image))) +(eval-when-compile (require 'gmm-utils)) (defun gnus-recursive-directory-files (dir) - "Return all regular files below DIR." - (let (files) - (dolist (file (directory-files dir t)) - (when (and (not (member (file-name-nondirectory file) '("." ".."))) - (file-readable-p file)) - (cond - ((file-regular-p file) - (push file files)) - ((file-directory-p file) - (setq files (append (gnus-recursive-directory-files file) files)))))) + "Return all regular files below DIR. +The first found will be returned if a file has hard or symbolic links." + (let (files attr attrs) + (gmm-labels + ((fn (directory) + (dolist (file (directory-files directory t)) + (setq attr (file-attributes (file-truename file))) + (when (and (not (member attr attrs)) + (not (member (file-name-nondirectory file) + '("." ".."))) + (file-readable-p file)) + (push attr attrs) + (cond ((file-regular-p file) + (push file files)) + ((file-directory-p file) + (fn file))))))) + (fn dir)) files)) (defun gnus-list-memq-of-list (elements list)