Mercurial > hg > xemacs-beta

comparison lisp/find-paths.el @ 267:966663fcf606 r20-5b32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b32
author cvs
date Mon, 13 Aug 2007 10:26:29 +0200
parents
children b2472a1930f2
comparison
equal deleted inserted replaced
266:18d185df8c54 267:966663fcf606
1 ;;; find-paths.el --- setup various XEmacs paths
2
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
6
7 ;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de>
8 ;; Maintainer: XEmacs Development Team
9 ;; Keywords: internal, dumped
10
11 ;; This file is part of XEmacs.
12
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)
16 ;; any later version.
17
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.
22
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.
27
28 ;;; Synched up with: Not in FSF.
29
30 ;;; Commentary:
31
32 ;; This file is dumped with XEmacs.
33
34 ;; This file contains the library functionality to find paths into the
35 ;; XEmacs hierarchy.
36
37 ;;; Code:
38
39 (defvar paths-version-control-bases '("RCS" "CVS" "SCCS")
40 "File bases associated with version control.")
41
42 (defun paths-find-recursive-path (directories &optional exclude)
43 "Return a list of the directory hierarchy underneath DIRECTORIES.
44 The returned list is sorted by pre-order and lexicographically."
45 (let ((path '()))
46 (while directories
47 (let ((directory (file-name-as-directory
48 (expand-file-name
49 (car directories)))))
50 (if (file-directory-p directory)
51 (let ((raw-dirs (directory-files directory nil "^[^-.]" nil 'dirs-only))
52 (reverse-dirs '()))
53
54 (while raw-dirs
55 (if (null (member (car raw-dirs) exclude))
56 (setq reverse-dirs
57 (cons (expand-file-name (car raw-dirs) directory)
58 reverse-dirs)))
59 (setq raw-dirs (cdr raw-dirs)))
60
61 (let ((sub-path
62 (paths-find-recursive-path (reverse reverse-dirs) exclude)))
63 (setq path (nconc path
64 (list directory)
65 sub-path))))))
66 (setq directories (cdr directories)))
67 path))
68
69 (defun paths-find-recursive-load-path (directories)
70 "Construct a recursive load path underneath DIRECTORIES."
71 (paths-find-recursive-path directories paths-version-control-bases))
72
73 (defun paths-emacs-root-p (directory)
74 "Check if DIRECTORY is a plausible installation root for XEmacs."
75 (or
76 ;; installed
77 (file-directory-p
78 (concat directory "lib/xemacs-" (construct-emacs-version)))
79 ;; in-place
80 (and
81 (file-directory-p (concat directory "lib-src"))
82 (file-directory-p (concat directory "lisp"))
83 (file-directory-p (concat directory "src")))))
84
85 (defun paths-find-emacs-root
86 (invocation-directory invocation-name)
87 "Find the run-time root of XEmacs."
88 (let ((maybe-root-1 (file-name-as-directory
89 (expand-file-name ".." invocation-directory)))
90 (maybe-root-2 (file-name-as-directory
91 (expand-file-name "../.." invocation-directory))))
92 (cond
93 ((paths-emacs-root-p maybe-root-1)
94 maybe-root-1)
95 ((paths-emacs-root-p maybe-root-2)
96 maybe-root-2)
97 (t
98 (let ((maybe-symlink (file-symlink-p (concat invocation-directory
99 invocation-name))))
100 (if maybe-symlink
101 (let ((directory (file-name-directory maybe-symlink)))
102 (paths-find-emacs-root directory invocation-name))
103 nil))))))
104
105 (defun paths-construct-emacs-directory (root suffix base)
106 "Construct a directory name within the XEmacs hierarchy."
107 (file-name-as-directory
108 (expand-file-name
109 (concat
110 (file-name-as-directory root)
111 suffix
112 base))))
113
114 (defun paths-find-emacs-directory (roots suffix base &optional envvar default)
115 "Find a directory in the XEmacs hierarchy.
116 ROOTS must be a list of installation roots.
117 SUFFIX is the subdirectory from there.
118 BASE is the base to look for.
119 ENVVAR is the name of the environment variable that might also
120 specify the directory.
121 DEFAULT is a fall-back value."
122 (let ((envvar-value (and envvar (getenv envvar))))
123 (if (and envvar-value
124 (file-directory-p envvar-value))
125 (file-name-as-directory envvar-value)
126 (catch 'gotcha
127 (while roots
128 (let* ((root (car roots))
129 (path (paths-construct-emacs-directory root suffix base)))
130 ;; installed
131 (if (file-directory-p path)
132 (throw 'gotcha path)
133 (let ((path (paths-construct-emacs-directory root "" base)))
134 ;; in-place
135 (if (file-directory-p path)
136 (throw 'gotcha path)))))
137 (setq roots (cdr roots)))
138 (if (and default
139 (file-directory-p default))
140 (file-name-as-directory default)
141 nil)))))
142
143 (defun paths-find-site-directory (roots base &optional envvar default)
144 "Find a site-specific directory in the XEmacs hierarchy."
145 (paths-find-emacs-directory roots "lib/xemacs/" base envvar default))
146
147 (defun paths-find-version-directory (roots base &optional envvar default)
148 "Find a version-specific directory in the XEmacs hierarchy."
149 (paths-find-emacs-directory roots
150 (concat "lib/xemacs-" (construct-emacs-version) "/")
151 base
152 envvar default))
153
154 (defun paths-find-architecture-directory (roots base &optional envvar default)
155 "Find an architecture-specific directory in the XEmacs hierarchy."
156 (or
157 ;; from more to less specific
158 (paths-find-version-directory roots
159 (concat base system-configuration)
160 envvar default)
161 (paths-find-version-directory roots
162 system-configuration
163 envvar default)
164 (paths-find-version-directory roots
165 base
166 envvar default)))
167
168 (defvar paths-path-emacs-version nil
169 "Emacs version as it appears in paths.")
170
171 (defun construct-emacs-version ()
172 "Construct the raw version number of XEmacs in the form XX.XX."
173 ;; emacs-version isn't available early, but we really don't care then
174 (if (null (boundp 'emacs-version))
175 "XX.XX"
176 (or paths-path-emacs-version ; cache
177 (progn
178 (string-match "\\`[^0-9]*\\([0-9]+\\.[0-9]+\\)" emacs-version)
179 (let ((version (substring emacs-version
180 (match-beginning 1) (match-end 1))))
181 (if (string-match "(beta *\\([0-9]+\\))" emacs-version)
182 (setq version (concat version
183 "-b"
184 (substring emacs-version
185 (match-beginning 1) (match-end 1)))))
186 (setq paths-path-emacs-version version)
187 version)))))
188
189 (defun paths-find-emacs-path (roots suffix base &optional envvar default)
190 "Find a path in the XEmacs hierarchy.
191 ROOTS must be a list of installation roots.
192 SUFFIX is the subdirectory from there.
193 BASE is the base to look for.
194 ENVVAR is the name of the environment variable that might also
195 specify the path.
196 DEFAULT is a fall-back value."
197 (let ((envvar-value (and envvar (getenv envvar))))
198 (if envvar-value
199 (decode-path-internal envvar-value)
200 (let ((directory (paths-find-emacs-directory roots base suffix)))
201 (if (and directory (file-directory-p directory))
202 (list directory)
203 (paths-directories-which-exist default))))))
204
205 (defun paths-directories-which-exist (directories)
206 "Return the directories among DIRECTORIES."
207 (let ((reverse-directories '()))
208 (while directories
209 (if (file-directory-p (car directories))
210 (setq reverse-directories
211 (cons (car directories)
212 reverse-directories)))
213 (setq directories (cdr directories)))
214 (reverse reverse-directories)))
215
216 (defun paths-find-site-path (roots base &optional envvar default)
217 "Find a path underneath the site hierarchy."
218 (paths-find-emacs-path roots "lib/xemacs/" base envvar default))
219
220 (defun paths-find-version-path (roots base &optional envvar default)
221 "Find a path underneath the site hierarchy."
222 (paths-find-emacs-path roots
223 (concat "lib/xemacs-" (construct-emacs-version) "/")
224 base
225 envvar default))
226
227 (defun paths-find-emacs-roots (invocation-directory
228 invocation-name)
229 "Find all plausible installation roots for XEmacs."
230 (let ((invocation-root
231 (paths-find-emacs-root invocation-directory invocation-name))
232 (installation-root
233 (if (and configure-prefix-directory
234 (file-directory-p configure-prefix-directory))
235 configure-prefix-directory)))
236 (append (and invocation-root
237 (list invocation-root))
238 (and installation-root
239 (list installation-root)))))
240
241 ;;; find-paths.el ends here