diff lisp/find-paths.el @ 373:6240c7796c7a r21-2b2

Import from CVS: tag r21-2b2
author cvs
date Mon, 13 Aug 2007 11:04:06 +0200
parents cc15677e0335
children 8626e4521993
line wrap: on
line diff
--- a/lisp/find-paths.el	Mon Aug 13 11:03:09 2007 +0200
+++ b/lisp/find-paths.el	Mon Aug 13 11:04:06 2007 +0200
@@ -62,7 +62,7 @@
       (let ((directory (file-name-as-directory
 			(expand-file-name
 			 (car directories)))))
-	(if (file-directory-p directory)
+	(if (paths-file-readable-directory-p directory)
 	    (let ((raw-entries
 		   (if (equal 0 max-depth)
 		       '()
@@ -88,6 +88,11 @@
       (setq directories (cdr directories)))
     path))
 
+(defun paths-file-readable-directory-p (filename)
+  "Check if filename is a readable directory."
+  (and (file-directory-p filename)
+       (file-readable-p filename)))
+
 (defun paths-find-recursive-load-path (directories &optional max-depth)
   "Construct a recursive load path underneath DIRECTORIES."
   (paths-find-recursive-path directories
@@ -97,13 +102,13 @@
   "Check if DIRECTORY is a plausible installation root for XEmacs."
   (or
    ;; installed
-   (file-directory-p (paths-construct-path (list directory
-						 "lib"
-						 emacs-program-name)))
+   (paths-file-readable-directory-p (paths-construct-path (list directory
+								"lib"
+								emacs-program-name)))
    ;; in-place or windows-nt
    (and 
-    (file-directory-p (paths-construct-path (list directory "lisp")))
-    (file-directory-p (paths-construct-path (list directory "etc"))))))
+    (paths-file-readable-directory-p (paths-construct-path (list directory "lisp")))
+    (paths-file-readable-directory-p (paths-construct-path (list directory "etc"))))))
 
 (defun paths-chase-symlink (file-name)
   "Chase a symlink until the bitter end."
@@ -168,19 +173,19 @@
   (let ((preferred-value (or (and envvar (getenv envvar))
 			     default)))
     (if (and preferred-value
-	     (file-directory-p preferred-value))
+	     (paths-file-readable-directory-p preferred-value))
 	(file-name-as-directory preferred-value)
       (catch 'gotcha
 	(while roots
 	  (let* ((root (car roots))
 		 ;; installed
 		 (path (paths-construct-emacs-directory root suffix base)))
-	    (if (file-directory-p path)
+	    (if (paths-file-readable-directory-p path)
 		(throw 'gotcha path)
 	      ;; in-place
 	      (if (null keep-suffix)
 		  (let ((path (paths-construct-emacs-directory root "" base)))
-		    (if (file-directory-p path)
+		    (if (paths-file-readable-directory-p path)
 			(throw 'gotcha path))))))
 	  (setq roots (cdr roots)))
 	nil))))
@@ -230,7 +235,7 @@
   "Return the directories among DIRECTORIES."
   (let ((reverse-directories '()))
     (while directories
-      (if (file-directory-p (car directories))
+      (if (paths-file-readable-directory-p (car directories))
 	  (setq reverse-directories 
 		(cons (car directories)
 		      reverse-directories)))