Mercurial > hg > xemacs-beta

comparison lisp/find-paths.el @ 4108:5da4cc7d5968

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2007-08-09 06:22:51 by michaels] 2007-08-07 Mike Sperber <mike@xemacs.org> * setup-paths.el (paths-find-doc-directory): (paths-find-exec-directory): (paths-find-lisp-directory): (paths-find-mule-lisp-directory): (paths-construct-info-path): (paths-find-data-directory): * packages.el (packages-find-installation-package-directories): * find-paths.el (paths-for-each-emacs-directory): (paths-find-emacs-directories): (paths-find-emacs-directory): (paths-for-each-site-directory): (paths-find-site-directory): (paths-find-site-directories): (paths-for-each-version-directory): (paths-find-version-directories): (paths-find-version-directory): Generalize to multiple bases. (paths-find-architecture-directory): Use above to give roots precedence over bases. This means, for example, that a directory in an in-place root will always get precedence over an installed root.
author michaels
date Thu, 09 Aug 2007 06:22:53 +0000
parents 9c0151d05116
children 9c6ea1581159
comparison
equal deleted inserted replaced
4107:d3a3bc2726d6 4108:5da4cc7d5968
136 suffix 136 suffix
137 base)))) 137 base))))
138 138
139 139
140 (defun paths-for-each-emacs-directory (func 140 (defun paths-for-each-emacs-directory (func
141 roots suffix base 141 roots suffix bases
142 &optional envvar default keep-suffix) 142 &optional envvar default keep-suffix)
143 "Iterate over directories in the XEmacs hierarchy. 143 "Iterate over directories in the XEmacs hierarchy.
144 FUNC is a function that called for each directory, with the directory 144 FUNC is a function that called for each directory, with the directory
145 as the only argument. 145 as the only argument.
146 ROOTS must be a list of installation roots. 146 ROOTS must be a list of installation roots.
147 SUFFIX is the subdirectory from there. 147 SUFFIX is the subdirectory from there.
148 BASE is the base to look for. 148 BASEA is a list of possible bases to look for.
149 ENVVAR is the name of the environment variable that might also 149 ENVVAR is the name of the environment variable that might also
150 specify the directory. 150 specify the directory.
151 DEFAULT is the preferred value. 151 DEFAULT is the preferred value.
152 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching 152 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
153 the directory." 153 the directory."
155 default))) 155 default)))
156 (if (and preferred-value 156 (if (and preferred-value
157 (paths-file-readable-directory-p preferred-value)) 157 (paths-file-readable-directory-p preferred-value))
158 (file-name-as-directory preferred-value) 158 (file-name-as-directory preferred-value)
159 (while roots 159 (while roots
160 (let* ((root (car roots)) 160 (let ((root (car roots))
161 ;; installed 161 (bases bases))
162 (path (paths-construct-emacs-directory root suffix base))) 162 (while bases
163 (if (paths-file-readable-directory-p path) 163 (let* ((base (car bases))
164 (funcall func path) 164 ;; installed
165 ;; in-place 165 (path (paths-construct-emacs-directory root suffix base)))
166 (if (null keep-suffix) 166 (if (paths-file-readable-directory-p path)
167 (let ((path (paths-construct-emacs-directory root "" base))) 167 (funcall func path)
168 (if (paths-file-readable-directory-p path) 168 ;; in-place
169 (funcall func path)))))) 169 (if (null keep-suffix)
170 (let ((path (paths-construct-emacs-directory root "" base)))
171 (if (paths-file-readable-directory-p path)
172 (funcall func path))))))
173 (setq bases (cdr bases))))
170 (setq roots (cdr roots)))))) 174 (setq roots (cdr roots))))))
171 175
172 (defun paths-find-emacs-directories (roots 176 (defun paths-find-emacs-directories (roots
173 suffix base 177 suffix bases
174 &optional envvar default keep-suffix) 178 &optional envvar default keep-suffix)
175 "Find a list of directories in the XEmacs hierarchy. 179 "Find a list of directories in the XEmacs hierarchy.
176 ROOTS must be a list of installation roots. 180 ROOTS must be a list of installation roots.
177 SUFFIX is the subdirectory from there. 181 SUFFIX is the subdirectory from there.
178 BASE is the base to look for. 182 BASES is a list of bases to look for.
179 ENVVAR is the name of the environment variable that might also 183 ENVVAR is the name of the environment variable that might also
180 specify the directory. 184 specify the directory.
181 DEFAULT is the preferred value. 185 DEFAULT is the preferred value.
182 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching 186 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
183 the directory." 187 the directory."
184 (let ((l '())) 188 (let ((l '()))
185 (paths-for-each-emacs-directory #'(lambda (dir) 189 (paths-for-each-emacs-directory #'(lambda (dir)
186 (setq l (cons dir l))) 190 (setq l (cons dir l)))
187 roots 191 roots
188 suffix base 192 suffix bases
189 envvar default keep-suffix) 193 envvar default keep-suffix)
190 (reverse l))) 194 (reverse l)))
191 195
192 (defun paths-find-emacs-directory (roots suffix base 196 (defun paths-find-emacs-directory (roots suffix bases
193 &optional envvar default keep-suffix) 197 &optional envvar default keep-suffix)
194 "Find a directory in the XEmacs hierarchy. 198 "Find a directory in the XEmacs hierarchy.
195 ROOTS must be a list of installation roots. 199 ROOTS must be a list of installation roots.
196 SUFFIX is the subdirectory from there. 200 SUFFIX is the subdirectory from there.
197 BASE is the base to look for. 201 BASES is a list of possible bases to look for.
198 ENVVAR is the name of the environment variable that might also 202 ENVVAR is the name of the environment variable that might also
199 specify the directory. 203 specify the directory.
200 DEFAULT is the preferred value. 204 DEFAULT is the preferred value.
201 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching 205 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
202 the directory." 206 the directory."
203 (catch 'gotcha 207 (catch 'gotcha
204 (paths-for-each-emacs-directory #'(lambda (dir) 208 (paths-for-each-emacs-directory #'(lambda (dir)
205 (throw 'gotcha dir)) 209 (throw 'gotcha dir))
206 roots 210 roots
207 suffix base 211 suffix bases
208 envvar default keep-suffix))) 212 envvar default keep-suffix)))
209 213
210 (defun paths-for-each-site-directory (func roots base arch-dependent-p &optional envvar default) 214 (defun paths-for-each-site-directory (func
215 roots bases
216 arch-dependent-p
217 &optional envvar default)
211 "Iterate over the site-specific directories in the XEmacs hierarchy. 218 "Iterate over the site-specific directories in the XEmacs hierarchy.
212 FUNC is a function that called for each directory, with the directory 219 FUNC is a function that called for each directory, with the directory
213 as the only argument. 220 as the only argument.
214 ROOTS must be a list of installation roots. 221 ROOTS must be a list of installation roots.
215 BASE is the base to look for. 222 BASES is a list of possible bases to look for.
216 ARCH-DEPENDENT-P says whether the file is architecture-specific. 223 ARCH-DEPENDENT-P says whether the file is architecture-specific.
217 ENVVAR is the name of the environment variable that might also 224 ENVVAR is the name of the environment variable that might also
218 specify the directory. 225 specify the directory.
219 DEFAULT is the preferred value." 226 DEFAULT is the preferred value."
220 (paths-for-each-emacs-directory func 227 (paths-for-each-emacs-directory func
221 roots 228 roots
222 (file-name-as-directory 229 (file-name-as-directory
223 (paths-construct-path (list 230 (paths-construct-path (list
224 (if arch-dependent-p "lib" "share") 231 (if arch-dependent-p "lib" "share")
225 emacs-program-name))) 232 emacs-program-name)))
226 base 233 bases
227 envvar default)) 234 envvar default))
228 235
229 (defun paths-find-site-directory (roots base arch-dependent-p &optional envvar default) 236 (defun paths-find-site-directory (roots bases arch-dependent-p &optional envvar default)
230 "Find a site-specific directory in the XEmacs hierarchy. 237 "Find a site-specific directory in the XEmacs hierarchy.
231 ROOTS must be a list of installation roots. 238 ROOTS must be a list of installation roots.
232 BASE is the base to look for. 239 BASES is a list of possible bases to look for.
233 ARCH-DEPENDENT-P says whether the file is architecture-specific. 240 ARCH-DEPENDENT-P says whether the file is architecture-specific.
234 ENVVAR is the name of the environment variable that might also 241 ENVVAR is the name of the environment variable that might also
235 specify the directory. 242 specify the directory.
236 DEFAULT is the preferred value." 243 DEFAULT is the preferred value."
237 (catch 'gotcha 244 (catch 'gotcha
238 (paths-for-each-site-directory #'(lambda (dir) 245 (paths-for-each-site-directory #'(lambda (dir)
239 (throw 'gotcha dir)) 246 (throw 'gotcha dir))
240 roots base arch-dependent-p 247 roots bases arch-dependent-p
241 envvar default))) 248 envvar default)))
242 249
243 (defun paths-find-site-directories (roots base arch-dependent-p &optional envvar default) 250 (defun paths-find-site-directories (roots bases arch-dependent-p &optional envvar default)
244 "Find a list of site-specific directories in the XEmacs hierarchy. 251 "Find a list of site-specific directories in the XEmacs hierarchy.
245 ROOTS must be a list of installation roots. 252 ROOTS must be a list of installation roots.
246 BASE is the base to look for. 253 BASES is a list of bases to look for.
247 ARCH-DEPENDENT-P says whether the file is architecture-specific. 254 ARCH-DEPENDENT-P says whether the file is architecture-specific.
248 ENVVAR is the name of the environment variable that might also 255 ENVVAR is the name of the environment variable that might also
249 specify the directory. 256 specify the directory.
250 DEFAULT is the preferred value." 257 DEFAULT is the preferred value."
251 (let ((l '())) 258 (let ((l '()))
252 (paths-for-each-site-directory #'(lambda (dir) 259 (paths-for-each-site-directory #'(lambda (dir)
253 (setq l (cons dir l))) 260 (setq l (cons dir l)))
254 roots base arch-dependent-p 261 roots bases arch-dependent-p
255 envvar default) 262 envvar default)
256 (reverse l))) 263 (reverse l)))
257 264
258 (defun paths-for-each-version-directory (func roots base arch-dependent-p 265 (defun paths-for-each-version-directory (func roots bases arch-dependent-p
259 &optional envvar default enforce-version) 266 &optional envvar default enforce-version)
260 "Iterate over version-specific directories in the XEmacs hierarchy. 267 "Iterate over version-specific directories in the XEmacs hierarchy.
261 FUNC is a function that called for each directory, with the directory 268 FUNC is a function that called for each directory, with the directory
262 as the only argument. 269 as the only argument.
263 ROOTS must be a list of installation roots. 270 ROOTS must be a list of installation roots.
264 BASE is the base to look for. 271 BASES is a list of possible bases to look for.
265 ARCH-DEPENDENT-P says whether the file is architecture-specific. 272 ARCH-DEPENDENT-P says whether the file is architecture-specific.
266 ENVVAR is the name of the environment variable that might also 273 ENVVAR is the name of the environment variable that might also
267 specify the directory. 274 specify the directory.
268 DEFAULT is the preferred value. 275 DEFAULT is the preferred value.
269 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." 276 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
271 roots 278 roots
272 (file-name-as-directory 279 (file-name-as-directory
273 (paths-construct-path 280 (paths-construct-path
274 (list (if arch-dependent-p "lib" "share") 281 (list (if arch-dependent-p "lib" "share")
275 (construct-emacs-version-name)))) 282 (construct-emacs-version-name))))
276 base 283 bases
277 envvar default)) 284 envvar default))
278 285
279 (defun paths-find-version-directory (roots base arch-dependent-p 286 (defun paths-find-version-directory (roots bases arch-dependent-p
280 &optional envvar default enforce-version) 287 &optional envvar default enforce-version)
281 "Find a version-specific directory in the XEmacs hierarchy. 288 "Find a version-specific directory in the XEmacs hierarchy.
282 ROOTS must be a list of installation roots. 289 ROOTS must be a list of installation roots.
283 BASE is the base to look for. 290 BASES is a list of possible bases to look for.
284 ARCH-DEPENDENT-P says whether the file is architecture-specific. 291 ARCH-DEPENDENT-P says whether the file is architecture-specific.
285 ENVVAR is the name of the environment variable that might also 292 ENVVAR is the name of the environment variable that might also
286 specify the directory. 293 specify the directory.
287 DEFAULT is the preferred value. 294 DEFAULT is the preferred value.
288 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." 295 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
289 (catch 'gotcha 296 (catch 'gotcha
290 (paths-for-each-version-directory #'(lambda (dir) 297 (paths-for-each-version-directory #'(lambda (dir)
291 (throw 'gotcha dir)) 298 (throw 'gotcha dir))
292 roots base arch-dependent-p 299 roots bases arch-dependent-p
293 envvar default))) 300 envvar default)))
294 301
295 (defun paths-find-version-directories (roots base arch-dependent-p 302 (defun paths-find-version-directories (roots bases arch-dependent-p
296 &optional envvar default enforce-version) 303 &optional envvar default enforce-version)
297 "Find a list of version-specific directories in the XEmacs hierarchy. 304 "Find a list of version-specific directories in the XEmacs hierarchy.
298 ROOTS must be a list of installation roots. 305 ROOTS must be a list of installation roots.
299 BASE is the base to look for. 306 BASES is a list of possible bases to look for.
300 ARCH-DEPENDENT-P says whether the file is architecture-specific. 307 ARCH-DEPENDENT-P says whether the file is architecture-specific.
301 ENVVAR is the name of the environment variable that might also 308 ENVVAR is the name of the environment variable that might also
302 specify the directory. 309 specify the directory.
303 DEFAULT is the preferred value. 310 DEFAULT is the preferred value.
304 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." 311 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
305 (let ((l '())) 312 (let ((l '()))
306 (paths-for-each-version-directory #'(lambda (dir) 313 (paths-for-each-version-directory #'(lambda (dir)
307 (setq l (cons dir l))) 314 (setq l (cons dir l)))
308 roots base arch-dependent-p 315 roots bases arch-dependent-p
309 envvar default) 316 envvar default)
310 (reverse l))) 317 (reverse l)))
311 318
312 (defun paths-find-architecture-directory (roots base &optional envvar default) 319 (defun paths-find-architecture-directory (roots bases &optional envvar default)
313 "Find an architecture-specific directory in the XEmacs hierarchy. 320 "Find an architecture-specific directory in the XEmacs hierarchy.
314 ROOTS must be a list of installation roots. 321 ROOTS must be a list of installation roots.
315 BASE is the base to look for. 322 BASES is a list of possible bases to look for.
316 ENVVAR is the name of the environment variable that might also 323 ENVVAR is the name of the environment variable that might also
317 specify the directory. 324 specify the directory.
318 DEFAULT is the preferred value." 325 DEFAULT is the preferred value."
319 (or 326 (paths-find-version-directory roots
320 ;; from more to less specific 327 ;; from more to less specific
321 (paths-find-version-directory roots 328 (append
322 (paths-construct-path 329 (mapcar
323 (list system-configuration base)) 330 #'(lambda (base)
324 t 331 (paths-construct-path
325 envvar default) 332 (list system-configuration base)))
326 (paths-find-version-directory roots 333 bases)
327 base t 334 bases
328 envvar) 335 (list system-configuration))
329 (paths-find-version-directory roots 336 t
330 system-configuration t 337 envvar default))
331 envvar)))
332 338
333 (defun construct-emacs-version-name () 339 (defun construct-emacs-version-name ()
334 "Construct a string from the raw XEmacs version number." 340 "Construct a string from the raw XEmacs version number."
335 (concat emacs-program-name "-" emacs-program-version)) 341 (concat emacs-program-name "-" emacs-program-version))
336 342