Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b2
author cvs
date Mon, 13 Aug 2007 11:04:06 +0200
parents cc15677e0335
children 8626e4521993
comparison
equal deleted inserted replaced
372:49e1ed2d7ed8 373:6240c7796c7a
60 (let ((path '())) 60 (let ((path '()))
61 (while directories 61 (while directories
62 (let ((directory (file-name-as-directory 62 (let ((directory (file-name-as-directory
63 (expand-file-name 63 (expand-file-name
64 (car directories))))) 64 (car directories)))))
65 (if (file-directory-p directory) 65 (if (paths-file-readable-directory-p directory)
66 (let ((raw-entries 66 (let ((raw-entries
67 (if (equal 0 max-depth) 67 (if (equal 0 max-depth)
68 '() 68 '()
69 (directory-files directory nil "^[^.-]"))) 69 (directory-files directory nil "^[^.-]")))
70 (reverse-dirs '())) 70 (reverse-dirs '()))
86 (list directory) 86 (list directory)
87 sub-path)))))) 87 sub-path))))))
88 (setq directories (cdr directories))) 88 (setq directories (cdr directories)))
89 path)) 89 path))
90 90
91 (defun paths-file-readable-directory-p (filename)
92 "Check if filename is a readable directory."
93 (and (file-directory-p filename)
94 (file-readable-p filename)))
95
91 (defun paths-find-recursive-load-path (directories &optional max-depth) 96 (defun paths-find-recursive-load-path (directories &optional max-depth)
92 "Construct a recursive load path underneath DIRECTORIES." 97 "Construct a recursive load path underneath DIRECTORIES."
93 (paths-find-recursive-path directories 98 (paths-find-recursive-path directories
94 max-depth paths-no-lisp-directory-regexp)) 99 max-depth paths-no-lisp-directory-regexp))
95 100
96 (defun paths-emacs-root-p (directory) 101 (defun paths-emacs-root-p (directory)
97 "Check if DIRECTORY is a plausible installation root for XEmacs." 102 "Check if DIRECTORY is a plausible installation root for XEmacs."
98 (or 103 (or
99 ;; installed 104 ;; installed
100 (file-directory-p (paths-construct-path (list directory 105 (paths-file-readable-directory-p (paths-construct-path (list directory
101 "lib" 106 "lib"
102 emacs-program-name))) 107 emacs-program-name)))
103 ;; in-place or windows-nt 108 ;; in-place or windows-nt
104 (and 109 (and
105 (file-directory-p (paths-construct-path (list directory "lisp"))) 110 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp")))
106 (file-directory-p (paths-construct-path (list directory "etc")))))) 111 (paths-file-readable-directory-p (paths-construct-path (list directory "etc"))))))
107 112
108 (defun paths-chase-symlink (file-name) 113 (defun paths-chase-symlink (file-name)
109 "Chase a symlink until the bitter end." 114 "Chase a symlink until the bitter end."
110 (let ((maybe-symlink (file-symlink-p file-name))) 115 (let ((maybe-symlink (file-symlink-p file-name)))
111 (if maybe-symlink 116 (if maybe-symlink
166 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching 171 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
167 the directory." 172 the directory."
168 (let ((preferred-value (or (and envvar (getenv envvar)) 173 (let ((preferred-value (or (and envvar (getenv envvar))
169 default))) 174 default)))
170 (if (and preferred-value 175 (if (and preferred-value
171 (file-directory-p preferred-value)) 176 (paths-file-readable-directory-p preferred-value))
172 (file-name-as-directory preferred-value) 177 (file-name-as-directory preferred-value)
173 (catch 'gotcha 178 (catch 'gotcha
174 (while roots 179 (while roots
175 (let* ((root (car roots)) 180 (let* ((root (car roots))
176 ;; installed 181 ;; installed
177 (path (paths-construct-emacs-directory root suffix base))) 182 (path (paths-construct-emacs-directory root suffix base)))
178 (if (file-directory-p path) 183 (if (paths-file-readable-directory-p path)
179 (throw 'gotcha path) 184 (throw 'gotcha path)
180 ;; in-place 185 ;; in-place
181 (if (null keep-suffix) 186 (if (null keep-suffix)
182 (let ((path (paths-construct-emacs-directory root "" base))) 187 (let ((path (paths-construct-emacs-directory root "" base)))
183 (if (file-directory-p path) 188 (if (paths-file-readable-directory-p path)
184 (throw 'gotcha path)))))) 189 (throw 'gotcha path))))))
185 (setq roots (cdr roots))) 190 (setq roots (cdr roots)))
186 nil)))) 191 nil))))
187 192
188 (defun paths-find-site-directory (roots base &optional envvar default) 193 (defun paths-find-site-directory (roots base &optional envvar default)
228 233
229 (defun paths-directories-which-exist (directories) 234 (defun paths-directories-which-exist (directories)
230 "Return the directories among DIRECTORIES." 235 "Return the directories among DIRECTORIES."
231 (let ((reverse-directories '())) 236 (let ((reverse-directories '()))
232 (while directories 237 (while directories
233 (if (file-directory-p (car directories)) 238 (if (paths-file-readable-directory-p (car directories))
234 (setq reverse-directories 239 (setq reverse-directories
235 (cons (car directories) 240 (cons (car directories)
236 reverse-directories))) 241 reverse-directories)))
237 (setq directories (cdr directories))) 242 (setq directories (cdr directories)))
238 (reverse reverse-directories))) 243 (reverse reverse-directories)))