[Emacs-diffs] trunk r117563: gnus-utils.el (gnus-recursive-directory-files): Unify hard or symbolic links (bug#18063)

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 117563
revision-id: address@hidden
parent: address@hidden
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Tue 2014-07-22 06:37:31 +0000
message:
  gnus-utils.el (gnus-recursive-directory-files): Unify hard or symbolic links 
(bug#18063)
modified:
  lisp/gnus/ChangeLog            changelog-20091113204419-o5vbwnq5f7feedwu-1433
  lisp/gnus/gnus-util.el         
gnusutil.el-20091113204419-o5vbwnq5f7feedwu-1140

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2014-07-18 08:23:49 +0000
+++ b/lisp/gnus/ChangeLog       2014-07-22 06:37:31 +0000
@@ -1,3 +1,8 @@
+2014-07-22  Katsumi Yamaoka  <address@hidden>
+
+       * gnus-utils.el (gnus-recursive-directory-files):
+       Unify hard or symbolic links (bug#18063).
+
 2013-07-17  Albert Krewinkel  <address@hidden>
 
        * gnus-msg.el (gnus-configure-posting-style):

=== modified file 'lisp/gnus/gnus-util.el'
--- a/lisp/gnus/gnus-util.el    2014-03-23 23:13:36 +0000
+++ b/lisp/gnus/gnus-util.el    2014-07-22 06:37:31 +0000
@@ -1910,17 +1910,25 @@
                    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)