428
+ − 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
1330
+ − 6 ;; Copyright (C) 2003 Ben Wing.
428
+ − 7
2456
+ − 8 ;; Author: Mike Sperber <mike@xemacs.org>
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 basic library functionality for manipulating paths
+ − 36 ;; and path lists and finding paths in the XEmacs hierarchy.
+ − 37
428
+ − 38
+ − 39 ;;; Code:
+ − 40
+ − 41 (defvar paths-version-control-filename-regexp
+ − 42 "^\\(RCS\\|CVS\\|SCCS\\)$"
+ − 43 "File bases associated with version control.")
+ − 44
+ − 45 (defvar paths-lisp-filename-regexp
+ − 46 "^\\(.*\\.elc?\\)$"
2297
+ − 47 "File bases that name Emacs Lisp files.")
428
+ − 48
+ − 49 (defvar paths-no-lisp-directory-regexp
+ − 50 (concat "\\(" paths-version-control-filename-regexp "\\)"
+ − 51 "\\|"
+ − 52 "\\(" paths-lisp-filename-regexp "\\)")
+ − 53 "File bases that may not be directories containing Lisp code.")
+ − 54
+ − 55 (defun paths-find-recursive-path (directories &optional max-depth exclude-regexp)
+ − 56 "Return a list of the directory hierarchy underneath DIRECTORIES.
+ − 57 The returned list is sorted by pre-order and lexicographically.
+ − 58 MAX-DEPTH limits the depth of the search to MAX-DEPTH level,
+ − 59 if it is a number. If MAX-DEPTH is NIL, the search depth is unlimited.
+ − 60 EXCLUDE-REGEXP is a regexp that matches directory names to exclude
+ − 61 from the search."
+ − 62 (let ((path '()))
+ − 63 (while directories
+ − 64 (let ((directory (file-name-as-directory
+ − 65 (expand-file-name
+ − 66 (car directories)))))
+ − 67 (if (paths-file-readable-directory-p directory)
+ − 68 (let ((raw-entries
+ − 69 (if (equal 0 max-depth)
+ − 70 '()
+ − 71 (directory-files directory nil "^[^.-]")))
+ − 72 (reverse-dirs '()))
+ − 73 (while raw-entries
531
+ − 74 (if (not (and exclude-regexp
+ − 75 (string-match exclude-regexp (car raw-entries))))
428
+ − 76 (setq reverse-dirs
+ − 77 (cons (expand-file-name (car raw-entries) directory)
+ − 78 reverse-dirs)))
+ − 79 (setq raw-entries (cdr raw-entries)))
+ − 80
+ − 81 (let ((sub-path
+ − 82 (paths-find-recursive-path (reverse reverse-dirs)
+ − 83 (if (numberp max-depth)
+ − 84 (- max-depth 1)
+ − 85 max-depth)
+ − 86 exclude-regexp)))
+ − 87 (setq path (nconc path
+ − 88 (list directory)
+ − 89 sub-path))))))
+ − 90 (setq directories (cdr directories)))
+ − 91 path))
+ − 92
+ − 93 (defun paths-file-readable-directory-p (filename)
+ − 94 "Check if filename is a readable directory."
+ − 95 (and (file-directory-p filename)
+ − 96 (file-readable-p filename)))
+ − 97
+ − 98 (defun paths-find-recursive-load-path (directories &optional max-depth)
+ − 99 "Construct a recursive load path underneath DIRECTORIES."
+ − 100 (paths-find-recursive-path directories
+ − 101 max-depth paths-no-lisp-directory-regexp))
+ − 102
+ − 103 (defun paths-chase-symlink (file-name)
+ − 104 "Chase a symlink until the bitter end."
+ − 105 (let ((maybe-symlink (file-symlink-p file-name)))
+ − 106 (if maybe-symlink
+ − 107 (let* ((directory (file-name-directory file-name))
+ − 108 (destination (expand-file-name maybe-symlink directory)))
+ − 109 (paths-chase-symlink destination))
+ − 110 file-name)))
+ − 111
+ − 112 (defun paths-construct-path (components &optional expand-directory)
+ − 113 "Convert list of path components COMPONENTS into a path.
+ − 114 If EXPAND-DIRECTORY is non-NIL, use it as a directory to feed
+ − 115 to EXPAND-FILE-NAME."
+ − 116 (let* ((reverse-components (reverse components))
+ − 117 (last-component (car reverse-components))
+ − 118 (first-components (reverse (cdr reverse-components)))
+ − 119 (path
+ − 120 (apply #'concat
+ − 121 (append (mapcar #'file-name-as-directory first-components)
+ − 122 (list last-component)))))
+ − 123 (if expand-directory
+ − 124 (expand-file-name path expand-directory)
+ − 125 path)))
+ − 126
+ − 127 (defun paths-construct-emacs-directory (root suffix base)
2456
+ − 128 "Construct a directory name within the XEmacs hierarchy.
3753
+ − 129 ROOT must be an installation root.
2456
+ − 130 SUFFIX is the subdirectory from there.
+ − 131 BASE is the base to look for."
428
+ − 132 (file-name-as-directory
+ − 133 (expand-file-name
+ − 134 (concat
+ − 135 (file-name-as-directory root)
+ − 136 suffix
+ − 137 base))))
+ − 138
2481
+ − 139
+ − 140 (defun paths-for-each-emacs-directory (func
4108
+ − 141 roots suffix bases
2481
+ − 142 &optional envvar default keep-suffix)
+ − 143 "Iterate over directories in the XEmacs hierarchy.
+ − 144 FUNC is a function that called for each directory, with the directory
+ − 145 as the only argument.
428
+ − 146 ROOTS must be a list of installation roots.
+ − 147 SUFFIX is the subdirectory from there.
4108
+ − 148 BASEA is a list of possible bases to look for.
428
+ − 149 ENVVAR is the name of the environment variable that might also
+ − 150 specify the directory.
+ − 151 DEFAULT is the preferred value.
+ − 152 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
1218
+ − 153 the directory."
428
+ − 154 (let ((preferred-value (or (and envvar (getenv envvar))
+ − 155 default)))
+ − 156 (if (and preferred-value
+ − 157 (paths-file-readable-directory-p preferred-value))
+ − 158 (file-name-as-directory preferred-value)
2481
+ − 159 (while roots
4108
+ − 160 (let ((root (car roots))
+ − 161 (bases bases))
+ − 162 (while bases
+ − 163 (let* ((base (car bases))
+ − 164 ;; installed
+ − 165 (path (paths-construct-emacs-directory root suffix base)))
+ − 166 (if (paths-file-readable-directory-p path)
+ − 167 (funcall func path)
+ − 168 ;; in-place
+ − 169 (if (null keep-suffix)
+ − 170 (let ((path (paths-construct-emacs-directory root "" base)))
+ − 171 (if (paths-file-readable-directory-p path)
+ − 172 (funcall func path))))))
+ − 173 (setq bases (cdr bases))))
2481
+ − 174 (setq roots (cdr roots))))))
+ − 175
+ − 176 (defun paths-find-emacs-directories (roots
4108
+ − 177 suffix bases
2481
+ − 178 &optional envvar default keep-suffix)
+ − 179 "Find a list of directories in the XEmacs hierarchy.
+ − 180 ROOTS must be a list of installation roots.
+ − 181 SUFFIX is the subdirectory from there.
4108
+ − 182 BASES is a list of bases to look for.
2481
+ − 183 ENVVAR is the name of the environment variable that might also
+ − 184 specify the directory.
+ − 185 DEFAULT is the preferred value.
+ − 186 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
+ − 187 the directory."
+ − 188 (let ((l '()))
+ − 189 (paths-for-each-emacs-directory #'(lambda (dir)
+ − 190 (setq l (cons dir l)))
+ − 191 roots
4108
+ − 192 suffix bases
2481
+ − 193 envvar default keep-suffix)
+ − 194 (reverse l)))
+ − 195
4108
+ − 196 (defun paths-find-emacs-directory (roots suffix bases
2481
+ − 197 &optional envvar default keep-suffix)
+ − 198 "Find a directory in the XEmacs hierarchy.
+ − 199 ROOTS must be a list of installation roots.
+ − 200 SUFFIX is the subdirectory from there.
4108
+ − 201 BASES is a list of possible bases to look for.
2481
+ − 202 ENVVAR is the name of the environment variable that might also
+ − 203 specify the directory.
+ − 204 DEFAULT is the preferred value.
+ − 205 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
+ − 206 the directory."
+ − 207 (catch 'gotcha
+ − 208 (paths-for-each-emacs-directory #'(lambda (dir)
+ − 209 (throw 'gotcha dir))
+ − 210 roots
4108
+ − 211 suffix bases
2481
+ − 212 envvar default keep-suffix)))
+ − 213
4108
+ − 214 (defun paths-for-each-site-directory (func
+ − 215 roots bases
+ − 216 arch-dependent-p
+ − 217 &optional envvar default)
2481
+ − 218 "Iterate over the site-specific directories in the XEmacs hierarchy.
+ − 219 FUNC is a function that called for each directory, with the directory
+ − 220 as the only argument.
3753
+ − 221 ROOTS must be a list of installation roots.
4108
+ − 222 BASES is a list of possible bases to look for.
4092
+ − 223 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2481
+ − 224 ENVVAR is the name of the environment variable that might also
+ − 225 specify the directory.
+ − 226 DEFAULT is the preferred value."
+ − 227 (paths-for-each-emacs-directory func
+ − 228 roots
+ − 229 (file-name-as-directory
+ − 230 (paths-construct-path (list
4092
+ − 231 (if arch-dependent-p "lib" "share")
2481
+ − 232 emacs-program-name)))
4108
+ − 233 bases
2481
+ − 234 envvar default))
428
+ − 235
4108
+ − 236 (defun paths-find-site-directory (roots bases arch-dependent-p &optional envvar default)
2456
+ − 237 "Find a site-specific directory in the XEmacs hierarchy.
3753
+ − 238 ROOTS must be a list of installation roots.
4108
+ − 239 BASES is a list of possible bases to look for.
4092
+ − 240 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2456
+ − 241 ENVVAR is the name of the environment variable that might also
+ − 242 specify the directory.
+ − 243 DEFAULT is the preferred value."
2481
+ − 244 (catch 'gotcha
+ − 245 (paths-for-each-site-directory #'(lambda (dir)
+ − 246 (throw 'gotcha dir))
4108
+ − 247 roots bases arch-dependent-p
2481
+ − 248 envvar default)))
428
+ − 249
4108
+ − 250 (defun paths-find-site-directories (roots bases arch-dependent-p &optional envvar default)
2481
+ − 251 "Find a list of site-specific directories in the XEmacs hierarchy.
3753
+ − 252 ROOTS must be a list of installation roots.
4108
+ − 253 BASES is a list of bases to look for.
4092
+ − 254 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2481
+ − 255 ENVVAR is the name of the environment variable that might also
+ − 256 specify the directory.
+ − 257 DEFAULT is the preferred value."
+ − 258 (let ((l '()))
+ − 259 (paths-for-each-site-directory #'(lambda (dir)
+ − 260 (setq l (cons dir l)))
4108
+ − 261 roots bases arch-dependent-p
2481
+ − 262 envvar default)
+ − 263 (reverse l)))
2456
+ − 264
4108
+ − 265 (defun paths-for-each-version-directory (func roots bases arch-dependent-p
2481
+ − 266 &optional envvar default enforce-version)
+ − 267 "Iterate over version-specific directories in the XEmacs hierarchy.
+ − 268 FUNC is a function that called for each directory, with the directory
+ − 269 as the only argument.
3753
+ − 270 ROOTS must be a list of installation roots.
4108
+ − 271 BASES is a list of possible bases to look for.
4092
+ − 272 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2456
+ − 273 ENVVAR is the name of the environment variable that might also
+ − 274 specify the directory.
+ − 275 DEFAULT is the preferred value.
428
+ − 276 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
2481
+ − 277 (paths-for-each-emacs-directory func
+ − 278 roots
+ − 279 (file-name-as-directory
+ − 280 (paths-construct-path
4092
+ − 281 (list (if arch-dependent-p "lib" "share")
2481
+ − 282 (construct-emacs-version-name))))
4108
+ − 283 bases
2481
+ − 284 envvar default))
+ − 285
4108
+ − 286 (defun paths-find-version-directory (roots bases arch-dependent-p
2481
+ − 287 &optional envvar default enforce-version)
+ − 288 "Find a version-specific directory in the XEmacs hierarchy.
3753
+ − 289 ROOTS must be a list of installation roots.
4108
+ − 290 BASES is a list of possible bases to look for.
4092
+ − 291 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2481
+ − 292 ENVVAR is the name of the environment variable that might also
+ − 293 specify the directory.
+ − 294 DEFAULT is the preferred value.
+ − 295 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
+ − 296 (catch 'gotcha
+ − 297 (paths-for-each-version-directory #'(lambda (dir)
+ − 298 (throw 'gotcha dir))
4108
+ − 299 roots bases arch-dependent-p
2481
+ − 300 envvar default)))
+ − 301
4108
+ − 302 (defun paths-find-version-directories (roots bases arch-dependent-p
2481
+ − 303 &optional envvar default enforce-version)
+ − 304 "Find a list of version-specific directories in the XEmacs hierarchy.
3753
+ − 305 ROOTS must be a list of installation roots.
4108
+ − 306 BASES is a list of possible bases to look for.
4092
+ − 307 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2481
+ − 308 ENVVAR is the name of the environment variable that might also
+ − 309 specify the directory.
+ − 310 DEFAULT is the preferred value.
+ − 311 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
+ − 312 (let ((l '()))
4092
+ − 313 (paths-for-each-version-directory #'(lambda (dir)
+ − 314 (setq l (cons dir l)))
4108
+ − 315 roots bases arch-dependent-p
4092
+ − 316 envvar default)
2481
+ − 317 (reverse l)))
428
+ − 318
4108
+ − 319 (defun paths-find-architecture-directory (roots bases &optional envvar default)
2456
+ − 320 "Find an architecture-specific directory in the XEmacs hierarchy.
3753
+ − 321 ROOTS must be a list of installation roots.
4108
+ − 322 BASES is a list of possible bases to look for.
2456
+ − 323 ENVVAR is the name of the environment variable that might also
+ − 324 specify the directory.
+ − 325 DEFAULT is the preferred value."
4108
+ − 326 (paths-find-version-directory roots
+ − 327 ;; from more to less specific
+ − 328 (append
+ − 329 (mapcar
+ − 330 #'(lambda (base)
+ − 331 (paths-construct-path
+ − 332 (list system-configuration base)))
+ − 333 bases)
+ − 334 bases
+ − 335 (list system-configuration))
+ − 336 t
+ − 337 envvar default))
428
+ − 338
+ − 339 (defun construct-emacs-version-name ()
2456
+ − 340 "Construct a string from the raw XEmacs version number."
428
+ − 341 (concat emacs-program-name "-" emacs-program-version))
+ − 342
+ − 343 (defun paths-directories-which-exist (directories)
2456
+ − 344 "Return the directories among DIRECTORIES.
+ − 345 DIRECTORIES is a list of strings."
428
+ − 346 (let ((reverse-directories '()))
+ − 347 (while directories
+ − 348 (if (paths-file-readable-directory-p (car directories))
+ − 349 (setq reverse-directories
+ − 350 (cons (car directories)
+ − 351 reverse-directories)))
+ − 352 (setq directories (cdr directories)))
+ − 353 (reverse reverse-directories)))
+ − 354
+ − 355 (defun paths-uniq-append (list-1 list-2)
2456
+ − 356 "Append LIST-1 and LIST-2, omitting EQUAL duplicates."
428
+ − 357 (let ((reverse-survivors '()))
+ − 358 (while list-2
+ − 359 (if (null (member (car list-2) list-1))
+ − 360 (setq reverse-survivors (cons (car list-2) reverse-survivors)))
+ − 361 (setq list-2 (cdr list-2)))
+ − 362 (append list-1
+ − 363 (reverse reverse-survivors))))
+ − 364
+ − 365 (defun paths-filter (predicate list)
+ − 366 "Delete all matches of PREDICATE from LIST."
+ − 367 (let ((reverse-result '()))
+ − 368 (while list
+ − 369 (if (funcall predicate (car list))
+ − 370 (setq reverse-result (cons (car list) reverse-result)))
+ − 371 (setq list (cdr list)))
+ − 372 (nreverse reverse-result)))
+ − 373
+ − 374 (defun paths-decode-directory-path (string &optional drop-empties)
+ − 375 "Split STRING at path separators into a directory list.
442
+ − 376 Non-\"\" components are converted into directory form.
428
+ − 377 If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output.
+ − 378 Otherwise, they are left alone."
+ − 379 (let* ((components (split-path string))
+ − 380 (directories
+ − 381 (mapcar #'(lambda (component)
+ − 382 (if (string-equal "" component)
+ − 383 component
+ − 384 (file-name-as-directory component)))
+ − 385 components)))
+ − 386 (if drop-empties
+ − 387 (paths-filter #'(lambda (component)
+ − 388 (null (string-equal "" component)))
+ − 389 directories)
+ − 390 directories)))
+ − 391
+ − 392 ;;; find-paths.el ends here
