Mercurial > hg > xemacs-beta
annotate lisp/find-paths.el @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 03 Jun 2011 18:40:57 +0100 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4919
diff
changeset
|
14 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4919
diff
changeset
|
15 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4919
diff
changeset
|
16 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4919
diff
changeset
|
17 ;; option) any later version. |
| 428 | 18 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4919
diff
changeset
|
19 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4919
diff
changeset
|
20 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4919
diff
changeset
|
21 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4919
diff
changeset
|
22 ;; for more details. |
| 428 | 23 |
| 24 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4919
diff
changeset
|
25 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 26 |
| 27 ;;; Synched up with: Not in FSF. | |
| 28 | |
| 29 ;;; Commentary: | |
| 30 | |
| 31 ;; This file is dumped with XEmacs. | |
| 32 | |
| 776 | 33 ;; This file contains basic library functionality for manipulating paths |
| 34 ;; and path lists and finding paths in the XEmacs hierarchy. | |
| 35 | |
| 428 | 36 |
| 37 ;;; Code: | |
| 38 | |
| 39 (defvar paths-version-control-filename-regexp | |
| 40 "^\\(RCS\\|CVS\\|SCCS\\)$" | |
| 41 "File bases associated with version control.") | |
| 42 | |
| 43 (defvar paths-lisp-filename-regexp | |
| 44 "^\\(.*\\.elc?\\)$" | |
| 2297 | 45 "File bases that name Emacs Lisp files.") |
| 428 | 46 |
| 47 (defvar paths-no-lisp-directory-regexp | |
| 48 (concat "\\(" paths-version-control-filename-regexp "\\)" | |
| 49 "\\|" | |
| 50 "\\(" paths-lisp-filename-regexp "\\)") | |
| 51 "File bases that may not be directories containing Lisp code.") | |
| 52 | |
| 53 (defun paths-find-recursive-path (directories &optional max-depth exclude-regexp) | |
| 54 "Return a list of the directory hierarchy underneath DIRECTORIES. | |
| 55 The returned list is sorted by pre-order and lexicographically. | |
| 56 MAX-DEPTH limits the depth of the search to MAX-DEPTH level, | |
| 57 if it is a number. If MAX-DEPTH is NIL, the search depth is unlimited. | |
| 58 EXCLUDE-REGEXP is a regexp that matches directory names to exclude | |
| 59 from the search." | |
| 60 (let ((path '())) | |
| 61 (while directories | |
| 62 (let ((directory (file-name-as-directory | |
| 63 (expand-file-name | |
| 64 (car directories))))) | |
| 65 (if (paths-file-readable-directory-p directory) | |
| 66 (let ((raw-entries | |
| 67 (if (equal 0 max-depth) | |
| 68 '() | |
| 69 (directory-files directory nil "^[^.-]"))) | |
| 70 (reverse-dirs '())) | |
| 71 (while raw-entries | |
| 531 | 72 (if (not (and exclude-regexp |
| 73 (string-match exclude-regexp (car raw-entries)))) | |
| 428 | 74 (setq reverse-dirs |
| 75 (cons (expand-file-name (car raw-entries) directory) | |
| 76 reverse-dirs))) | |
| 77 (setq raw-entries (cdr raw-entries))) | |
| 78 | |
| 79 (let ((sub-path | |
| 80 (paths-find-recursive-path (reverse reverse-dirs) | |
| 81 (if (numberp max-depth) | |
| 82 (- max-depth 1) | |
| 83 max-depth) | |
| 84 exclude-regexp))) | |
| 85 (setq path (nconc path | |
| 86 (list directory) | |
| 87 sub-path)))))) | |
| 88 (setq directories (cdr directories))) | |
| 89 path)) | |
| 90 | |
| 91 (defun paths-file-readable-directory-p (filename) | |
| 92 "Check if filename is a readable directory." | |
| 93 (and (file-directory-p filename) | |
| 94 (file-readable-p filename))) | |
| 95 | |
| 96 (defun paths-find-recursive-load-path (directories &optional max-depth) | |
| 97 "Construct a recursive load path underneath DIRECTORIES." | |
| 98 (paths-find-recursive-path directories | |
| 99 max-depth paths-no-lisp-directory-regexp)) | |
| 100 | |
| 101 (defun paths-chase-symlink (file-name) | |
| 102 "Chase a symlink until the bitter end." | |
| 103 (let ((maybe-symlink (file-symlink-p file-name))) | |
| 104 (if maybe-symlink | |
| 105 (let* ((directory (file-name-directory file-name)) | |
| 106 (destination (expand-file-name maybe-symlink directory))) | |
| 107 (paths-chase-symlink destination)) | |
| 108 file-name))) | |
| 109 | |
| 110 (defun paths-construct-path (components &optional expand-directory) | |
| 111 "Convert list of path components COMPONENTS into a path. | |
| 112 If EXPAND-DIRECTORY is non-NIL, use it as a directory to feed | |
| 113 to EXPAND-FILE-NAME." | |
| 114 (let* ((reverse-components (reverse components)) | |
| 115 (last-component (car reverse-components)) | |
| 116 (first-components (reverse (cdr reverse-components))) | |
| 117 (path | |
| 118 (apply #'concat | |
| 119 (append (mapcar #'file-name-as-directory first-components) | |
| 120 (list last-component))))) | |
| 121 (if expand-directory | |
| 122 (expand-file-name path expand-directory) | |
| 123 path))) | |
| 124 | |
| 125 (defun paths-construct-emacs-directory (root suffix base) | |
| 2456 | 126 "Construct a directory name within the XEmacs hierarchy. |
| 3753 | 127 ROOT must be an installation root. |
| 2456 | 128 SUFFIX is the subdirectory from there. |
| 129 BASE is the base to look for." | |
| 428 | 130 (file-name-as-directory |
| 131 (expand-file-name | |
| 132 (concat | |
| 133 (file-name-as-directory root) | |
| 134 suffix | |
| 135 base)))) | |
| 136 | |
| 2481 | 137 |
| 138 (defun paths-for-each-emacs-directory (func | |
| 4108 | 139 roots suffix bases |
| 2481 | 140 &optional envvar default keep-suffix) |
| 141 "Iterate over directories in the XEmacs hierarchy. | |
| 142 FUNC is a function that called for each directory, with the directory | |
| 143 as the only argument. | |
| 428 | 144 ROOTS must be a list of installation roots. |
| 145 SUFFIX is the subdirectory from there. | |
| 4108 | 146 BASEA is a list of possible bases to look for. |
| 428 | 147 ENVVAR is the name of the environment variable that might also |
| 148 specify the directory. | |
| 149 DEFAULT is the preferred value. | |
| 150 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching | |
| 1218 | 151 the directory." |
| 428 | 152 (let ((preferred-value (or (and envvar (getenv envvar)) |
| 153 default))) | |
| 154 (if (and preferred-value | |
| 155 (paths-file-readable-directory-p preferred-value)) | |
| 156 (file-name-as-directory preferred-value) | |
| 2481 | 157 (while roots |
| 4108 | 158 (let ((root (car roots)) |
| 159 (bases bases)) | |
| 160 (while bases | |
| 161 (let* ((base (car bases)) | |
| 162 ;; installed | |
| 163 (path (paths-construct-emacs-directory root suffix base))) | |
| 164 (if (paths-file-readable-directory-p path) | |
| 165 (funcall func path) | |
| 166 ;; in-place | |
| 167 (if (null keep-suffix) | |
| 168 (let ((path (paths-construct-emacs-directory root "" base))) | |
| 169 (if (paths-file-readable-directory-p path) | |
| 170 (funcall func path)))))) | |
| 171 (setq bases (cdr bases)))) | |
| 2481 | 172 (setq roots (cdr roots)))))) |
| 173 | |
| 174 (defun paths-find-emacs-directories (roots | |
| 4108 | 175 suffix bases |
| 2481 | 176 &optional envvar default keep-suffix) |
| 177 "Find a list of directories in the XEmacs hierarchy. | |
| 178 ROOTS must be a list of installation roots. | |
| 179 SUFFIX is the subdirectory from there. | |
| 4108 | 180 BASES is a list of bases to look for. |
| 2481 | 181 ENVVAR is the name of the environment variable that might also |
| 182 specify the directory. | |
| 183 DEFAULT is the preferred value. | |
| 184 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching | |
| 185 the directory." | |
| 186 (let ((l '())) | |
| 187 (paths-for-each-emacs-directory #'(lambda (dir) | |
| 188 (setq l (cons dir l))) | |
| 189 roots | |
| 4108 | 190 suffix bases |
| 2481 | 191 envvar default keep-suffix) |
| 192 (reverse l))) | |
| 193 | |
| 4108 | 194 (defun paths-find-emacs-directory (roots suffix bases |
| 2481 | 195 &optional envvar default keep-suffix) |
| 196 "Find a directory in the XEmacs hierarchy. | |
| 197 ROOTS must be a list of installation roots. | |
| 198 SUFFIX is the subdirectory from there. | |
| 4108 | 199 BASES is a list of possible bases to look for. |
| 2481 | 200 ENVVAR is the name of the environment variable that might also |
| 201 specify the directory. | |
| 202 DEFAULT is the preferred value. | |
| 203 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching | |
| 204 the directory." | |
| 205 (catch 'gotcha | |
| 206 (paths-for-each-emacs-directory #'(lambda (dir) | |
| 207 (throw 'gotcha dir)) | |
| 208 roots | |
| 4108 | 209 suffix bases |
| 2481 | 210 envvar default keep-suffix))) |
| 211 | |
| 4108 | 212 (defun paths-for-each-site-directory (func |
| 213 roots bases | |
| 214 arch-dependent-p | |
| 215 &optional envvar default) | |
| 2481 | 216 "Iterate over the site-specific directories in the XEmacs hierarchy. |
| 217 FUNC is a function that called for each directory, with the directory | |
| 218 as the only argument. | |
| 3753 | 219 ROOTS must be a list of installation roots. |
| 4108 | 220 BASES is a list of possible bases to look for. |
| 4092 | 221 ARCH-DEPENDENT-P says whether the file is architecture-specific. |
| 2481 | 222 ENVVAR is the name of the environment variable that might also |
| 223 specify the directory. | |
| 224 DEFAULT is the preferred value." | |
| 225 (paths-for-each-emacs-directory func | |
| 226 roots | |
| 227 (file-name-as-directory | |
| 228 (paths-construct-path (list | |
| 4092 | 229 (if arch-dependent-p "lib" "share") |
| 2481 | 230 emacs-program-name))) |
| 4108 | 231 bases |
| 2481 | 232 envvar default)) |
| 428 | 233 |
| 4108 | 234 (defun paths-find-site-directory (roots bases arch-dependent-p &optional envvar default) |
| 2456 | 235 "Find a site-specific directory in the XEmacs hierarchy. |
| 3753 | 236 ROOTS must be a list of installation roots. |
| 4108 | 237 BASES is a list of possible bases to look for. |
| 4092 | 238 ARCH-DEPENDENT-P says whether the file is architecture-specific. |
| 2456 | 239 ENVVAR is the name of the environment variable that might also |
| 240 specify the directory. | |
| 241 DEFAULT is the preferred value." | |
| 2481 | 242 (catch 'gotcha |
| 243 (paths-for-each-site-directory #'(lambda (dir) | |
| 244 (throw 'gotcha dir)) | |
| 4108 | 245 roots bases arch-dependent-p |
| 2481 | 246 envvar default))) |
| 428 | 247 |
| 4108 | 248 (defun paths-find-site-directories (roots bases arch-dependent-p &optional envvar default) |
| 2481 | 249 "Find a list of site-specific directories in the XEmacs hierarchy. |
| 3753 | 250 ROOTS must be a list of installation roots. |
| 4108 | 251 BASES is a list of bases to look for. |
| 4092 | 252 ARCH-DEPENDENT-P says whether the file is architecture-specific. |
| 2481 | 253 ENVVAR is the name of the environment variable that might also |
| 254 specify the directory. | |
| 255 DEFAULT is the preferred value." | |
| 256 (let ((l '())) | |
| 257 (paths-for-each-site-directory #'(lambda (dir) | |
| 258 (setq l (cons dir l))) | |
| 4108 | 259 roots bases arch-dependent-p |
| 2481 | 260 envvar default) |
| 261 (reverse l))) | |
| 2456 | 262 |
| 4108 | 263 (defun paths-for-each-version-directory (func roots bases arch-dependent-p |
| 2481 | 264 &optional envvar default enforce-version) |
| 265 "Iterate over version-specific directories in the XEmacs hierarchy. | |
| 266 FUNC is a function that called for each directory, with the directory | |
| 267 as the only argument. | |
| 3753 | 268 ROOTS must be a list of installation roots. |
| 4108 | 269 BASES is a list of possible bases to look for. |
| 4092 | 270 ARCH-DEPENDENT-P says whether the file is architecture-specific. |
| 2456 | 271 ENVVAR is the name of the environment variable that might also |
| 272 specify the directory. | |
| 273 DEFAULT is the preferred value. | |
| 428 | 274 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." |
| 2481 | 275 (paths-for-each-emacs-directory func |
| 276 roots | |
| 277 (file-name-as-directory | |
| 278 (paths-construct-path | |
| 4092 | 279 (list (if arch-dependent-p "lib" "share") |
| 2481 | 280 (construct-emacs-version-name)))) |
| 4108 | 281 bases |
| 2481 | 282 envvar default)) |
| 283 | |
| 4108 | 284 (defun paths-find-version-directory (roots bases arch-dependent-p |
| 2481 | 285 &optional envvar default enforce-version) |
| 286 "Find a version-specific directory in the XEmacs hierarchy. | |
| 3753 | 287 ROOTS must be a list of installation roots. |
| 4108 | 288 BASES is a list of possible bases to look for. |
| 4092 | 289 ARCH-DEPENDENT-P says whether the file is architecture-specific. |
| 2481 | 290 ENVVAR is the name of the environment variable that might also |
| 291 specify the directory. | |
| 292 DEFAULT is the preferred value. | |
| 293 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." | |
| 294 (catch 'gotcha | |
| 295 (paths-for-each-version-directory #'(lambda (dir) | |
| 296 (throw 'gotcha dir)) | |
| 4108 | 297 roots bases arch-dependent-p |
| 2481 | 298 envvar default))) |
| 299 | |
| 4108 | 300 (defun paths-find-version-directories (roots bases arch-dependent-p |
| 2481 | 301 &optional envvar default enforce-version) |
| 302 "Find a list of version-specific directories in the XEmacs hierarchy. | |
| 3753 | 303 ROOTS must be a list of installation roots. |
| 4108 | 304 BASES is a list of possible bases to look for. |
| 4092 | 305 ARCH-DEPENDENT-P says whether the file is architecture-specific. |
| 2481 | 306 ENVVAR is the name of the environment variable that might also |
| 307 specify the directory. | |
| 308 DEFAULT is the preferred value. | |
| 309 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." | |
| 310 (let ((l '())) | |
| 4092 | 311 (paths-for-each-version-directory #'(lambda (dir) |
| 312 (setq l (cons dir l))) | |
| 4108 | 313 roots bases arch-dependent-p |
| 4092 | 314 envvar default) |
| 2481 | 315 (reverse l))) |
| 428 | 316 |
| 4108 | 317 (defun paths-find-architecture-directory (roots bases &optional envvar default) |
| 2456 | 318 "Find an architecture-specific directory in the XEmacs hierarchy. |
| 3753 | 319 ROOTS must be a list of installation roots. |
| 4108 | 320 BASES is a list of possible bases to look for. |
| 2456 | 321 ENVVAR is the name of the environment variable that might also |
| 322 specify the directory. | |
| 323 DEFAULT is the preferred value." | |
| 4108 | 324 (paths-find-version-directory roots |
| 325 ;; from more to less specific | |
| 326 (append | |
| 327 (mapcar | |
| 328 #'(lambda (base) | |
| 329 (paths-construct-path | |
| 330 (list system-configuration base))) | |
| 331 bases) | |
| 332 bases | |
| 333 (list system-configuration)) | |
| 334 t | |
| 335 envvar default)) | |
| 428 | 336 |
| 337 (defun construct-emacs-version-name () | |
| 2456 | 338 "Construct a string from the raw XEmacs version number." |
| 428 | 339 (concat emacs-program-name "-" emacs-program-version)) |
| 340 | |
| 341 (defun paths-directories-which-exist (directories) | |
| 2456 | 342 "Return the directories among DIRECTORIES. |
| 343 DIRECTORIES is a list of strings." | |
| 428 | 344 (let ((reverse-directories '())) |
| 345 (while directories | |
| 346 (if (paths-file-readable-directory-p (car directories)) | |
| 347 (setq reverse-directories | |
| 348 (cons (car directories) | |
| 349 reverse-directories))) | |
| 350 (setq directories (cdr directories))) | |
| 351 (reverse reverse-directories))) | |
| 352 | |
| 353 (defun paths-decode-directory-path (string &optional drop-empties) | |
| 354 "Split STRING at path separators into a directory list. | |
| 442 | 355 Non-\"\" components are converted into directory form. |
| 428 | 356 If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output. |
| 357 Otherwise, they are left alone." | |
| 358 (let* ((components (split-path string)) | |
| 359 (directories | |
| 360 (mapcar #'(lambda (component) | |
| 361 (if (string-equal "" component) | |
| 362 component | |
| 363 (file-name-as-directory component))) | |
| 364 components))) | |
| 365 (if drop-empties | |
|
4919
9c6ea1581159
Remove a couple of XEmacs-specific duplicate functions, find-paths.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
4108
diff
changeset
|
366 (delete "" directories) |
| 428 | 367 directories))) |
| 368 | |
| 369 ;;; find-paths.el ends here |