Mercurial > hg > xemacs-beta

comparison lisp/find-paths.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children 11054d720c21
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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
116 (defun paths-chase-symlink (file-name) 112 (defun paths-chase-symlink (file-name)
117 "Chase a symlink until the bitter end." 113 "Chase a symlink until the bitter end."
118 (let ((maybe-symlink (file-symlink-p file-name))) 114 (let ((maybe-symlink (file-symlink-p file-name)))
119 (if maybe-symlink 115 (if maybe-symlink
120 (let* ((directory (file-name-directory file-name)) 116 (let* ((directory (file-name-directory file-name))
161 (file-name-as-directory root) 157 (file-name-as-directory root)
162 suffix 158 suffix
163 base)))) 159 base))))
164 160
165 (defun paths-find-emacs-directory (roots suffix base 161 (defun paths-find-emacs-directory (roots suffix base
166 &optional envvar default keep-suffix 162 &optional envvar default keep-suffix)
167 in-place-external)
168 "Find a directory in the XEmacs hierarchy. 163 "Find a directory in the XEmacs hierarchy.
169 ROOTS must be a list of installation roots. 164 ROOTS must be a list of installation roots.
170 SUFFIX is the subdirectory from there. 165 SUFFIX is the subdirectory from there.
171 BASE is the base to look for. 166 BASE is the base to look for.
172 ENVVAR is the name of the environment variable that might also 167 ENVVAR is the name of the environment variable that might also
173 specify the directory. 168 specify the directory.
174 DEFAULT is the preferred value. 169 DEFAULT is the preferred value.
175 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching 170 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
176 the directory. 171 the directory."
177 If IN-PLACE-EXTERNAL is non-nil, the directory might be found outside
178 an in-place root-hierarchy."
179 (let ((preferred-value (or (and envvar (getenv envvar)) 172 (let ((preferred-value (or (and envvar (getenv envvar))
180 default))) 173 default)))
181 (if (and preferred-value 174 (if (and preferred-value
182 (paths-file-readable-directory-p preferred-value)) 175 (paths-file-readable-directory-p preferred-value))
183 (file-name-as-directory preferred-value) 176 (file-name-as-directory preferred-value)
184 (catch 'gotcha 177 (catch 'gotcha
185 (while roots 178 (while roots
186 (let ((root (car roots))) 179 (let* ((root (car roots))
187 ;; installed 180 ;; installed
188 (let ((path (paths-construct-emacs-directory root suffix base))) 181 (path (paths-construct-emacs-directory root suffix base)))
189 (if (paths-file-readable-directory-p path) 182 (if (paths-file-readable-directory-p path)
190 (throw 'gotcha path))) 183 (throw 'gotcha path)
191 ;; in-place 184 ;; in-place
192 (if (null keep-suffix) 185 (if (null keep-suffix)
193 (let ((path (paths-construct-emacs-directory root "" base))) 186 (let ((path (paths-construct-emacs-directory root "" base)))
194 (if (paths-file-readable-directory-p path) 187 (if (paths-file-readable-directory-p path)
195 (throw 'gotcha path)))) 188 (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)))))
203 (setq roots (cdr roots))) 189 (setq roots (cdr roots)))
204 nil)))) 190 nil))))
205 191
206 (defun paths-find-site-directory (roots base &optional envvar default in-place-external) 192 (defun paths-find-site-directory (roots base &optional envvar default)
207 "Find a site-specific directory in the XEmacs hierarchy. 193 "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."
210 (paths-find-emacs-directory roots 194 (paths-find-emacs-directory roots
211 (file-name-as-directory 195 (file-name-as-directory
212 (paths-construct-path (list 196 (paths-construct-path (list
213 "lib" 197 "lib"
214 emacs-program-name))) 198 emacs-program-name)))
215 base 199 base
216 envvar default 200 envvar default))
217 nil
218 in-place-external))
219 201
220 (defun paths-find-version-directory (roots base 202 (defun paths-find-version-directory (roots base
221 &optional envvar default enforce-version) 203 &optional envvar default enforce-version)
222 "Find a version-specific directory in the XEmacs hierarchy. 204 "Find a version-specific directory in the XEmacs hierarchy.
223 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." 205 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
234 "Find an architecture-specific directory in the XEmacs hierarchy." 216 "Find an architecture-specific directory in the XEmacs hierarchy."
235 (or 217 (or
236 ;; from more to less specific 218 ;; from more to less specific
237 (paths-find-version-directory roots 219 (paths-find-version-directory roots
238 (concat base system-configuration) 220 (concat base system-configuration)
239 envvar default) 221 envvar)
240 (paths-find-version-directory roots 222 (paths-find-version-directory roots
241 base 223 base
242 envvar) 224 envvar)
243 (paths-find-version-directory roots 225 (paths-find-version-directory roots
244 system-configuration 226 system-configuration
245 envvar))) 227 envvar default)))
246 228
247 (defun construct-emacs-version-name () 229 (defun construct-emacs-version-name ()
248 "Construct the raw XEmacs version number." 230 "Construct the raw XEmacs version number."
249 (concat emacs-program-name "-" emacs-program-version)) 231 (concat emacs-program-name "-" emacs-program-version))
250 232