annotate lisp/find-paths.el @ 4885:6772ce4d982b

Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums lisp/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Correct the semantics of #'member*, #'eql, #'assoc* in the presence of bignums; change the integerp byte code to fixnump semantics. * bytecomp.el (fixnump, integerp, byte-compile-integerp): Change the integerp byte code to fixnump; add a byte-compile method to integerp using fixnump and numberp and avoiding a funcall most of the time, since in the non-core contexts where integerp is used, it's mostly distinguishing between fixnums and things that are not numbers at all. * byte-optimize.el (side-effect-free-fns, byte-after-unbind-ops) (byte-compile-side-effect-and-error-free-ops): Replace the integerp bytecode with fixnump; add fixnump to the side-effect-free-fns. Add the other extended number type predicates to the list in passing. * obsolete.el (floatp-safe): Mark this as obsolete. * cl.el (eql): Go into more detail in the docstring here. Don't bother checking whether both arguments are numbers; one is enough, #'equal will fail correctly if they have distinct types. (subst): Replace a call to #'integerp (deciding whether to use #'memq or not) with one to #'fixnump. Delete most-positive-fixnum, most-negative-fixnum from this file; they're now always in C, so they can't be modified from Lisp. * cl-seq.el (member*, assoc*, rassoc*): Correct these functions in the presence of bignums. * cl-macs.el (cl-make-type-test): The type test for a fixnum is now fixnump. Ditch floatp-safe, use floatp instead. (eql): Correct this compiler macro in the presence of bignums. (assoc*): Correct this compiler macro in the presence of bignums. * simple.el (undo): Change #'integerp to #'fixnump here, since we use #'delq with the same value as ELT a few lines down. src/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Fix problems with #'eql, extended number types, and the hash table implementation; change the Bintegerp bytecode to fixnump semantics even on bignum builds, since #'integerp can have a fast implementation in terms of #'fixnump for most of its extant uses, but not vice-versa. * lisp.h: Always #include number.h; we want the macros provided in it, even if the various number types are not available. * number.h (NON_FIXNUM_NUMBER_P): New macro, giving 1 when its argument is of non-immediate number type. Equivalent to FLOATP if WITH_NUMBER_TYPES is not defined. * elhash.c (lisp_object_eql_equal, lisp_object_eql_hash): Use NON_FIXNUM_NUMBER_P in these functions, instead of FLOATP, giving more correct behaviour in the presence of the extended number types. * bytecode.c (Bfixnump, execute_optimized_program): Rename Bintegerp to Bfixnump; change its semantics to reflect the new name on builds with bignum support. * data.c (Ffixnump, Fintegerp, syms_of_data, vars_of_data): Always make #'fixnump available, even on non-BIGNUM builds; always implement #'integerp in this file, even on BIGNUM builds. Move most-positive-fixnum, most-negative-fixnum here from number.c, so they are Lisp constants even on builds without number types, and attempts to change or bind them error. Use the NUMBERP and INTEGERP macros even on builds without extended number types. * data.c (fixnum_char_or_marker_to_int): Rename this function from integer_char_or_marker_to_int, to better reflect the arguments it accepts. * number.c (Fevenp, Foddp, syms_of_number): Never provide #'integerp in this file. Remove #'oddp, #'evenp; their implementations are overridden by those in cl.el. * number.c (vars_of_number): most-positive-fixnum, most-negative-fixnum are no longer here. man/ChangeLog addition: 2010-01-23 Aidan Kehoe <kehoea@parhasard.net> Generally: be careful to say fixnum, not integer, when talking about fixed-precision integral types. I'm sure I've missed instances, both here and in the docstrings, but this is a decent start. * lispref/text.texi (Columns): Document where only fixnums, not integers generally, are accepted. (Registers): Remove some ancient char-int confoundance here. * lispref/strings.texi (Creating Strings, Creating Strings): Be more exact in describing where fixnums but not integers in general are accepted. (Creating Strings): Use a more contemporary example to illustrate how concat deals with lists including integers about #xFF. Delete some obsolete documentation on same. (Char Table Types): Document that only fixnums are accepted as values in syntax tables. * lispref/searching.texi (String Search, Search and Replace): Be exact in describing where fixnums but not integers in general are accepted. * lispref/range-tables.texi (Range Tables): Be exact in describing them; only fixnums are accepted to describe ranges. * lispref/os.texi (Killing XEmacs, User Identification) (Time of Day, Time Conversion): Be more exact about using fixnum where only fixed-precision integers are accepted. * lispref/objects.texi (Integer Type): Be more exact (and up-to-date) about the possible values for integers. Cross-reference to documentation of the bignum extension. (Equality Predicates): (Range Table Type): (Array Type): Use fixnum, not integer, to describe a fixed-precision integer. (Syntax Table Type): Correct some English syntax here. * lispref/numbers.texi (Numbers): Change the phrasing here to use fixnum to mean the fixed-precision integers normal in emacs. Document that our terminology deviates from that of Common Lisp, and that we're working on it. (Compatibility Issues): Reiterate the Common Lisp versus Emacs Lisp compatibility issues. (Comparison of Numbers, Arithmetic Operations): * lispref/commands.texi (Command Loop Info, Working With Events): * lispref/buffers.texi (Modification Time): Be more exact in describing where fixnums but not integers in general are accepted.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 24 Jan 2010 15:21:27 +0000
parents 5da4cc7d5968
children 9c6ea1581159
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; find-paths.el --- setup various XEmacs paths
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
1330
4542b72c005e [xemacs-hg @ 2003-03-01 07:25:26 by ben]
ben
parents: 1227
diff changeset
6 ;; Copyright (C) 2003 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
8 ;; Author: Mike Sperber <mike@xemacs.org>
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; Keywords: internal, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; Free Software Foundation, 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 689
diff changeset
35 ;; This file contains basic library functionality for manipulating paths
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 689
diff changeset
36 ;; and path lists and finding paths in the XEmacs hierarchy.
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 689
diff changeset
37
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 (defvar paths-version-control-filename-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 "^\\(RCS\\|CVS\\|SCCS\\)$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 "File bases associated with version control.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 (defvar paths-lisp-filename-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 "^\\(.*\\.elc?\\)$"
2297
13a418960a88 [xemacs-hg @ 2004-09-22 02:05:42 by stephent]
stephent
parents: 1330
diff changeset
47 "File bases that name Emacs Lisp files.")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (defvar paths-no-lisp-directory-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 (concat "\\(" paths-version-control-filename-regexp "\\)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 "\\|"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 "\\(" paths-lisp-filename-regexp "\\)")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 "File bases that may not be directories containing Lisp code.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 (defun paths-find-recursive-path (directories &optional max-depth exclude-regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 "Return a list of the directory hierarchy underneath DIRECTORIES.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 The returned list is sorted by pre-order and lexicographically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 MAX-DEPTH limits the depth of the search to MAX-DEPTH level,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 if it is a number. If MAX-DEPTH is NIL, the search depth is unlimited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 EXCLUDE-REGEXP is a regexp that matches directory names to exclude
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 from the search."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (let ((path '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 (while directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (let ((directory (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (car directories)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (if (paths-file-readable-directory-p directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (let ((raw-entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (if (equal 0 max-depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 '()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (directory-files directory nil "^[^.-]")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (reverse-dirs '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (while raw-entries
531
0493e9f3c27f [xemacs-hg @ 2001-05-12 11:16:12 by ben]
ben
parents: 442
diff changeset
74 (if (not (and exclude-regexp
0493e9f3c27f [xemacs-hg @ 2001-05-12 11:16:12 by ben]
ben
parents: 442
diff changeset
75 (string-match exclude-regexp (car raw-entries))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (setq reverse-dirs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (cons (expand-file-name (car raw-entries) directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 reverse-dirs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (setq raw-entries (cdr raw-entries)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (let ((sub-path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (paths-find-recursive-path (reverse reverse-dirs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (if (numberp max-depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (- max-depth 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 max-depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 exclude-regexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (setq path (nconc path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (list directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 sub-path))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (setq directories (cdr directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (defun paths-file-readable-directory-p (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 "Check if filename is a readable directory."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (and (file-directory-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (file-readable-p filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (defun paths-find-recursive-load-path (directories &optional max-depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 "Construct a recursive load path underneath DIRECTORIES."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (paths-find-recursive-path directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 max-depth paths-no-lisp-directory-regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (defun paths-chase-symlink (file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 "Chase a symlink until the bitter end."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (let ((maybe-symlink (file-symlink-p file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (if maybe-symlink
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (let* ((directory (file-name-directory file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (destination (expand-file-name maybe-symlink directory)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (paths-chase-symlink destination))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (defun paths-construct-path (components &optional expand-directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 "Convert list of path components COMPONENTS into a path.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 If EXPAND-DIRECTORY is non-NIL, use it as a directory to feed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 to EXPAND-FILE-NAME."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (let* ((reverse-components (reverse components))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (last-component (car reverse-components))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 (first-components (reverse (cdr reverse-components)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (apply #'concat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 (append (mapcar #'file-name-as-directory first-components)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 (list last-component)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (if expand-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (expand-file-name path expand-directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 path)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (defun paths-construct-emacs-directory (root suffix base)
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
128 "Construct a directory name within the XEmacs hierarchy.
3753
a452d2a78a4e [xemacs-hg @ 2006-12-19 15:28:43 by stephent]
stephent
parents: 2481
diff changeset
129 ROOT must be an installation root.
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
130 SUFFIX is the subdirectory from there.
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
131 BASE is the base to look for."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (concat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (file-name-as-directory root)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 base))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
139
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
140 (defun paths-for-each-emacs-directory (func
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
141 roots suffix bases
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
142 &optional envvar default keep-suffix)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
143 "Iterate over directories in the XEmacs hierarchy.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
144 FUNC is a function that called for each directory, with the directory
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
145 as the only argument.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 ROOTS must be a list of installation roots.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 SUFFIX is the subdirectory from there.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
148 BASEA is a list of possible bases to look for.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 ENVVAR is the name of the environment variable that might also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 specify the directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 DEFAULT is the preferred value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
1218
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
153 the directory."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (let ((preferred-value (or (and envvar (getenv envvar))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 default)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (if (and preferred-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (paths-file-readable-directory-p preferred-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (file-name-as-directory preferred-value)
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
159 (while roots
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
160 (let ((root (car roots))
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
161 (bases bases))
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
162 (while bases
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
163 (let* ((base (car bases))
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
164 ;; installed
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
165 (path (paths-construct-emacs-directory root suffix base)))
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
166 (if (paths-file-readable-directory-p path)
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
167 (funcall func path)
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
168 ;; in-place
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
169 (if (null keep-suffix)
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
170 (let ((path (paths-construct-emacs-directory root "" base)))
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
171 (if (paths-file-readable-directory-p path)
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
172 (funcall func path))))))
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
173 (setq bases (cdr bases))))
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
174 (setq roots (cdr roots))))))
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
175
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
176 (defun paths-find-emacs-directories (roots
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
177 suffix bases
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
178 &optional envvar default keep-suffix)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
179 "Find a list of directories in the XEmacs hierarchy.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
180 ROOTS must be a list of installation roots.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
181 SUFFIX is the subdirectory from there.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
182 BASES is a list of bases to look for.
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
183 ENVVAR is the name of the environment variable that might also
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
184 specify the directory.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
185 DEFAULT is the preferred value.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
186 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
187 the directory."
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
188 (let ((l '()))
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
189 (paths-for-each-emacs-directory #'(lambda (dir)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
190 (setq l (cons dir l)))
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
191 roots
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
192 suffix bases
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
193 envvar default keep-suffix)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
194 (reverse l)))
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
195
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
196 (defun paths-find-emacs-directory (roots suffix bases
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
197 &optional envvar default keep-suffix)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
198 "Find a directory in the XEmacs hierarchy.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
199 ROOTS must be a list of installation roots.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
200 SUFFIX is the subdirectory from there.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
201 BASES is a list of possible bases to look for.
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
202 ENVVAR is the name of the environment variable that might also
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
203 specify the directory.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
204 DEFAULT is the preferred value.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
205 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
206 the directory."
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
207 (catch 'gotcha
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
208 (paths-for-each-emacs-directory #'(lambda (dir)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
209 (throw 'gotcha dir))
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
210 roots
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
211 suffix bases
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
212 envvar default keep-suffix)))
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
213
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
214 (defun paths-for-each-site-directory (func
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
215 roots bases
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
216 arch-dependent-p
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
217 &optional envvar default)
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
218 "Iterate over the site-specific directories in the XEmacs hierarchy.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
219 FUNC is a function that called for each directory, with the directory
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
220 as the only argument.
3753
a452d2a78a4e [xemacs-hg @ 2006-12-19 15:28:43 by stephent]
stephent
parents: 2481
diff changeset
221 ROOTS must be a list of installation roots.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
222 BASES is a list of possible bases to look for.
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
223 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
224 ENVVAR is the name of the environment variable that might also
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
225 specify the directory.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
226 DEFAULT is the preferred value."
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
227 (paths-for-each-emacs-directory func
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
228 roots
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
229 (file-name-as-directory
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
230 (paths-construct-path (list
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
231 (if arch-dependent-p "lib" "share")
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
232 emacs-program-name)))
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
233 bases
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
234 envvar default))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
236 (defun paths-find-site-directory (roots bases arch-dependent-p &optional envvar default)
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
237 "Find a site-specific directory in the XEmacs hierarchy.
3753
a452d2a78a4e [xemacs-hg @ 2006-12-19 15:28:43 by stephent]
stephent
parents: 2481
diff changeset
238 ROOTS must be a list of installation roots.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
239 BASES is a list of possible bases to look for.
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
240 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
241 ENVVAR is the name of the environment variable that might also
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
242 specify the directory.
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
243 DEFAULT is the preferred value."
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
244 (catch 'gotcha
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
245 (paths-for-each-site-directory #'(lambda (dir)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
246 (throw 'gotcha dir))
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
247 roots bases arch-dependent-p
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
248 envvar default)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
250 (defun paths-find-site-directories (roots bases arch-dependent-p &optional envvar default)
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
251 "Find a list of site-specific directories in the XEmacs hierarchy.
3753
a452d2a78a4e [xemacs-hg @ 2006-12-19 15:28:43 by stephent]
stephent
parents: 2481
diff changeset
252 ROOTS must be a list of installation roots.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
253 BASES is a list of bases to look for.
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
254 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
255 ENVVAR is the name of the environment variable that might also
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
256 specify the directory.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
257 DEFAULT is the preferred value."
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
258 (let ((l '()))
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
259 (paths-for-each-site-directory #'(lambda (dir)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
260 (setq l (cons dir l)))
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
261 roots bases arch-dependent-p
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
262 envvar default)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
263 (reverse l)))
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
264
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
265 (defun paths-for-each-version-directory (func roots bases arch-dependent-p
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
266 &optional envvar default enforce-version)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
267 "Iterate over version-specific directories in the XEmacs hierarchy.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
268 FUNC is a function that called for each directory, with the directory
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
269 as the only argument.
3753
a452d2a78a4e [xemacs-hg @ 2006-12-19 15:28:43 by stephent]
stephent
parents: 2481
diff changeset
270 ROOTS must be a list of installation roots.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
271 BASES is a list of possible bases to look for.
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
272 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
273 ENVVAR is the name of the environment variable that might also
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
274 specify the directory.
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
275 DEFAULT is the preferred value.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
277 (paths-for-each-emacs-directory func
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
278 roots
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
279 (file-name-as-directory
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
280 (paths-construct-path
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
281 (list (if arch-dependent-p "lib" "share")
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
282 (construct-emacs-version-name))))
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
283 bases
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
284 envvar default))
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
285
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
286 (defun paths-find-version-directory (roots bases arch-dependent-p
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
287 &optional envvar default enforce-version)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
288 "Find a version-specific directory in the XEmacs hierarchy.
3753
a452d2a78a4e [xemacs-hg @ 2006-12-19 15:28:43 by stephent]
stephent
parents: 2481
diff changeset
289 ROOTS must be a list of installation roots.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
290 BASES is a list of possible bases to look for.
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
291 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
292 ENVVAR is the name of the environment variable that might also
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
293 specify the directory.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
294 DEFAULT is the preferred value.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
295 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
296 (catch 'gotcha
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
297 (paths-for-each-version-directory #'(lambda (dir)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
298 (throw 'gotcha dir))
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
299 roots bases arch-dependent-p
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
300 envvar default)))
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
301
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
302 (defun paths-find-version-directories (roots bases arch-dependent-p
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
303 &optional envvar default enforce-version)
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
304 "Find a list of version-specific directories in the XEmacs hierarchy.
3753
a452d2a78a4e [xemacs-hg @ 2006-12-19 15:28:43 by stephent]
stephent
parents: 2481
diff changeset
305 ROOTS must be a list of installation roots.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
306 BASES is a list of possible bases to look for.
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
307 ARCH-DEPENDENT-P says whether the file is architecture-specific.
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
308 ENVVAR is the name of the environment variable that might also
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
309 specify the directory.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
310 DEFAULT is the preferred value.
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
311 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
312 (let ((l '()))
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
313 (paths-for-each-version-directory #'(lambda (dir)
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
314 (setq l (cons dir l)))
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
315 roots bases arch-dependent-p
4092
9c0151d05116 [xemacs-hg @ 2007-08-02 06:33:04 by michaels]
michaels
parents: 3753
diff changeset
316 envvar default)
2481
505a24c07ba9 [xemacs-hg @ 2005-01-15 15:17:32 by michaels]
michaels
parents: 2456
diff changeset
317 (reverse l)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
319 (defun paths-find-architecture-directory (roots bases &optional envvar default)
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
320 "Find an architecture-specific directory in the XEmacs hierarchy.
3753
a452d2a78a4e [xemacs-hg @ 2006-12-19 15:28:43 by stephent]
stephent
parents: 2481
diff changeset
321 ROOTS must be a list of installation roots.
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
322 BASES is a list of possible bases to look for.
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
323 ENVVAR is the name of the environment variable that might also
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
324 specify the directory.
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
325 DEFAULT is the preferred value."
4108
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
326 (paths-find-version-directory roots
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
327 ;; from more to less specific
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
328 (append
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
329 (mapcar
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
330 #'(lambda (base)
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
331 (paths-construct-path
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
332 (list system-configuration base)))
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
333 bases)
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
334 bases
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
335 (list system-configuration))
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
336 t
5da4cc7d5968 [xemacs-hg @ 2007-08-09 06:22:51 by michaels]
michaels
parents: 4092
diff changeset
337 envvar default))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (defun construct-emacs-version-name ()
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
340 "Construct a string from the raw XEmacs version number."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (concat emacs-program-name "-" emacs-program-version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (defun paths-directories-which-exist (directories)
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
344 "Return the directories among DIRECTORIES.
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
345 DIRECTORIES is a list of strings."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 (let ((reverse-directories '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (while directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (if (paths-file-readable-directory-p (car directories))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (setq reverse-directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (cons (car directories)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 reverse-directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (setq directories (cdr directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (reverse reverse-directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (defun paths-uniq-append (list-1 list-2)
2456
f4e405a9d18d [xemacs-hg @ 2004-12-27 12:25:14 by michaels]
michaels
parents: 2297
diff changeset
356 "Append LIST-1 and LIST-2, omitting EQUAL duplicates."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (let ((reverse-survivors '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (while list-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (if (null (member (car list-2) list-1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (setq reverse-survivors (cons (car list-2) reverse-survivors)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (setq list-2 (cdr list-2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (append list-1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (reverse reverse-survivors))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (defun paths-filter (predicate list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 "Delete all matches of PREDICATE from LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (let ((reverse-result '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (while list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (if (funcall predicate (car list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (setq reverse-result (cons (car list) reverse-result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (setq list (cdr list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (nreverse reverse-result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (defun paths-decode-directory-path (string &optional drop-empties)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 "Split STRING at path separators into a directory list.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
376 Non-\"\" components are converted into directory form.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 Otherwise, they are left alone."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (let* ((components (split-path string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (mapcar #'(lambda (component)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (if (string-equal "" component)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 component
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (file-name-as-directory component)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 components)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (if drop-empties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (paths-filter #'(lambda (component)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (null (string-equal "" component)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 directories)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 ;;; find-paths.el ends here