Mercurial > hg > xemacs-beta

comparison lisp/find-paths.el @ 410:de805c49cfc1 r21-2-35

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-35
author cvs
date Mon, 13 Aug 2007 11:19:21 +0200
parents 74fd4e045ea6
children 697ef44129c6
comparison
equal deleted inserted replaced
409:301b9ebbdf3b 410:de805c49cfc1
107 ;; in-place or windows-nt 107 ;; in-place or windows-nt
108 (and 108 (and
109 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp"))) 109 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp")))
110 (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))))) 110 (paths-file-readable-directory-p (paths-construct-path (list directory "etc"))))))
111 111
112 (defun paths-root-in-place-p (root)
113 "Check if ROOT is an in-place installation root for XEmacs."
114 (paths-file-readable-directory-p (paths-construct-path (list root "lisp"))))
115
112 (defun paths-chase-symlink (file-name) 116 (defun paths-chase-symlink (file-name)
113 "Chase a symlink until the bitter end." 117 "Chase a symlink until the bitter end."
114 (let ((maybe-symlink (file-symlink-p file-name))) 118 (let ((maybe-symlink (file-symlink-p file-name)))
115 (if maybe-symlink 119 (if maybe-symlink
116 (let* ((directory (file-name-directory file-name)) 120 (let* ((directory (file-name-directory file-name))
157 (file-name-as-directory root) 161 (file-name-as-directory root)
158 suffix 162 suffix
159 base)))) 163 base))))
160 164
161 (defun paths-find-emacs-directory (roots suffix base 165 (defun paths-find-emacs-directory (roots suffix base
162 &optional envvar default keep-suffix) 166 &optional envvar default keep-suffix
167 in-place-external)
163 "Find a directory in the XEmacs hierarchy. 168 "Find a directory in the XEmacs hierarchy.
164 ROOTS must be a list of installation roots. 169 ROOTS must be a list of installation roots.
165 SUFFIX is the subdirectory from there. 170 SUFFIX is the subdirectory from there.
166 BASE is the base to look for. 171 BASE is the base to look for.
167 ENVVAR is the name of the environment variable that might also 172 ENVVAR is the name of the environment variable that might also
168 specify the directory. 173 specify the directory.
169 DEFAULT is the preferred value. 174 DEFAULT is the preferred value.
170 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching 175 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
171 the directory." 176 the directory.
177 If IN-PLACE-EXTERNAL is non-nil, the directory might be found outside
178 an in-place root-hierarchy."
172 (let ((preferred-value (or (and envvar (getenv envvar)) 179 (let ((preferred-value (or (and envvar (getenv envvar))
173 default))) 180 default)))
174 (if (and preferred-value 181 (if (and preferred-value
175 (paths-file-readable-directory-p preferred-value)) 182 (paths-file-readable-directory-p preferred-value))
176 (file-name-as-directory preferred-value) 183 (file-name-as-directory preferred-value)
177 (catch 'gotcha 184 (catch 'gotcha
178 (while roots 185 (while roots
179 (let* ((root (car roots)) 186 (let ((root (car roots)))
180 ;; installed 187 ;; installed
181 (path (paths-construct-emacs-directory root suffix base))) 188 (let ((path (paths-construct-emacs-directory root suffix base)))
182 (if (paths-file-readable-directory-p path) 189 (if (paths-file-readable-directory-p path)
183 (throw 'gotcha path) 190 (throw 'gotcha path)))
184 ;; in-place 191 ;; in-place
185 (if (null keep-suffix) 192 (if (null keep-suffix)
186 (let ((path (paths-construct-emacs-directory root "" base))) 193 (let ((path (paths-construct-emacs-directory root "" base)))
187 (if (paths-file-readable-directory-p path) 194 (if (paths-file-readable-directory-p path)
188 (throw 'gotcha path)))))) 195 (throw 'gotcha path))))
196 (if (and in-place-external
197 (paths-root-in-place-p root))
198 (let ((path (paths-construct-emacs-directory
199 (paths-construct-path '("..") root)
200 "" base)))
201 (if (paths-file-readable-directory-p path)
202 (throw 'gotcha path)))))
189 (setq roots (cdr roots))) 203 (setq roots (cdr roots)))
190 nil)))) 204 nil))))
191 205
192 (defun paths-find-site-directory (roots base &optional envvar default) 206 (defun paths-find-site-directory (roots base &optional envvar default in-place-external)
193 "Find a site-specific directory in the XEmacs hierarchy." 207 "Find a site-specific directory in the XEmacs hierarchy.
208 If IN-PLACE-EXTERNAL is non-nil, the directory might be found outside
209 an in-place root-hierarchy."
194 (paths-find-emacs-directory roots 210 (paths-find-emacs-directory roots
195 (file-name-as-directory 211 (file-name-as-directory
196 (paths-construct-path (list 212 (paths-construct-path (list
197 "lib" 213 "lib"
198 emacs-program-name))) 214 emacs-program-name)))
199 base 215 base
200 envvar default)) 216 envvar default
217 nil
218 in-place-external))
201 219
202 (defun paths-find-version-directory (roots base 220 (defun paths-find-version-directory (roots base
203 &optional envvar default enforce-version) 221 &optional envvar default enforce-version)
204 "Find a version-specific directory in the XEmacs hierarchy. 222 "Find a version-specific directory in the XEmacs hierarchy.
205 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." 223 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."