Mercurial > hg > xemacs-beta

comparison lisp/find-paths.el @ 1218:ceedb6eeaba8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-01-16 08:59:47 by michaels] 2003-01-13 Mike Sperber <mike@xemacs.org> * packages.el: * find-paths.el: Revert this change 2000-04-01 Mike Sperber <mike@xemacs.org> * packages.el (packages-find-package-directories): Added support for external package hierarchies with in-place installations. * find-paths.el (paths-root-in-place-p): Added. (paths-find-emacs-directory): Added support for external directories with in-place installations. (paths-find-site-directory): Ditto.
author michaels
date Thu, 16 Jan 2003 08:59:47 +0000
parents 987c2a685f39
children 5636ae1c0234
comparison
equal deleted inserted replaced
1217:1d1c82f6b17e 1218:ceedb6eeaba8
109 ;; in-place or windows-nt 109 ;; in-place or windows-nt
110 (and 110 (and
111 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp"))) 111 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp")))
112 (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))))) 112 (paths-file-readable-directory-p (paths-construct-path (list directory "etc"))))))
113 113
114 (defun paths-root-in-place-p (root)
115 "Check if ROOT is an in-place installation root for XEmacs."
116 (paths-file-readable-directory-p (paths-construct-path (list root "lisp"))))
117
118 (defun paths-chase-symlink (file-name) 114 (defun paths-chase-symlink (file-name)
119 "Chase a symlink until the bitter end." 115 "Chase a symlink until the bitter end."
120 (let ((maybe-symlink (file-symlink-p file-name))) 116 (let ((maybe-symlink (file-symlink-p file-name)))
121 (if maybe-symlink 117 (if maybe-symlink
122 (let* ((directory (file-name-directory file-name)) 118 (let* ((directory (file-name-directory file-name))
163 (file-name-as-directory root) 159 (file-name-as-directory root)
164 suffix 160 suffix
165 base)))) 161 base))))
166 162
167 (defun paths-find-emacs-directory (roots suffix base 163 (defun paths-find-emacs-directory (roots suffix base
168 &optional envvar default keep-suffix 164 &optional envvar default keep-suffix)
169 in-place-external)
170 "Find a directory in the XEmacs hierarchy. 165 "Find a directory in the XEmacs hierarchy.
171 ROOTS must be a list of installation roots. 166 ROOTS must be a list of installation roots.
172 SUFFIX is the subdirectory from there. 167 SUFFIX is the subdirectory from there.
173 BASE is the base to look for. 168 BASE is the base to look for.
174 ENVVAR is the name of the environment variable that might also 169 ENVVAR is the name of the environment variable that might also
175 specify the directory. 170 specify the directory.
176 DEFAULT is the preferred value. 171 DEFAULT is the preferred value.
177 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching 172 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
178 the directory. 173 the directory."
179 If IN-PLACE-EXTERNAL is non-nil, the directory might be found outside
180 an in-place root-hierarchy."
181 (let ((preferred-value (or (and envvar (getenv envvar)) 174 (let ((preferred-value (or (and envvar (getenv envvar))
182 default))) 175 default)))
183 (if (and preferred-value 176 (if (and preferred-value
184 (paths-file-readable-directory-p preferred-value)) 177 (paths-file-readable-directory-p preferred-value))
185 (file-name-as-directory preferred-value) 178 (file-name-as-directory preferred-value)
186 (catch 'gotcha 179 (catch 'gotcha
187 (while roots 180 (while roots
188 (let ((root (car roots))) 181 (let* ((root (car roots))
189 ;; installed 182 ;; installed
190 (let ((path (paths-construct-emacs-directory root suffix base))) 183 (path (paths-construct-emacs-directory root suffix base)))
191 (if (paths-file-readable-directory-p path) 184 (if (paths-file-readable-directory-p path)
192 (throw 'gotcha path))) 185 (throw 'gotcha path)
193 ;; in-place 186 ;; in-place
194 (if (null keep-suffix) 187 (if (null keep-suffix)
195 (let ((path (paths-construct-emacs-directory root "" base))) 188 (let ((path (paths-construct-emacs-directory root "" base)))
196 (if (paths-file-readable-directory-p path) 189 (if (paths-file-readable-directory-p path)
197 (throw 'gotcha path)))) 190 (throw 'gotcha path))))))
198 (if (and in-place-external
199 (paths-root-in-place-p root))
200 (let ((path (paths-construct-emacs-directory
201 (paths-construct-path '("..") root)
202 "" base)))
203 (if (paths-file-readable-directory-p path)
204 (throw 'gotcha path)))))
205 (setq roots (cdr roots))) 191 (setq roots (cdr roots)))
206 nil)))) 192 nil))))
207 193
208 (defun paths-find-site-directory (roots base &optional envvar default in-place-external) 194 (defun paths-find-site-directory (roots base &optional envvar default)
209 "Find a site-specific directory in the XEmacs hierarchy. 195 "Find a site-specific directory in the XEmacs hierarchy."
210 If IN-PLACE-EXTERNAL is non-nil, the directory might be found outside
211 an in-place root-hierarchy."
212 (paths-find-emacs-directory roots 196 (paths-find-emacs-directory roots
213 (file-name-as-directory 197 (file-name-as-directory
214 (paths-construct-path (list 198 (paths-construct-path (list
215 "lib" 199 "lib"
216 emacs-program-name))) 200 emacs-program-name)))
217 base 201 base
218 envvar default 202 envvar default))
219 nil
220 in-place-external))
221 203
222 (defun paths-find-version-directory (roots base 204 (defun paths-find-version-directory (roots base
223 &optional envvar default enforce-version) 205 &optional envvar default enforce-version)
224 "Find a version-specific directory in the XEmacs hierarchy. 206 "Find a version-specific directory in the XEmacs hierarchy.
225 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." 207 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."