Mercurial > hg > xemacs-beta

comparison lisp/find-paths.el @ 280:7df0dd720c89 r21-0b38

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b38
author cvs
date Mon, 13 Aug 2007 10:32:22 +0200
parents 90d73dddcdc4
children 558f606b08ae
comparison
equal deleted inserted replaced
279:c20b2fb5bb0a 280:7df0dd720c89
83 83
84 (defun paths-emacs-root-p (directory) 84 (defun paths-emacs-root-p (directory)
85 "Check if DIRECTORY is a plausible installation root for XEmacs." 85 "Check if DIRECTORY is a plausible installation root for XEmacs."
86 (or 86 (or
87 ;; installed 87 ;; installed
88 (file-directory-p (paths-construct-path (list directory "lib" "xemacs"))) 88 (file-directory-p (paths-construct-path (list directory
89 "lib"
90 emacs-program-name)))
89 ;; in-place 91 ;; in-place
90 (and 92 (and
91 (file-directory-p (paths-construct-path (list directory "lib-src"))) 93 (file-directory-p (paths-construct-path (list directory "lib-src")))
92 (file-directory-p (paths-construct-path (list directory "lisp"))) 94 (file-directory-p (paths-construct-path (list directory "lisp")))
93 (file-directory-p (paths-construct-path (list directory "src")))))) 95 (file-directory-p (paths-construct-path (list directory "src"))))))
139 (concat 141 (concat
140 (file-name-as-directory root) 142 (file-name-as-directory root)
141 suffix 143 suffix
142 base)))) 144 base))))
143 145
144 (defun paths-find-emacs-directory (roots suffix base &optional envvar default) 146 (defun paths-find-emacs-directory (roots suffix base
147 &optional envvar default keep-suffix)
145 "Find a directory in the XEmacs hierarchy. 148 "Find a directory in the XEmacs hierarchy.
146 ROOTS must be a list of installation roots. 149 ROOTS must be a list of installation roots.
147 SUFFIX is the subdirectory from there. 150 SUFFIX is the subdirectory from there.
148 BASE is the base to look for. 151 BASE is the base to look for.
149 ENVVAR is the name of the environment variable that might also 152 ENVVAR is the name of the environment variable that might also
150 specify the directory. 153 specify the directory.
151 DEFAULT is the preferred value." 154 DEFAULT is the preferred value.
155 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
156 the directory."
152 (let ((preferred-value (or (and envvar (getenv envvar)) 157 (let ((preferred-value (or (and envvar (getenv envvar))
153 default))) 158 default)))
154 (if (and preferred-value 159 (if (and preferred-value
155 (file-directory-p preferred-value)) 160 (file-directory-p preferred-value))
156 (file-name-as-directory preferred-value) 161 (file-name-as-directory preferred-value)
157 (catch 'gotcha 162 (catch 'gotcha
158 (while roots 163 (while roots
159 (let* ((root (car roots)) 164 (let* ((root (car roots))
165 ;; installed
160 (path (paths-construct-emacs-directory root suffix base))) 166 (path (paths-construct-emacs-directory root suffix base)))
161 ;; installed
162 (if (file-directory-p path) 167 (if (file-directory-p path)
163 (throw 'gotcha path) 168 (throw 'gotcha path)
164 (let ((path (paths-construct-emacs-directory root "" base))) 169 ;; in-place
165 ;; in-place 170 (if (null keep-suffix)
166 (if (file-directory-p path) 171 (let ((path (paths-construct-emacs-directory root "" base)))
167 (throw 'gotcha path))))) 172 (if (file-directory-p path)
173 (throw 'gotcha path))))))
168 (setq roots (cdr roots))) 174 (setq roots (cdr roots)))
169 nil)))) 175 nil))))
170 176
171 (defun paths-find-site-directory (roots base &optional envvar default) 177 (defun paths-find-site-directory (roots base &optional envvar default)
172 "Find a site-specific directory in the XEmacs hierarchy." 178 "Find a site-specific directory in the XEmacs hierarchy."
173 (paths-find-emacs-directory roots 179 (paths-find-emacs-directory roots
174 (file-name-as-directory 180 (file-name-as-directory
175 (paths-construct-path '("lib" "xemacs"))) 181 (paths-construct-path (list
182 "lib"
183 emacs-program-name)))
176 base 184 base
177 envvar default)) 185 envvar default))
178 186
179 (defun paths-find-version-directory (roots base &optional envvar default) 187 (defun paths-find-version-directory (roots base
180 "Find a version-specific directory in the XEmacs hierarchy." 188 &optional envvar default enforce-version)
189 "Find a version-specific directory in the XEmacs hierarchy.
190 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
181 (paths-find-emacs-directory roots 191 (paths-find-emacs-directory roots
182 (file-name-as-directory 192 (file-name-as-directory
183 (paths-construct-path 193 (paths-construct-path
184 (list "lib" 194 (list "lib"
185 (concat "xemacs-" 195 (construct-emacs-version-name))))
186 (construct-emacs-version)))))
187 base 196 base
188 envvar default)) 197 envvar default
198 enforce-version))
189 199
190 (defun paths-find-architecture-directory (roots base &optional envvar default) 200 (defun paths-find-architecture-directory (roots base &optional envvar default)
191 "Find an architecture-specific directory in the XEmacs hierarchy." 201 "Find an architecture-specific directory in the XEmacs hierarchy."
192 (or 202 (or
193 ;; from more to less specific 203 ;; from more to less specific
198 base 208 base
199 envvar) 209 envvar)
200 (paths-find-version-directory roots 210 (paths-find-version-directory roots
201 system-configuration 211 system-configuration
202 envvar default))) 212 envvar default)))
203 213
204 (defvar paths-path-emacs-version nil 214 (defun construct-emacs-version-name ()
205 "Emacs version as it appears in paths.") 215 "Construct the raw XEmacs version number."
206 216 (concat emacs-program-name "-" emacs-program-version))
207 (defun construct-emacs-version ()
208 "Construct the raw version number of XEmacs in the form XX.XX."
209 ;; emacs-version isn't available early, but we really don't care then
210 (if (null (boundp 'emacs-version))
211 "XX.XX"
212 (or paths-path-emacs-version ; cache
213 (progn
214 (string-match "\\`[^0-9]*\\([0-9]+\\.[0-9]+\\)" emacs-version)
215 (let ((version (substring emacs-version
216 (match-beginning 1) (match-end 1))))
217 (if (string-match "(beta *\\([0-9]+\\))" emacs-version)
218 (setq version (concat version
219 "-b"
220 (substring emacs-version
221 (match-beginning 1) (match-end 1)))))
222 (setq paths-path-emacs-version version)
223 version)))))
224 217
225 (defun paths-directories-which-exist (directories) 218 (defun paths-directories-which-exist (directories)
226 "Return the directories among DIRECTORIES." 219 "Return the directories among DIRECTORIES."
227 (let ((reverse-directories '())) 220 (let ((reverse-directories '()))
228 (while directories 221 (while directories