Mercurial > hg > xemacs-beta

comparison lisp/setup-paths.el @ 4919:9c6ea1581159

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove a couple of XEmacs-specific duplicate functions, find-paths.el 2010-02-03 Aidan Kehoe <kehoea@parhasard.net> Delete a couple of XEmacs-specific functions that duplicate CL functions. * find-paths.el (paths-filter, paths-uniq-append): Remove #'paths-filter, a reimplementation of #'remove-if-not, and #'paths-uniq-append, a reimplementation of #'union with test #'equal. (paths-decode-directory-path): Don't use #'path-filter here. * packages.el (packages-package-hierarchy-directory-names): Don't use #'path-filter here. (packages-find-installation-package-directories): Use #'union, not #'paths-uniq-append here. * setup-paths.el (paths-find-invocation-roots) (paths-find-emacs-roots, paths-construct-info-path) (paths-construct-info-path): Replace #'paths-filter with #'remove-if-not, #'paths-uniq-append with #'union.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 03 Feb 2010 09:04:35 +0000
parents 09c3d30b5d4e
children 6b6b0f8ab749
comparison
equal deleted inserted replaced
4915:bedf3747a6d7 4919:9c6ea1581159
125 (maybe-root-1 (file-name-as-directory 125 (maybe-root-1 (file-name-as-directory
126 (paths-construct-path '("..") executable-directory))) 126 (paths-construct-path '("..") executable-directory)))
127 (maybe-root-2 (file-name-as-directory 127 (maybe-root-2 (file-name-as-directory
128 (paths-construct-path '(".." "..") executable-directory)))) 128 (paths-construct-path '(".." "..") executable-directory))))
129 129
130 (paths-filter root-p 130 (delete-if-not root-p (list maybe-root-1 maybe-root-2))))
131 (list maybe-root-1 maybe-root-2))))
132 131
133 (defun paths-find-emacs-roots (invocation-directory 132 (defun paths-find-emacs-roots (invocation-directory
134 invocation-name 133 invocation-name
135 root-p) 134 root-p)
136 "Find all plausible installation roots for XEmacs. 135 "Find all plausible installation roots for XEmacs.
141 (let* ((invocation-roots 140 (let* ((invocation-roots
142 (paths-find-invocation-roots invocation-directory 141 (paths-find-invocation-roots invocation-directory
143 invocation-name 142 invocation-name
144 root-p)) 143 root-p))
145 (potential-installation-roots 144 (potential-installation-roots
146 (paths-uniq-append 145 (union
147 (and configure-exec-prefix-directory 146 (and configure-exec-prefix-directory
148 (list (file-name-as-directory 147 (list (file-name-as-directory
149 configure-exec-prefix-directory))) 148 configure-exec-prefix-directory)))
150 (and configure-prefix-directory 149 (and configure-prefix-directory
151 (list (file-name-as-directory 150 (list (file-name-as-directory
152 configure-prefix-directory))))) 151 configure-prefix-directory)))
152 :test #'equal))
153 (installation-roots 153 (installation-roots
154 (paths-filter root-p potential-installation-roots))) 154 (remove-if-not root-p potential-installation-roots)))
155 (paths-uniq-append invocation-roots 155 (union invocation-roots installation-roots :test #'equal)))
156 installation-roots)))
157 156
158 (defun paths-find-site-lisp-directory (roots) 157 (defun paths-find-site-lisp-directory (roots)
159 "Find the site Lisp directory of the XEmacs hierarchy. 158 "Find the site Lisp directory of the XEmacs hierarchy.
160 ROOTS is a list of installation roots." 159 ROOTS is a list of installation roots."
161 (paths-find-site-directory roots (list "site-lisp") 160 (paths-find-site-directory roots (list "site-lisp")
259 ROOTS is the list of installation roots. 258 ROOTS is the list of installation roots.
260 EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and 259 EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and
261 LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots, 260 LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots,
262 respectively." 261 respectively."
263 (let ((info-path-envval (getenv "INFOPATH"))) 262 (let ((info-path-envval (getenv "INFOPATH")))
264 (paths-uniq-append 263 (union
265 (append 264 (append
266 (let ((info-directory 265 (let ((info-directory
267 (paths-find-version-directory roots (list "info") 266 (paths-find-version-directory roots (list "info")
268 nil nil 267 nil nil
269 configure-info-directory))) 268 configure-info-directory)))
273 (packages-find-package-info-path late-package-hierarchies) 272 (packages-find-package-info-path late-package-hierarchies)
274 (packages-find-package-info-path last-package-hierarchies) 273 (packages-find-package-info-path last-package-hierarchies)
275 (and info-path-envval 274 (and info-path-envval
276 (paths-decode-directory-path info-path-envval 'drop-empties))) 275 (paths-decode-directory-path info-path-envval 'drop-empties)))
277 (and (null info-path-envval) 276 (and (null info-path-envval)
278 (paths-uniq-append 277 (union
279 (paths-directories-which-exist configure-info-path) 278 (paths-directories-which-exist configure-info-path)
280 (paths-directories-which-exist paths-default-info-directories)))))) 279 (paths-directories-which-exist paths-default-info-directories)
280 :test #'equal))
281 :test #'equal)))
281 282
282 (defun paths-find-doc-directory (roots) 283 (defun paths-find-doc-directory (roots)
283 "Find the documentation directory. 284 "Find the documentation directory.
284 ROOTS is the list of installation roots." 285 ROOTS is the list of installation roots."
285 (paths-find-architecture-directory roots (list "lib-src") nil configure-doc-directory)) 286 (paths-find-architecture-directory roots (list "lib-src") nil configure-doc-directory))