|
265
|
1 ;;; setup-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 machinery necessary to find the various
|
|
|
35 ;; paths into the XEmacs hierarchy.
|
|
|
36
|
|
|
37 (defvar paths-version-control-bases '("RCS" "CVS" "SCCS")
|
|
|
38 "File bases associated with version control.")
|
|
|
39
|
|
|
40 (defun paths-find-recursive-path (directories &optional exclude)
|
|
|
41 "Return a list of the directory hierarchy underneath DIRECTORIES.
|
|
|
42 The returned list is sorted by pre-order and lexicographically."
|
|
|
43 (let ((path '()))
|
|
|
44 (while directories
|
|
|
45 (let ((directory (file-name-as-directory
|
|
|
46 (expand-file-name
|
|
|
47 (car directories)))))
|
|
|
48 (if (file-directory-p directory)
|
|
|
49 (let ((raw-dirs (directory-files directory nil "^[^-.]" nil 'dirs-only))
|
|
|
50 (reverse-dirs '()))
|
|
|
51
|
|
|
52 (while raw-dirs
|
|
|
53 (if (null (member (car raw-dirs) exclude))
|
|
|
54 (setq reverse-dirs
|
|
|
55 (cons (expand-file-name (car raw-dirs) directory)
|
|
|
56 reverse-dirs)))
|
|
|
57 (setq raw-dirs (cdr raw-dirs)))
|
|
|
58
|
|
|
59 (let ((sub-path
|
|
|
60 (paths-find-recursive-path (reverse reverse-dirs) exclude)))
|
|
|
61 (setq path (nconc path
|
|
|
62 (list directory)
|
|
|
63 sub-path))))))
|
|
|
64 (setq directories (cdr directories)))
|
|
|
65 path))
|
|
|
66
|
|
|
67 (defun paths-find-recursive-load-path (directories)
|
|
|
68 "Construct a recursive load path underneath DIRECTORIES."
|
|
|
69 (paths-find-recursive-path directories paths-version-control-bases))
|
|
|
70
|
|
|
71 (defun paths-emacs-root-p (directory)
|
|
|
72 "Check if DIRECTORY is a plausible installation root for XEmacs."
|
|
|
73 (or
|
|
|
74 ;; installed
|
|
|
75 (and (boundp 'emacs-version)
|
|
|
76 (file-directory-p
|
|
|
77 (concat directory "lib/xemacs-" (construct-emacs-version))))
|
|
|
78 ;; in-place
|
|
|
79 (and
|
|
|
80 (file-directory-p (concat directory "lib-src"))
|
|
|
81 (file-directory-p (concat directory "lisp"))
|
|
|
82 (file-directory-p (concat directory "src")))))
|
|
|
83
|
|
|
84 (defun paths-find-emacs-root
|
|
|
85 (invocation-directory invocation-name)
|
|
|
86 "Find the run-time root of XEmacs."
|
|
|
87 (let ((maybe-root-1 (file-name-as-directory
|
|
|
88 (expand-file-name ".." invocation-directory)))
|
|
|
89 (maybe-root-2 (file-name-as-directory
|
|
|
90 (expand-file-name "../.." invocation-directory))))
|
|
|
91 (cond
|
|
|
92 ((paths-emacs-root-p maybe-root-1)
|
|
|
93 maybe-root-1)
|
|
|
94 ((paths-emacs-root-p maybe-root-2)
|
|
|
95 maybe-root-2)
|
|
|
96 (t
|
|
|
97 (let ((maybe-symlink (file-symlink-p (concat invocation-directory
|
|
|
98 invocation-name))))
|
|
|
99 (if maybe-symlink
|
|
|
100 (let ((directory (file-name-directory maybe-symlink)))
|
|
|
101 (paths-find-emacs-root directory invocation-name))
|
|
|
102 nil))))))
|
|
|
103
|
|
|
104 (defun paths-construct-emacs-directory (root suffix base)
|
|
|
105 "Construct a directory name within the XEmacs hierarchy."
|
|
|
106 (file-name-as-directory
|
|
|
107 (expand-file-name
|
|
|
108 (concat
|
|
|
109 (file-name-as-directory root)
|
|
|
110 suffix
|
|
|
111 base))))
|
|
|
112
|
|
|
113 (defun paths-find-emacs-directory (roots suffix base &optional envvar default)
|
|
|
114 "Find a directory in the XEmacs hierarchy.
|
|
|
115 ROOTS must be a list of installation roots.
|
|
|
116 SUFFIX is the subdirectory from there.
|
|
|
117 BASE is the base to look for.
|
|
|
118 ENVVAR is the name of the environment variable that might also
|
|
|
119 specify the directory.
|
|
|
120 DEFAULT is a fall-back value."
|
|
|
121 (let ((envvar-value (and envvar (getenv envvar))))
|
|
|
122 (if (and envvar-value
|
|
|
123 (file-directory-p envvar-value))
|
|
|
124 (file-name-as-directory envvar-value)
|
|
|
125 (catch 'gotcha
|
|
|
126 (while roots
|
|
|
127 (let* ((root (car roots))
|
|
|
128 (path (paths-construct-emacs-directory root suffix base)))
|
|
|
129 ;; installed
|
|
|
130 (if (file-directory-p path)
|
|
|
131 (throw 'gotcha path)
|
|
|
132 (let ((path (paths-construct-emacs-directory root "" base)))
|
|
|
133 ;; in-place
|
|
|
134 (if (file-directory-p path)
|
|
|
135 (throw 'gotcha path)))))
|
|
|
136 (setq roots (cdr roots)))
|
|
|
137 (if (and default
|
|
|
138 (file-directory-p default))
|
|
|
139 (file-name-as-directory default)
|
|
|
140 nil)))))
|
|
|
141
|
|
|
142 (defun paths-find-site-directory (roots base &optional envvar default)
|
|
|
143 "Find a site-specific directory in the XEmacs hierarchy."
|
|
|
144 (paths-find-emacs-directory roots "lib/xemacs/" base envvar default))
|
|
|
145
|
|
|
146 (defun paths-find-version-directory (roots base &optional envvar default)
|
|
|
147 "Find a version-specific directory in the XEmacs hierarchy."
|
|
|
148 (paths-find-emacs-directory roots
|
|
|
149 (concat "lib/xemacs-" (construct-emacs-version) "/")
|
|
|
150 base
|
|
|
151 envvar default))
|
|
|
152
|
|
|
153 (defun paths-find-architecture-directory (roots base &optional envvar default)
|
|
|
154 "Find an architecture-specific directory in the XEmacs hierarchy."
|
|
|
155 (or
|
|
|
156 ;; from more to less specific
|
|
|
157 (paths-find-version-directory roots
|
|
|
158 (concat base system-configuration)
|
|
|
159 envvar default)
|
|
|
160 (paths-find-version-directory roots
|
|
|
161 system-configuration
|
|
|
162 envvar default)
|
|
|
163 (paths-find-version-directory roots
|
|
|
164 base
|
|
|
165 envvar default)))
|
|
|
166
|
|
|
167 (defvar paths-path-emacs-version nil
|
|
|
168 "Emacs version as it appears in paths.")
|
|
|
169
|
|
|
170 (defun construct-emacs-version ()
|
|
|
171 "Construct the raw version number of XEmacs in the form XX.XX."
|
|
|
172 ;; emacs-version isn't available early, but we really don't care then
|
|
|
173 (if (null (boundp 'emacs-version))
|
|
|
174 ""
|
|
|
175 (or paths-path-emacs-version ; cache
|
|
|
176 (progn
|
|
|
177 (string-match "\\`[^0-9]*\\([0-9]+\\.[0-9]+\\)" emacs-version)
|
|
|
178 (let ((version (substring emacs-version
|
|
|
179 (match-beginning 1) (match-end 1))))
|
|
|
180 (if (string-match "(beta *\\([0-9]+\\))" emacs-version)
|
|
|
181 (setq version (concat version
|
|
|
182 "-b"
|
|
|
183 (substring emacs-version
|
|
|
184 (match-beginning 1) (match-end 1)))))
|
|
|
185 (setq paths-path-emacs-version version)
|
|
|
186 version)))))
|
|
|
187
|
|
|
188 (defun paths-find-emacs-path (roots suffix base &optional envvar default)
|
|
|
189 "Find a path in the XEmacs hierarchy.
|
|
|
190 ROOTS must be a list of installation roots.
|
|
|
191 SUFFIX is the subdirectory from there.
|
|
|
192 BASE is the base to look for.
|
|
|
193 ENVVAR is the name of the environment variable that might also
|
|
|
194 specify the path.
|
|
|
195 DEFAULT is a fall-back value."
|
|
|
196 (let ((envvar-value (and envvar (getenv envvar))))
|
|
|
197 (if (and (fboundp 'parse-colon-path) envvar-value)
|
|
|
198 (parse-colon-path envvar-value)
|
|
|
199 (let ((directory (paths-find-emacs-directory roots base suffix)))
|
|
|
200 (if (and directory (file-directory-p directory))
|
|
|
201 (list directory)
|
|
|
202 (paths-directories-which-exist default))))))
|
|
|
203
|
|
|
204 (defun paths-directories-which-exist (directories)
|
|
|
205 "Return the directories among DIRECTORIES."
|
|
|
206 (let ((reverse-directories '()))
|
|
|
207 (while directories
|
|
|
208 (if (file-directory-p (car directories))
|
|
|
209 (setq reverse-directories
|
|
|
210 (cons (car directories)
|
|
|
211 reverse-directories)))
|
|
|
212 (setq directories (cdr directories)))
|
|
|
213 (reverse reverse-directories)))
|
|
|
214
|
|
|
215 (defun paths-find-site-path (roots base &optional envvar default)
|
|
|
216 "Find a path underneath the site hierarchy."
|
|
|
217 (paths-find-emacs-path roots "lib/xemacs/" base envvar default))
|
|
|
218
|
|
|
219 (defun paths-find-version-path (roots base &optional envvar default)
|
|
|
220 "Find a path underneath the site hierarchy."
|
|
|
221 (paths-find-emacs-path roots
|
|
|
222 (concat "lib/xemacs-" (construct-emacs-version) "/")
|
|
|
223 base
|
|
|
224 envvar default))
|
|
|
225
|
|
|
226 ; Packages are special ...
|
|
|
227
|
|
|
228 (defun paths-find-package-path (roots)
|
|
|
229 "Construct the package path underneath installation roots ROOTS."
|
|
|
230 (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
|
|
|
231 (if (and (fboundp 'parse-colon-path) envvar-value)
|
|
|
232 (parse-colon-path envvar-value)
|
|
|
233 (let ((base-directory (paths-find-site-directory roots "packages")))
|
|
|
234 (if base-directory
|
|
|
235 (let ((mule-directory (and (featurep 'mule)
|
|
|
236 (paths-find-site-directory roots
|
|
|
237 "mule-packages"))))
|
|
|
238 (append '("~/.xemacs/")
|
|
|
239 '(nil)
|
|
|
240 (and mule-directory
|
|
|
241 (list mule-directory))
|
|
|
242 (list base-directory)))
|
|
|
243 configure-package-path)))))
|
|
|
244
|
|
|
245 (defvar paths-package-special-bases '("etc" "info" "lisp" "lib-src" "bin")
|
|
|
246 "Special subdirectories of packages.")
|
|
|
247
|
|
|
248 (defun paths-find-packages-in-directories (directories)
|
|
|
249 "Find all packages underneath directories in DIRECTORIES."
|
|
|
250 (paths-find-recursive-path directories
|
|
|
251 (append paths-version-control-bases
|
|
|
252 paths-package-special-bases)))
|
|
|
253
|
|
|
254 (defun paths-split-path (path)
|
|
|
255 "Split PATH at NIL, return pair with two components.
|
|
|
256 The second component is shared with PATH."
|
|
|
257 (let ((reverse-early '()))
|
|
|
258 (while (and path (null (null (car path))))
|
|
|
259 (setq reverse-early (cons (car path) reverse-early))
|
|
|
260 (setq path (cdr path)))
|
|
|
261 (if (null path)
|
|
|
262 (cons nil path)
|
|
|
263 (cons (reverse reverse-early) (cdr path)))))
|
|
|
264
|
|
|
265 (defun paths-find-packages (package-path)
|
|
|
266 "Search for all packages in PACKAGE-PATH.
|
|
|
267 PACKAGE-PATH may distinguish (by NIL-separation) between early
|
|
|
268 and late packages.
|
|
|
269 This returns (CONS EARLY-PACKAGES LATE-PACKAGES)."
|
|
|
270 (let* ((stuff (paths-split-path package-path))
|
|
|
271 (early (car stuff))
|
|
|
272 (late (cdr stuff)))
|
|
|
273 (cons (paths-find-packages-in-directories early)
|
|
|
274 (paths-find-packages-in-directories late))))
|
|
|
275
|
|
|
276 (defun paths-find-package-library-path (packages suffixes)
|
|
|
277 "Construct a path into a component of the packages hierarchy.
|
|
|
278 PACKAGES is a list of package directories.
|
|
|
279 SUFFIXES is a list of names of package subdirectories to look for."
|
|
|
280 (let ((directories
|
|
|
281 (apply
|
|
|
282 #'append
|
|
|
283 (mapcar #'(lambda (package)
|
|
|
284 (mapcar #'(lambda (suffix)
|
|
|
285 (concat package suffix))
|
|
|
286 suffixes))
|
|
|
287 packages))))
|
|
|
288 (paths-directories-which-exist directories)))
|
|
|
289
|
|
|
290 (defun paths-find-package-load-path (packages)
|
|
|
291 "Construct the load-path component for packages.
|
|
|
292 PACKAGES is a list of package directories."
|
|
|
293 (paths-find-recursive-load-path
|
|
|
294 (paths-find-package-library-path packages '("lisp/"))))
|
|
|
295
|
|
|
296 (defun paths-find-package-exec-path (packages)
|
|
|
297 (paths-find-package-library-path packages
|
|
|
298 (list (concat "bin/" system-configuration "/")
|
|
|
299 "lib-src/")))
|
|
|
300
|
|
|
301 (defun paths-find-package-info-path (packages)
|
|
|
302 (paths-find-package-library-path packages '("info/")))
|
|
|
303
|
|
|
304 (defun paths-find-package-data-path (packages)
|
|
|
305 (paths-find-package-library-path packages '("etc/")))
|
|
|
306
|
|
|
307 (defun paths-find-emacs-roots (invocation-directory
|
|
|
308 invocation-name)
|
|
|
309 "Find all plausible installation roots for XEmacs."
|
|
|
310 (let ((invocation-root
|
|
|
311 (paths-find-emacs-root invocation-directory invocation-name))
|
|
|
312 (installation-root
|
|
|
313 (if (and configure-prefix-directory
|
|
|
314 (file-directory-p configure-prefix-directory))
|
|
|
315 configure-prefix-directory)))
|
|
|
316 (append (and invocation-root
|
|
|
317 (list invocation-root))
|
|
|
318 (and installation-root
|
|
|
319 (list installation-root)))))
|
|
|
320
|
|
|
321 (defun paths-find-load-path (roots early-package-load-path late-package-load-path)
|
|
|
322 "Construct the load path."
|
|
|
323 (let ((envvar-value (getenv "EMACSLOADPATH")))
|
|
|
324 (if (and (fboundp 'parse-colon-path) envvar-value)
|
|
|
325 (parse-colon-path envvar-value)
|
|
|
326 (let* ((site-lisp-directory
|
|
|
327 (and allow-site-lisp
|
|
|
328 (paths-find-site-directory roots "site-lisp"
|
|
|
329 nil
|
|
|
330 configure-site-directory)))
|
|
|
331 (site-lisp-load-path
|
|
|
332 (and site-lisp-directory
|
|
|
333 (paths-find-recursive-load-path (list site-lisp-directory))))
|
|
|
334 (lisp-directory
|
|
|
335 (paths-find-version-directory roots "lisp"
|
|
|
336 nil
|
|
|
337 configure-lisp-directory))
|
|
|
338 (lisp-load-path
|
|
|
339 (paths-find-recursive-load-path (list lisp-directory))))
|
|
|
340 (nconc early-package-load-path
|
|
|
341 site-lisp-load-path
|
|
|
342 late-package-load-path
|
|
|
343 lisp-load-path)))))
|
|
|
344
|
|
|
345 (defun paths-find-info-path (roots early-packages late-packages)
|
|
|
346 "Construct the info path."
|
|
|
347 (append
|
|
|
348 (paths-find-package-info-path early-packages)
|
|
|
349 (paths-find-package-info-path late-packages)
|
|
|
350 (let ((info-directory
|
|
|
351 (paths-find-version-directory roots "info"
|
|
|
352 nil
|
|
|
353 (append
|
|
|
354 (and configure-info-directory
|
|
|
355 (list configure-info-directory))
|
|
|
356 configure-info-path))))
|
|
|
357 (and info-directory
|
|
|
358 (list info-directory)))
|
|
|
359 (let ((info-path-envval (getenv "INFOPATH")))
|
|
|
360 (if (and (fboundp 'parse-colon-path) info-path-envval)
|
|
|
361 (parse-colon-path info-path-envval)))))
|
|
|
362
|
|
|
363 (defun paths-find-doc-directory (roots)
|
|
|
364 "Find the documentation directory."
|
|
|
365 (paths-find-architecture-directory roots "lib-src"))
|
|
|
366
|
|
|
367 (defun paths-find-lock-directory (roots)
|
|
|
368 "Find the lock directory."
|
|
|
369 (paths-find-site-path roots "lock" "EMACSLOCKDIR" configure-lock-directory))
|
|
|
370
|
|
|
371 (defun paths-find-superlock-file (lock-directory)
|
|
|
372 "Find the superlock file."
|
|
|
373 (cond
|
|
|
374 ((null lock-directory)
|
|
|
375 nil)
|
|
|
376 ((and configure-superlock-file
|
|
|
377 (file-directory-p (file-name-directory configure-superlock-file)))
|
|
|
378 configure-superlock-file)
|
|
|
379 (t
|
|
|
380 (expand-file-name "!!!SuperLock!!!" lock-directory))))
|
|
|
381
|
|
|
382 (defun paths-find-exec-directory (roots)
|
|
|
383 "Find the binary directory."
|
|
|
384 (paths-find-architecture-directory roots "lib-src"))
|
|
|
385
|
|
|
386 (defun paths-find-exec-path (roots exec-directory early-packages late-packages)
|
|
|
387 "Find the binary path."
|
|
|
388 (append
|
|
|
389 (let ((path-envval (getenv "PATH")))
|
|
|
390 (and (fboundp 'parse-colon-path) path-envval
|
|
|
391 (parse-colon-path path-envval)))
|
|
|
392 (paths-find-package-exec-path early-packages)
|
|
|
393 (paths-find-package-exec-path late-packages)
|
|
|
394 (let ((emacspath-envval (getenv "EMACSPATH")))
|
|
|
395 (if (and (fboundp 'parse-colon-path) emacspath-envval)
|
|
|
396 (parse-colon-path path-envval)
|
|
|
397 (paths-directories-which-exist configure-exec-path)))
|
|
|
398 (and exec-directory
|
|
|
399 (list exec-directory))))
|
|
|
400
|
|
|
401 (defun paths-find-data-directory (roots)
|
|
|
402 "Find the data directory."
|
|
|
403 (paths-find-version-directory roots "etc" "EMACSDATA" configure-data-directory))
|
|
|
404
|
|
|
405 (defun paths-find-data-directory-list (data-directory early-packages late-packages)
|
|
|
406 "Find the data path."
|
|
|
407 (append
|
|
|
408 (paths-find-package-data-path early-packages)
|
|
|
409 (paths-find-package-data-path late-packages)
|
|
|
410 (list data-directory)))
|
|
|
411
|
|
|
412 (defun paths-setup-paths ()
|
|
|
413 "Setup all the various paths.
|
|
|
414 Call this as often as you like!"
|
|
|
415 ;; XEmacs -- Steven Baur says invocation directory is nil if you
|
|
|
416 ;; try to use XEmacs as a login shell.
|
|
|
417 (or invocation-directory (setq invocation-directory default-directory))
|
|
|
418 (if (fboundp 'abbreviate-file-name)
|
|
|
419 ;; No abbreviate-file-name in temacs
|
|
|
420 (setq invocation-directory
|
|
|
421 ;; don't let /tmp_mnt/... get into the load-path or exec-path.
|
|
|
422 (abbreviate-file-name invocation-directory)))
|
|
|
423
|
|
|
424 (let ((roots (paths-find-emacs-roots invocation-directory invocation-name)))
|
|
|
425
|
|
|
426 (setq package-path (paths-find-package-path roots))
|
|
|
427
|
|
|
428 (let ((stuff (paths-find-packages package-path)))
|
|
|
429 (setq early-packages (car stuff))
|
|
|
430 (setq late-packages (cdr stuff)))
|
|
|
431
|
|
|
432 (setq early-package-load-path (paths-find-package-load-path early-packages))
|
|
|
433 (setq late-package-load-path (paths-find-package-load-path late-packages))
|
|
|
434
|
|
|
435 (setq load-path (paths-find-load-path roots
|
|
|
436 early-package-load-path
|
|
|
437 late-package-load-path))
|
|
|
438
|
|
|
439 (setq info-path (paths-find-info-path roots early-packages late-packages))
|
|
|
440
|
|
|
441 (if (boundp 'lock-directory)
|
|
|
442 (progn
|
|
|
443 (setq lock-directory (paths-find-lock-directory roots))
|
|
|
444 (setq superlock-file (paths-find-superlock-file lock-directory))))
|
|
|
445
|
|
|
446 (setq exec-directory (paths-find-exec-directory roots))
|
|
|
447
|
|
|
448 (setq exec-path (paths-find-exec-path roots exec-directory
|
|
|
449 early-packages late-packages))
|
|
|
450
|
|
|
451 (setq doc-directory (paths-find-doc-directory roots))
|
|
|
452
|
|
|
453 (setq data-directory (paths-find-data-directory roots))
|
|
|
454
|
|
|
455 (setq data-directory-list (paths-find-data-directory-list data-directory
|
|
|
456 early-packages
|
|
|
457 late-packages))))
|
|
|
458
|
|
|
459 (defun paths-setup-paths-warning ()
|
|
|
460 (let ((lock (if (boundp 'lock-directory) lock-directory 't))
|
|
|
461 warnings message guess)
|
|
|
462 (if (and (stringp lock) (null (file-directory-p lock)))
|
|
|
463 (setq lock nil))
|
|
|
464 (cond
|
|
|
465 ((null (and exec-directory data-directory doc-directory load-path lock))
|
|
|
466 (save-excursion
|
|
|
467 (set-buffer (get-buffer-create " *warning-tmp*"))
|
|
|
468 (erase-buffer)
|
|
|
469 (buffer-disable-undo (current-buffer))
|
|
|
470 (if (null lock) (push "lock-directory" warnings))
|
|
|
471 (if (null exec-directory) (push "exec-directory" warnings))
|
|
|
472 (if (null data-directory) (push "data-directory" warnings))
|
|
|
473 (if (null doc-directory) (push "doc-directory" warnings))
|
|
|
474 (if (null load-path) (push "load-path" warnings))
|
|
|
475 (cond ((cdr (cdr warnings))
|
|
|
476 (setq message (apply 'format "%s, %s, and %s" warnings)))
|
|
|
477 ((cdr warnings)
|
|
|
478 (setq message (apply 'format "%s and %s" warnings)))
|
|
|
479 (t (setq message (format "variable %s" (car warnings)))))
|
|
|
480 (insert "couldn't find an obvious default for " message
|
|
|
481 ", and there were no defaults specified in paths.h when "
|
|
|
482 "XEmacs was built. Perhaps some directories don't exist, "
|
|
|
483 "or the XEmacs executable, " (concat invocation-directory
|
|
|
484 invocation-name)
|
|
|
485 " is in a strange place?")
|
|
|
486
|
|
|
487 (if (fboundp 'fill-region)
|
|
|
488 ;; Might not be bound in the cold load environment...
|
|
|
489 (let ((fill-column 76))
|
|
|
490 (fill-region (point-min) (point-max))))
|
|
|
491 (goto-char (point-min))
|
|
|
492 (princ "\nWARNING:\n" 'external-debugging-output)
|
|
|
493 (princ (buffer-string) 'external-debugging-output)
|
|
|
494 (erase-buffer)
|
|
|
495 t)))))
|
|
|
496
|
|
|
497 (defun paths-load-package-lisps (package-load-path base)
|
|
|
498 "Load all Lisp files of a certain name along a load path.
|
|
|
499 BASE is the base name of the files."
|
|
|
500 (mapc #'(lambda (dir)
|
|
|
501 (let ((file-name (expand-file-name base dir)))
|
|
|
502 (if (file-exists-p file-name)
|
|
|
503 (condition-case error
|
|
|
504 (load file-name)
|
|
|
505 (error
|
|
|
506 (warn (format "Autoload error in: %s:\n\t%s"
|
|
|
507 file-name
|
|
|
508 (with-output-to-string
|
|
|
509 (display-error error nil)))))))))
|
|
|
510 package-load-path))
|
|
|
511
|
|
|
512 (defun paths-load-package-auto-autoloads (package-load-path)
|
|
|
513 "Load auto-autoload files along a load path."
|
|
|
514 (paths-load-package-lisps package-load-path
|
|
|
515 (file-name-sans-extension autoload-file-name)))
|
|
|
516
|
|
|
517 (defun paths-load-package-dumped-lisps (package-load-path)
|
|
|
518 "Load dumped-lisp.el files along a load path."
|
|
|
519 (mapc #'(lambda (dir)
|
|
|
520 (let ((file-name (expand-file-name "dumped-lisp.el" dir)))
|
|
|
521 (if (file-exists-p file-name)
|
|
|
522 (let (package-lisp
|
|
|
523 ;; 20.4 packages could set this
|
|
|
524 preloaded-file-list)
|
|
|
525 (load file-name)
|
|
|
526 ;; dumped-lisp.el could have set this ...
|
|
|
527 (if package-lisp
|
|
|
528 (mapc #'(lambda (base)
|
|
|
529 (load (expand-file-name base dir)))
|
|
|
530 package-lisp))))))
|
|
|
531 package-load-path))
|
|
|
532
|
|
|
533 ;;; setup-paths.el ends here
|
