1 ;;; find-paths.el --- setup various XEmacs paths
3 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc.
4 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc.
5 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
7 ;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de>
8 ;; Maintainer: XEmacs Development Team
9 ;; Keywords: internal, dumped
11 ;; This file is part of XEmacs.
13 ;; XEmacs is free software; you can redistribute it and/or modify it
14 ;; under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; XEmacs is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with XEmacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
28 ;;; Synched up with: Not in FSF.
32 ;; This file is dumped with XEmacs.
34 ;; This file contains the library functionality to find paths into the
39 (defvar paths-version-control-filename-regexp
40 "^\\(RCS\\|CVS\\|SCCS\\)$"
41 "File bases associated with version control.")
43 (defvar paths-lisp-filename-regexp
45 "File bases that contain Lisp file.")
47 (defvar paths-no-lisp-directory-regexp
48 (concat "\\(" paths-version-control-filename-regexp "\\)"
50 "\\(" paths-lisp-filename-regexp "\\)")
51 "File bases that may not be directories containing Lisp code.")
53 (defun paths-find-recursive-path (directories &optional max-depth exclude-regexp)
54 "Return a list of the directory hierarchy underneath DIRECTORIES.
55 The returned list is sorted by pre-order and lexicographically.
56 MAX-DEPTH limits the depth of the search to MAX-DEPTH level,
57 if it is a number. If MAX-DEPTH is NIL, the search depth is unlimited.
58 EXCLUDE-REGEXP is a regexp that matches directory names to exclude
62 (let ((directory (file-name-as-directory
65 (if (paths-file-readable-directory-p directory)
67 (if (equal 0 max-depth)
69 (directory-files directory nil "^[^.-]")))
73 (if (null (string-match exclude-regexp (car raw-entries)))
75 (cons (expand-file-name (car raw-entries) directory)
77 (setq raw-entries (cdr raw-entries)))
80 (paths-find-recursive-path (reverse reverse-dirs)
81 (if (numberp max-depth)
85 (setq path (nconc path
88 (setq directories (cdr directories)))
91 (defun paths-file-readable-directory-p (filename)
92 "Check if filename is a readable directory."
93 (and (file-directory-p filename)
94 (file-readable-p filename)))
96 (defun paths-find-recursive-load-path (directories &optional max-depth)
97 "Construct a recursive load path underneath DIRECTORIES."
98 (paths-find-recursive-path directories
99 max-depth paths-no-lisp-directory-regexp))
101 (defun paths-emacs-root-p (directory)
102 "Check if DIRECTORY is a plausible installation root for XEmacs."
105 (paths-file-readable-directory-p (paths-construct-path (list directory
107 emacs-program-name)))
108 ;; in-place or windows-nt
110 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp")))
111 (paths-file-readable-directory-p (paths-construct-path (list directory "etc"))))))
113 (defun paths-chase-symlink (file-name)
114 "Chase a symlink until the bitter end."
115 (let ((maybe-symlink (file-symlink-p file-name)))
117 (let* ((directory (file-name-directory file-name))
118 (destination (expand-file-name maybe-symlink directory)))
119 (paths-chase-symlink destination))
122 (defun paths-find-emacs-root
123 (invocation-directory invocation-name)
124 "Find the run-time root of XEmacs."
125 (let* ((executable-file-name (paths-chase-symlink
126 (concat invocation-directory
128 (executable-directory (file-name-directory executable-file-name))
129 (maybe-root-1 (file-name-as-directory
130 (paths-construct-path '("..") executable-directory)))
131 (maybe-root-2 (file-name-as-directory
132 (paths-construct-path '(".." "..") executable-directory))))
133 (or (and (paths-emacs-root-p maybe-root-1)
135 (and (paths-emacs-root-p maybe-root-2)
138 (defun paths-construct-path (components &optional expand-directory)
139 "Convert list of path components COMPONENTS into a path.
140 If EXPAND-DIRECTORY is non-NIL, use it as a directory to feed
141 to EXPAND-FILE-NAME."
142 (let* ((reverse-components (reverse components))
143 (last-component (car reverse-components))
144 (first-components (reverse (cdr reverse-components)))
147 (append (mapcar #'file-name-as-directory first-components)
148 (list last-component)))))
150 (expand-file-name path expand-directory)
153 (defun paths-construct-emacs-directory (root suffix base)
154 "Construct a directory name within the XEmacs hierarchy."
155 (file-name-as-directory
158 (file-name-as-directory root)
162 (defun paths-find-emacs-directory (roots suffix base
163 &optional envvar default keep-suffix)
164 "Find a directory in the XEmacs hierarchy.
165 ROOTS must be a list of installation roots.
166 SUFFIX is the subdirectory from there.
167 BASE is the base to look for.
168 ENVVAR is the name of the environment variable that might also
169 specify the directory.
170 DEFAULT is the preferred value.
171 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
173 (let ((preferred-value (or (and envvar (getenv envvar))
175 (if (and preferred-value
176 (paths-file-readable-directory-p preferred-value))
177 (file-name-as-directory preferred-value)
180 (let* ((root (car roots))
182 (path (paths-construct-emacs-directory root suffix base)))
183 (if (paths-file-readable-directory-p path)
186 (if (null keep-suffix)
187 (let ((path (paths-construct-emacs-directory root "" base)))
188 (if (paths-file-readable-directory-p path)
189 (throw 'gotcha path))))))
190 (setq roots (cdr roots)))
193 (defun paths-find-site-directory (roots base &optional envvar default)
194 "Find a site-specific directory in the XEmacs hierarchy."
195 (paths-find-emacs-directory roots
196 (file-name-as-directory
197 (paths-construct-path (list
199 emacs-program-name)))
203 (defun paths-find-version-directory (roots base
204 &optional envvar default enforce-version)
205 "Find a version-specific directory in the XEmacs hierarchy.
206 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
207 (paths-find-emacs-directory roots
208 (file-name-as-directory
209 (paths-construct-path
211 (construct-emacs-version-name))))
216 (defun paths-find-architecture-directory (roots base &optional envvar default)
217 "Find an architecture-specific directory in the XEmacs hierarchy."
219 ;; from more to less specific
220 (paths-find-version-directory roots
221 (concat base system-configuration)
223 (paths-find-version-directory roots
226 (paths-find-version-directory roots
230 (defun construct-emacs-version-name ()
231 "Construct the raw XEmacs version number."
232 (concat emacs-program-name "-" emacs-program-version))
234 (defun paths-directories-which-exist (directories)
235 "Return the directories among DIRECTORIES."
236 (let ((reverse-directories '()))
238 (if (paths-file-readable-directory-p (car directories))
239 (setq reverse-directories
240 (cons (car directories)
241 reverse-directories)))
242 (setq directories (cdr directories)))
243 (reverse reverse-directories)))
245 (defun paths-uniq-append (list-1 list-2)
246 "Append LIST-1 and LIST-2, omitting duplicates."
247 (let ((reverse-survivors '()))
249 (if (null (member (car list-2) list-1))
250 (setq reverse-survivors (cons (car list-2) reverse-survivors)))
251 (setq list-2 (cdr list-2)))
253 (reverse reverse-survivors))))
255 (defun paths-filter (predicate list)
256 "Delete all matches of PREDICATE from LIST."
257 (let ((reverse-result '()))
259 (if (funcall predicate (car list))
260 (setq reverse-result (cons (car list) reverse-result)))
261 (setq list (cdr list)))
262 (nreverse reverse-result)))
264 (defun paths-decode-directory-path (string &optional drop-empties)
265 "Split STRING at path separators into a directory list.
266 Non-\"\" comonents are converted into directory form.
267 If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output.
268 Otherwise, they are left alone."
269 (let* ((components (split-path string))
271 (mapcar #'(lambda (component)
272 (if (string-equal "" component)
274 (file-name-as-directory component)))
277 (paths-filter #'(lambda (component)
278 (null (string-equal "" component)))
282 (defun paths-find-emacs-roots (invocation-directory
284 "Find all plausible installation roots for XEmacs."
285 (let* ((potential-invocation-root
286 (paths-find-emacs-root invocation-directory invocation-name))
288 (and potential-invocation-root
289 (list potential-invocation-root)))
290 (potential-installation-roots
292 (and configure-exec-prefix-directory
293 (list (file-name-as-directory
294 configure-exec-prefix-directory)))
295 (and configure-prefix-directory
296 (list (file-name-as-directory
297 configure-prefix-directory)))))
299 (paths-filter #'paths-emacs-root-p potential-installation-roots)))
300 (paths-uniq-append invocation-roots
301 installation-roots)))
303 ;;; find-paths.el ends here