gnus-utils.el (gnus-recursive-directory-files): Unify hard or symbolic links (bug#18063)

2 files changed, 23 insertions, 10 deletions

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  <yamaoka@jpl.org>
+
+        * gnus-utils.el (gnus-recursive-directory-files):
+        Unify hard or symbolic links (bug#18063).
+
 2013-07-17  Albert Krewinkel  <albert@zeitkraut.de>
 
         * 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)