[gnus git] branch master updated: m0-11-31-g5418511 =1= gnus-utils.el (gnus-recursive-directory-files): Unify hard or symbolic links (bug#18063)

Katsumi Yamaoka <[email protected]> Tue, 22 Jul 2014 08:37:36 +0200
Newsgroups gmane.emacs.gnus.cvs
Message-ID <[email protected]>
       via  541851107664081d96b3aca32582916a379fc455 (commit)
      from  7a4c0a6aa3b9ec91a93902f894fd47ded1deca52 (commit)


- Log -----------------------------------------------------------------
commit 541851107664081d96b3aca32582916a379fc455
Author: Katsumi Yamaoka <[email protected]>
Date:   Tue Jul 22 06:37:25 2014 +0000

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

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 408318d..4769108 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2014-07-22  Katsumi Yamaoka  <[email protected]>
+
+	* gnus-utils.el (gnus-recursive-directory-files):
+	Unify hard or symbolic links (bug#18063).
+
 2013-07-17  Albert Krewinkel  <[email protected]>
 
 	* gnus-msg.el (gnus-configure-posting-style):
diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 6297757..fe4d707 100644
--- a/lisp/gnus-util.el
+++ b/lisp/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) '("." "..")))
+  "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))
-	(cond
-	 ((file-regular-p file)
+		 (push attr attrs)
+		 (cond ((file-regular-p file)
 			(push file files))
 		       ((file-directory-p file)
-	  (setq files (append (gnus-recursive-directory-files file) files))))))
+			(fn file)))))))
+      (fn dir))
     files))
 
 (defun gnus-list-memq-of-list (elements list)

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog    |    5 +++++
 lisp/gnus-util.el |   28 ++++++++++++++++++----------
 2 files changed, 23 insertions(+), 10 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project