Mercurial > hg > xemacs-beta

comparison lisp/find-paths.el @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents a4f53d9b3154
children 6240c7796c7a
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
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 (paths-file-readable-directory-p directory) 65 (if (file-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
96 (defun paths-find-recursive-load-path (directories &optional max-depth) 91 (defun paths-find-recursive-load-path (directories &optional max-depth)
97 "Construct a recursive load path underneath DIRECTORIES." 92 "Construct a recursive load path underneath DIRECTORIES."
98 (paths-find-recursive-path directories 93 (paths-find-recursive-path directories
99 max-depth paths-no-lisp-directory-regexp)) 94 max-depth paths-no-lisp-directory-regexp))
100 95
101 (defun paths-emacs-root-p (directory) 96 (defun paths-emacs-root-p (directory)
102 "Check if DIRECTORY is a plausible installation root for XEmacs." 97 "Check if DIRECTORY is a plausible installation root for XEmacs."
103 (or 98 (or
104 ;; installed 99 ;; installed
105 (paths-file-readable-directory-p (paths-construct-path (list directory 100 (file-directory-p (paths-construct-path (list directory
106 "lib" 101 "lib"
107 emacs-program-name))) 102 emacs-program-name)))
108 ;; in-place or windows-nt 103 ;; in-place or windows-nt
109 (and 104 (and
110 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp"))) 105 (file-directory-p (paths-construct-path (list directory "lisp")))
111 (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))))) 106 (file-directory-p (paths-construct-path (list directory "etc"))))))
112 107
113 (defun paths-chase-symlink (file-name) 108 (defun paths-chase-symlink (file-name)
114 "Chase a symlink until the bitter end." 109 "Chase a symlink until the bitter end."
115 (let ((maybe-symlink (file-symlink-p file-name))) 110 (let ((maybe-symlink (file-symlink-p file-name)))
116 (if maybe-symlink 111 (if maybe-symlink
171 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching 166 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
172 the directory." 167 the directory."
173 (let ((preferred-value (or (and envvar (getenv envvar)) 168 (let ((preferred-value (or (and envvar (getenv envvar))
174 default))) 169 default)))
175 (if (and preferred-value 170 (if (and preferred-value
176 (paths-file-readable-directory-p preferred-value)) 171 (file-directory-p preferred-value))
177 (file-name-as-directory preferred-value) 172 (file-name-as-directory preferred-value)
178 (catch 'gotcha 173 (catch 'gotcha
179 (while roots 174 (while roots
180 (let* ((root (car roots)) 175 (let* ((root (car roots))
181 ;; installed 176 ;; installed
182 (path (paths-construct-emacs-directory root suffix base))) 177 (path (paths-construct-emacs-directory root suffix base)))
183 (if (paths-file-readable-directory-p path) 178 (if (file-directory-p path)
184 (throw 'gotcha path) 179 (throw 'gotcha path)
185 ;; in-place 180 ;; in-place
186 (if (null keep-suffix) 181 (if (null keep-suffix)
187 (let ((path (paths-construct-emacs-directory root "" base))) 182 (let ((path (paths-construct-emacs-directory root "" base)))
188 (if (paths-file-readable-directory-p path) 183 (if (file-directory-p path)
189 (throw 'gotcha path)))))) 184 (throw 'gotcha path))))))
190 (setq roots (cdr roots))) 185 (setq roots (cdr roots)))
191 nil)))) 186 nil))))
192 187
193 (defun paths-find-site-directory (roots base &optional envvar default) 188 (defun paths-find-site-directory (roots base &optional envvar default)
217 "Find an architecture-specific directory in the XEmacs hierarchy." 212 "Find an architecture-specific directory in the XEmacs hierarchy."
218 (or 213 (or
219 ;; from more to less specific 214 ;; from more to less specific
220 (paths-find-version-directory roots 215 (paths-find-version-directory roots
221 (concat base system-configuration) 216 (concat base system-configuration)
222 envvar default) 217 envvar)
223 (paths-find-version-directory roots 218 (paths-find-version-directory roots
224 base 219 base
225 envvar) 220 envvar)
226 (paths-find-version-directory roots 221 (paths-find-version-directory roots
227 system-configuration 222 system-configuration
228 envvar))) 223 envvar default)))
229 224
230 (defun construct-emacs-version-name () 225 (defun construct-emacs-version-name ()
231 "Construct the raw XEmacs version number." 226 "Construct the raw XEmacs version number."
232 (concat emacs-program-name "-" emacs-program-version)) 227 (concat emacs-program-name "-" emacs-program-version))
233 228
234 (defun paths-directories-which-exist (directories) 229 (defun paths-directories-which-exist (directories)
235 "Return the directories among DIRECTORIES." 230 "Return the directories among DIRECTORIES."
236 (let ((reverse-directories '())) 231 (let ((reverse-directories '()))
237 (while directories 232 (while directories
238 (if (paths-file-readable-directory-p (car directories)) 233 (if (file-directory-p (car directories))
239 (setq reverse-directories 234 (setq reverse-directories
240 (cons (car directories) 235 (cons (car directories)
241 reverse-directories))) 236 reverse-directories)))
242 (setq directories (cdr directories))) 237 (setq directories (cdr directories)))
243 (reverse reverse-directories))) 238 (reverse reverse-directories)))
261 (setq list (cdr list))) 256 (setq list (cdr list)))
262 (nreverse reverse-result))) 257 (nreverse reverse-result)))
263 258
264 (defun paths-decode-directory-path (string &optional drop-empties) 259 (defun paths-decode-directory-path (string &optional drop-empties)
265 "Split STRING at path separators into a directory list. 260 "Split STRING at path separators into a directory list.
266 Non-\"\" components are converted into directory form. 261 Non-\"\" comonents are converted into directory form.
267 If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output. 262 If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output.
268 Otherwise, they are left alone." 263 Otherwise, they are left alone."
269 (let* ((components (split-path string)) 264 (let* ((components (split-path string))
270 (directories 265 (directories
271 (mapcar #'(lambda (component) 266 (mapcar #'(lambda (component)