Mercurial > hg > xemacs-beta

comparison lisp/find-paths.el @ 2456:f4e405a9d18d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-12-27 12:25:14 by michaels] 2004-12-18 Mike Sperber <mike@xemacs.org> * package-admin.el: * startup.el: Reflect the changes made in packages.el. * packages.el: * loadup.el: * make-docfile.el: * package-admin.el: * startup.el: * update-elc.el (early-package-hierarchies) (late-package-hierarchies) (last-package-hierarchies): Renamed these from `early-packages', `late-packages' and `last-packages'. * packages.el: Rewrote package-finding logic to separate the concepts of "package directories" and "package hierarchies". Added explanation of these concepts. * setup-paths.el: * find-paths.el: Added parameter descriptions to some of the docstrings. * packages.el, setup-paths.el: Make terminology more explicit about "package hierarchies" * startup.el (emacs-roots, emacs-data-roots) (user-init-directory-base, user-init-directory) (user-init-file-base, user-init-file-base-list) (user-home-init-file-base-list) (load-home-init-file, load-user-init-file-p) (startup-find-load-path, startup-setup-paths) (startup-find-load-path-for-packages): Moved these back from setup-paths.el where they belong---setup-paths.el now again, as documented, contains no code that sets global variables. (They were moved from startup.el to setup-paths.el on 2003-02-28.) Clarify that in the comment at the top. * setup-paths.el (paths-find-emacs-roots): Restored `invocation-directory' 'invocation-name' parameters removed on 2003-02-28; they're useful for debugging.
author michaels
date Mon, 27 Dec 2004 12:27:05 +0000
parents 13a418960a88
children 505a24c07ba9
comparison
equal deleted inserted replaced
2455:3e06061baa0e 2456:f4e405a9d18d
3 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc.
4 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc. 4 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc.
5 ;; Copyright (C) 1995 Board of Trustees, University of Illinois 5 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
6 ;; Copyright (C) 2003 Ben Wing. 6 ;; Copyright (C) 2003 Ben Wing.
7 7
8 ;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de> 8 ;; Author: Mike Sperber <mike@xemacs.org>
9 ;; Maintainer: XEmacs Development Team 9 ;; Maintainer: XEmacs Development Team
10 ;; Keywords: internal, dumped 10 ;; Keywords: internal, dumped
11 11
12 ;; This file is part of XEmacs. 12 ;; This file is part of XEmacs.
13 13
123 (if expand-directory 123 (if expand-directory
124 (expand-file-name path expand-directory) 124 (expand-file-name path expand-directory)
125 path))) 125 path)))
126 126
127 (defun paths-construct-emacs-directory (root suffix base) 127 (defun paths-construct-emacs-directory (root suffix base)
128 "Construct a directory name within the XEmacs hierarchy." 128 "Construct a directory name within the XEmacs hierarchy.
129 ROOT must be a an installation root.
130 SUFFIX is the subdirectory from there.
131 BASE is the base to look for."
129 (file-name-as-directory 132 (file-name-as-directory
130 (expand-file-name 133 (expand-file-name
131 (concat 134 (concat
132 (file-name-as-directory root) 135 (file-name-as-directory root)
133 suffix 136 suffix
163 (throw 'gotcha path)))))) 166 (throw 'gotcha path))))))
164 (setq roots (cdr roots))) 167 (setq roots (cdr roots)))
165 nil)))) 168 nil))))
166 169
167 (defun paths-find-site-directory (roots base &optional envvar default) 170 (defun paths-find-site-directory (roots base &optional envvar default)
168 "Find a site-specific directory in the XEmacs hierarchy." 171 "Find a site-specific directory in the XEmacs hierarchy.
172 ROOT must be a an installation root.
173 BASE is the base to look for.
174 ENVVAR is the name of the environment variable that might also
175 specify the directory.
176 DEFAULT is the preferred value."
169 (paths-find-emacs-directory roots 177 (paths-find-emacs-directory roots
170 (file-name-as-directory 178 (file-name-as-directory
171 (paths-construct-path (list 179 (paths-construct-path (list
172 "lib" 180 "lib"
173 emacs-program-name))) 181 emacs-program-name)))
175 envvar default)) 183 envvar default))
176 184
177 (defun paths-find-version-directory (roots base 185 (defun paths-find-version-directory (roots base
178 &optional envvar default enforce-version) 186 &optional envvar default enforce-version)
179 "Find a version-specific directory in the XEmacs hierarchy. 187 "Find a version-specific directory in the XEmacs hierarchy.
188
189 ROOT must be a an installation root.
190 BASE is the base to look for.
191 ENVVAR is the name of the environment variable that might also
192 specify the directory.
193 DEFAULT is the preferred value.
180 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." 194 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
181 (paths-find-emacs-directory roots 195 (paths-find-emacs-directory roots
182 (file-name-as-directory 196 (file-name-as-directory
183 (paths-construct-path 197 (paths-construct-path
184 (list "lib" 198 (list "lib"
186 base 200 base
187 envvar default 201 envvar default
188 enforce-version)) 202 enforce-version))
189 203
190 (defun paths-find-architecture-directory (roots base &optional envvar default) 204 (defun paths-find-architecture-directory (roots base &optional envvar default)
191 "Find an architecture-specific directory in the XEmacs hierarchy." 205 "Find an architecture-specific directory in the XEmacs hierarchy.
206 ROOT must be a an installation root.
207 BASE is the base to look for.
208 ENVVAR is the name of the environment variable that might also
209 specify the directory.
210 DEFAULT is the preferred value."
192 (or 211 (or
193 ;; from more to less specific 212 ;; from more to less specific
194 (paths-find-version-directory roots 213 (paths-find-version-directory roots
195 (paths-construct-path 214 (paths-construct-path
196 (list system-configuration base)) 215 (list system-configuration base))
201 (paths-find-version-directory roots 220 (paths-find-version-directory roots
202 system-configuration 221 system-configuration
203 envvar))) 222 envvar)))
204 223
205 (defun construct-emacs-version-name () 224 (defun construct-emacs-version-name ()
206 "Construct the raw XEmacs version number." 225 "Construct a string from the raw XEmacs version number."
207 (concat emacs-program-name "-" emacs-program-version)) 226 (concat emacs-program-name "-" emacs-program-version))
208 227
209 (defun paths-directories-which-exist (directories) 228 (defun paths-directories-which-exist (directories)
210 "Return the directories among DIRECTORIES." 229 "Return the directories among DIRECTORIES.
230 DIRECTORIES is a list of strings."
211 (let ((reverse-directories '())) 231 (let ((reverse-directories '()))
212 (while directories 232 (while directories
213 (if (paths-file-readable-directory-p (car directories)) 233 (if (paths-file-readable-directory-p (car directories))
214 (setq reverse-directories 234 (setq reverse-directories
215 (cons (car directories) 235 (cons (car directories)
216 reverse-directories))) 236 reverse-directories)))
217 (setq directories (cdr directories))) 237 (setq directories (cdr directories)))
218 (reverse reverse-directories))) 238 (reverse reverse-directories)))
219 239
220 (defun paths-uniq-append (list-1 list-2) 240 (defun paths-uniq-append (list-1 list-2)
221 "Append LIST-1 and LIST-2, omitting duplicates." 241 "Append LIST-1 and LIST-2, omitting EQUAL duplicates."
222 (let ((reverse-survivors '())) 242 (let ((reverse-survivors '()))
223 (while list-2 243 (while list-2
224 (if (null (member (car list-2) list-1)) 244 (if (null (member (car list-2) list-1))
225 (setq reverse-survivors (cons (car list-2) reverse-survivors))) 245 (setq reverse-survivors (cons (car list-2) reverse-survivors)))
226 (setq list-2 (cdr list-2))) 246 (setq list-2 (cdr list-2)))