Mercurial > hg > xemacs-beta
annotate lisp/setup-paths.el @ 4919:9c6ea1581159
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 |
| rev | line source |
|---|---|
| 428 | 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 | |
| 1330 | 6 ;; Copyright (C) 2003 Ben Wing. |
| 428 | 7 |
| 2456 | 8 ;; Author: Mike Sperber <mike@xemacs.orgx> |
| 428 | 9 ;; Maintainer: XEmacs Development Team |
| 10 ;; Keywords: internal, dumped | |
| 11 | |
| 12 ;; This file is part of XEmacs. | |
| 13 | |
| 14 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 15 ;; under the terms of the GNU General Public License as published by | |
| 16 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 17 ;; any later version. | |
| 18 | |
| 19 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 22 ;; General Public License for more details. | |
| 23 | |
| 24 ;; You should have received a copy of the GNU General Public License | |
| 25 ;; along with XEmacs; see the file COPYING. If not, write to the | |
| 26 ;; Free Software Foundation, 59 Temple Place - Suite 330, | |
| 27 ;; Boston, MA 02111-1307, USA. | |
| 28 | |
| 29 ;;; Synched up with: Not in FSF. | |
| 30 | |
| 31 ;;; Commentary: | |
| 32 | |
| 33 ;; This file is dumped with XEmacs. | |
| 34 | |
| 776 | 35 ;; This file contains functions and variables that describe and construct |
| 36 ;; the various paths into the XEmacs hierarchy from a global viewpoint. | |
| 2456 | 37 |
| 38 ;; This file doesn't actually set any global variable, and doesn't | |
| 39 ;; contain any state---it just contains the functionality for | |
| 40 ;; searching directories and constructing paths. | |
| 428 | 41 |
| 42 ;; It requires find-paths.el and packages.el. | |
| 1330 | 43 |
| 44 ;;; Code: | |
| 45 | |
| 46 ;(setq debug-paths t) | |
| 47 | |
| 428 | 48 |
| 460 | 49 (defvar paths-core-load-path-depth 0 |
| 428 | 50 "Depth of load-path searches in core Lisp paths.") |
| 51 | |
| 452 | 52 (defvar paths-site-load-path-depth 1 |
| 53 "Depth of load-path searches in site Lisp paths.") | |
| 54 | |
| 460 | 55 (defvar paths-mule-load-path-depth 0 |
| 56 "Depth of load-path searches in Mule Lisp paths.") | |
| 57 | |
| 3813 | 58 (defvar paths-module-load-path-depth 1 |
| 59 "Depth of load-path searches in module paths.") | |
| 60 | |
| 428 | 61 (defvar paths-default-info-directories |
| 62 (mapcar (function | |
| 63 (lambda (dirlist) | |
| 64 (paths-construct-path | |
| 65 dirlist (char-to-string directory-sep-char)))) | |
| 66 '(("usr" "local" "info") | |
| 67 ("usr" "info") | |
| 68 ("usr" "local" "share" "info") | |
| 69 ("usr" "share" "info"))) | |
| 70 "Directories appended to the end of the info path by default.") | |
| 71 | |
| 1330 | 72 |
| 73 ;;; Basic utility functions. | |
| 74 | |
| 75 (defun paths-emacs-root-p (directory) | |
| 76 "Check if DIRECTORY is a plausible installation root." | |
| 77 (or | |
| 78 ;; installed | |
| 79 (paths-file-readable-directory-p (paths-construct-path (list directory | |
| 80 "lib" | |
| 81 (construct-emacs-version-name)))) | |
| 82 ;; in-place or windows-nt. windows-nt equivalent of --srcdir is | |
| 83 ;; BUILD_DIR in config.inc, and has no lisp/ or etc/ since symlinks | |
| 84 ;; don't exist. instead, xemacs.mak points configure-lisp-directory and | |
| 85 ;; configure-data-directory at the right places. | |
| 86 (and | |
| 1526 | 87 (or configure-exec-directory (paths-file-readable-directory-p (paths-construct-path (list directory "lib-src"))) (eq system-type 'windows-nt)) |
| 1330 | 88 (or configure-lisp-directory (paths-file-readable-directory-p (paths-construct-path (list directory "lisp")))) |
| 89 (or configure-data-directory (paths-file-readable-directory-p (paths-construct-path (list directory "etc"))))))) | |
| 90 | |
| 91 (defun paths-emacs-data-root-p (directory) | |
| 92 "Check if DIRECTORY is a plausible data installation root. | |
| 93 A data installation root is one containing data files that may be shared | |
| 2456 | 94 among multiple different versions of XEmacs, the packages in particular. |
| 95 This serves as an additional filter to narrow down the list of plausible | |
| 96 installation roots." | |
| 1330 | 97 (or |
| 98 ;; installed | |
| 99 (paths-file-readable-directory-p (paths-construct-path (list directory | |
| 4154 | 100 "share" |
| 1330 | 101 emacs-program-name))) |
| 102 (paths-file-readable-directory-p (paths-construct-path (list directory | |
| 4154 | 103 "share" |
| 1330 | 104 (construct-emacs-version-name)))) |
| 105 ;; in-place or windows-nt | |
| 106 (and | |
| 107 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp"))) | |
| 3281 | 108 (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))) |
| 1330 | 109 |
| 3281 | 110 ;; searching for a package directory |
| 111 (and | |
| 112 (string-match "win32" system-configuration) | |
| 113 (paths-file-readable-directory-p (paths-construct-path (list directory | |
| 114 "xemacs-packages")))))) | |
| 115 | |
| 116 (defun paths-find-invocation-roots (invocation-directory invocation-name root-p) | |
| 117 "Find the list of run-time roots of XEmacs. | |
| 2456 | 118 INVOCATION-DIRECTORY is a directory containing the XEmacs executable. |
| 3281 | 119 INVOCATION-NAME is the name of the executable itself |
| 120 ROOT-P is a function that tests whether a root is plausible." | |
| 1330 | 121 (let* ((executable-file-name (paths-chase-symlink |
| 122 (concat invocation-directory | |
| 123 invocation-name))) | |
| 124 (executable-directory (file-name-directory executable-file-name)) | |
| 125 (maybe-root-1 (file-name-as-directory | |
| 126 (paths-construct-path '("..") executable-directory))) | |
| 127 (maybe-root-2 (file-name-as-directory | |
| 128 (paths-construct-path '(".." "..") executable-directory)))) | |
| 3281 | 129 |
|
4919
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
130 (delete-if-not root-p (list maybe-root-1 maybe-root-2)))) |
| 1330 | 131 |
| 2456 | 132 (defun paths-find-emacs-roots (invocation-directory |
| 133 invocation-name | |
| 134 root-p) | |
| 1330 | 135 "Find all plausible installation roots for XEmacs. |
| 136 This is a list of plausible directories in which to search for the important | |
| 137 directories used by XEmacs at run-time, for example `exec-directory', | |
| 138 `data-directory' and `lisp-directory'. | |
| 139 ROOT-P is a function that tests whether a root is plausible." | |
| 3281 | 140 (let* ((invocation-roots |
| 141 (paths-find-invocation-roots invocation-directory | |
| 142 invocation-name | |
| 143 root-p)) | |
| 1330 | 144 (potential-installation-roots |
|
4919
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
145 (union |
| 1330 | 146 (and configure-exec-prefix-directory |
| 147 (list (file-name-as-directory | |
| 148 configure-exec-prefix-directory))) | |
| 149 (and configure-prefix-directory | |
| 150 (list (file-name-as-directory | |
|
4919
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
151 configure-prefix-directory))) |
|
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
152 :test #'equal)) |
| 1330 | 153 (installation-roots |
|
4919
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
154 (remove-if-not root-p potential-installation-roots))) |
|
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
155 (union invocation-roots installation-roots :test #'equal))) |
| 1330 | 156 |
| 428 | 157 (defun paths-find-site-lisp-directory (roots) |
| 2456 | 158 "Find the site Lisp directory of the XEmacs hierarchy. |
| 159 ROOTS is a list of installation roots." | |
| 4108 | 160 (paths-find-site-directory roots (list "site-lisp") |
| 4092 | 161 nil nil |
| 428 | 162 configure-site-directory)) |
| 163 | |
| 164 (defun paths-find-site-module-directory (roots) | |
| 2456 | 165 "Find the site modules directory of the XEmacs hierarchy. |
| 166 ROOTS is a list of installation roots." | |
| 4108 | 167 (paths-find-site-directory roots (list "site-modules") |
| 4092 | 168 t nil |
| 428 | 169 configure-site-module-directory)) |
| 170 | |
| 171 (defun paths-find-lisp-directory (roots) | |
| 2456 | 172 "Find the main Lisp directory of the XEmacs hierarchy. |
| 173 ROOTS is a list of installation roots." | |
| 4108 | 174 (paths-find-version-directory roots (list "lisp") |
| 4092 | 175 nil nil |
| 428 | 176 configure-lisp-directory)) |
| 177 | |
| 460 | 178 (defun paths-find-mule-lisp-directory (roots &optional lisp-directory) |
| 2456 | 179 "Find the Mule Lisp directory of the XEmacs hierarchy. |
| 180 ROOTS is a list of installation roots." | |
| 460 | 181 ;; #### kludge |
| 182 (if lisp-directory | |
| 183 (let ((guess | |
| 184 (file-name-as-directory | |
| 185 (paths-construct-path (list lisp-directory "mule"))))) | |
| 186 (if (paths-file-readable-directory-p guess) | |
| 187 guess | |
| 4108 | 188 (paths-find-version-directory roots (list "mule-lisp") |
| 4092 | 189 nil nil |
| 460 | 190 configure-mule-lisp-directory))))) |
| 191 | |
| 428 | 192 (defun paths-find-module-directory (roots) |
| 2456 | 193 "Find the main modules directory of the XEmacs hierarchy. |
| 194 ROOTS is a list of installation roots." | |
| 4108 | 195 (paths-find-architecture-directory roots (list "modules") |
| 428 | 196 nil configure-module-directory)) |
| 197 | |
| 198 (defun paths-construct-load-path | |
| 199 (roots early-package-load-path late-package-load-path last-package-load-path | |
| 200 lisp-directory | |
| 460 | 201 &optional site-lisp-directory mule-lisp-directory) |
| 2456 | 202 "Construct the complete load path. |
| 203 ROOTS is the list of installation roots. | |
| 204 EARLY-PACKAGE-LOAD-PATH, LATE-PACKAGE-LOAD-PATH, and LAST-PACKAGE-LOAD-PATH | |
| 205 are the load paths for the package hierarchies. | |
| 206 SITE-LISP-DIRECTORY and MULE-LISP-DIRECTORY are optional directories to be | |
| 207 included in the load path---SITE-LISP-DIRECTORY for the obsolete site-specific | |
| 208 Lisp files, and MULE-LISP-DIRECTORY for the Mule Lisp files, which exist | |
| 209 only in Mule installations." | |
| 428 | 210 (let* ((envvar-value (getenv "EMACSLOADPATH")) |
| 211 (env-load-path | |
| 212 (and envvar-value | |
| 213 (paths-decode-directory-path envvar-value 'drop-empties))) | |
| 214 (site-lisp-load-path | |
| 215 (and site-lisp-directory | |
| 216 (paths-find-recursive-load-path (list site-lisp-directory) | |
| 452 | 217 paths-site-load-path-depth))) |
| 460 | 218 (mule-lisp-load-path |
| 219 (and mule-lisp-directory | |
| 220 (paths-find-recursive-load-path (list mule-lisp-directory) | |
| 221 paths-mule-load-path-depth))) | |
| 428 | 222 (lisp-load-path |
| 223 (and lisp-directory | |
| 224 (paths-find-recursive-load-path (list lisp-directory) | |
| 452 | 225 paths-core-load-path-depth)))) |
| 428 | 226 (append env-load-path |
| 227 early-package-load-path | |
| 228 site-lisp-load-path | |
| 229 late-package-load-path | |
| 460 | 230 mule-lisp-load-path |
| 428 | 231 lisp-load-path |
| 232 last-package-load-path))) | |
| 233 | |
| 234 (defun paths-construct-module-load-path | |
| 235 (root module-directory &optional site-module-directory) | |
| 236 "Construct the modules load path." | |
| 237 (let* ((envvar-value (getenv "EMACSMODULEPATH")) | |
| 238 (env-module-path | |
| 239 (and envvar-value | |
| 240 (paths-decode-directory-path envvar-value 'drop-empties))) | |
| 241 (site-module-load-path | |
| 242 (and site-module-directory | |
| 243 (paths-find-recursive-load-path (list site-module-directory) | |
| 452 | 244 paths-site-load-path-depth))) |
| 428 | 245 (module-load-path |
| 246 (and module-directory | |
| 247 (paths-find-recursive-load-path (list module-directory) | |
| 3813 | 248 paths-module-load-path-depth)))) |
| 2456 | 249 (append env-module-path |
| 428 | 250 site-module-load-path |
| 251 module-load-path))) | |
| 252 | |
| 2456 | 253 (defun paths-construct-info-path (roots |
| 254 early-package-hierarchies | |
| 255 late-package-hierarchies | |
| 256 last-package-hierarchies) | |
| 257 "Construct the info path. | |
| 258 ROOTS is the list of installation roots. | |
| 259 EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and | |
| 260 LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots, | |
| 261 respectively." | |
| 428 | 262 (let ((info-path-envval (getenv "INFOPATH"))) |
|
4919
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
263 (union |
| 428 | 264 (append |
| 265 (let ((info-directory | |
| 4108 | 266 (paths-find-version-directory roots (list "info") |
| 4092 | 267 nil nil |
| 428 | 268 configure-info-directory))) |
| 269 (and info-directory | |
| 270 (list info-directory))) | |
| 2456 | 271 (packages-find-package-info-path early-package-hierarchies) |
| 272 (packages-find-package-info-path late-package-hierarchies) | |
| 273 (packages-find-package-info-path last-package-hierarchies) | |
| 428 | 274 (and info-path-envval |
| 275 (paths-decode-directory-path info-path-envval 'drop-empties))) | |
| 276 (and (null info-path-envval) | |
|
4919
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
277 (union |
| 428 | 278 (paths-directories-which-exist configure-info-path) |
|
4919
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
279 (paths-directories-which-exist paths-default-info-directories) |
|
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
280 :test #'equal)) |
|
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4154
diff
changeset
|
281 :test #'equal))) |
| 428 | 282 |
| 283 (defun paths-find-doc-directory (roots) | |
| 2456 | 284 "Find the documentation directory. |
| 285 ROOTS is the list of installation roots." | |
| 4108 | 286 (paths-find-architecture-directory roots (list "lib-src") nil configure-doc-directory)) |
| 428 | 287 |
| 288 (defun paths-find-exec-directory (roots) | |
| 2456 | 289 "Find the binary directory. |
| 290 ROOTS is the list of installation roots." | |
| 4108 | 291 (paths-find-architecture-directory roots (list "lib-src") |
| 428 | 292 nil configure-exec-directory)) |
| 293 | |
| 294 (defun paths-construct-exec-path (roots exec-directory | |
| 2456 | 295 early-package-hierarchies |
| 296 late-package-hierarchies | |
| 297 last-package-hierarchies) | |
| 298 "Find the binary path. | |
| 299 ROOTS is the list of installation roots. | |
| 300 EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and | |
| 301 LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots, | |
| 302 respectively. | |
| 303 EXEC-DIRECTORY is the directory of architecture-dependent files that | |
| 304 come with XEmacs. | |
| 305 EARLY-PACKAGES, LATE-PACKAGES, and LAST-PACKAGES are lists of | |
| 306 package hierarchy roots, respectively." | |
| 428 | 307 (append |
| 308 (let ((path-envval (getenv "PATH"))) | |
| 309 (if path-envval | |
| 310 (paths-decode-directory-path path-envval 'drop-empties))) | |
| 2456 | 311 (packages-find-package-exec-path early-package-hierarchies) |
| 312 (packages-find-package-exec-path late-package-hierarchies) | |
| 428 | 313 (let ((emacspath-envval (getenv "EMACSPATH"))) |
| 314 (and emacspath-envval | |
| 315 (split-path emacspath-envval))) | |
| 316 (and exec-directory | |
| 317 (list exec-directory)) | |
| 2456 | 318 (packages-find-package-exec-path last-package-hierarchies))) |
| 428 | 319 |
| 320 (defun paths-find-data-directory (roots) | |
| 2456 | 321 "Find the data directory. |
| 322 ROOTS is the list of installation roots." | |
| 4108 | 323 (paths-find-version-directory roots (list "etc") nil "EMACSDATA" configure-data-directory)) |
| 428 | 324 |
| 325 (defun paths-construct-data-directory-list (data-directory | |
| 2456 | 326 early-package-hierarchies |
| 327 late-package-hierarchies | |
| 328 last-package-hierarchies) | |
| 329 "Construct the data path. | |
| 330 DATA-DIRECTORY is the data directory of the XEmacs installation. | |
| 331 EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and | |
| 332 LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots, | |
| 333 respectively." | |
| 428 | 334 (append |
| 2456 | 335 (packages-find-package-data-path early-package-hierarchies) |
| 336 (packages-find-package-data-path late-package-hierarchies) | |
| 428 | 337 (list data-directory) |
| 2456 | 338 (packages-find-package-data-path last-package-hierarchies))) |
| 1330 | 339 |
| 428 | 340 ;;; setup-paths.el ends here |