3:09 p.m.
This should fix the problem reported by Malcolm Purvis. I'll commit
sometime next week if nobody objects.
2005-01-08 Mike Sperber <mike(a)xemacs.org>
* packages.el (packages-find-installation-package-directories): Add.
* find-paths.el (paths-for-each-emacs-directory): Abstract FUNC
parameter out of `paths-find-emacs-directory'.
(paths-find-emacs-directories): Add.
(paths-find-emacs-directory): Redefine in terms of
`paths-for-each-emacs-directory'.
(paths-for-each-site-directory): Add.
(paths-find-site-directory): Redefine in terms of
`paths-for-each-site-directory'.
(paths-find-site-directories): Add.
(paths-for-each-version-directory): Add.
(paths-find-version-directory): Redefine in terms of
`paths-for-each-version-directory'.
(paths-find-version-directories): Add.
Index: lisp/packages.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/packages.el,v
retrieving revision 1.51
diff -u -r1.51 packages.el
--- lisp/packages.el 27 Dec 2004 12:25:14 -0000 1.51
+++ lisp/packages.el 8 Jan 2005 11:46:08 -0000
＠＠ -376,11 +376,8 ＠＠
(defun packages-find-installation-package-directories (roots)
"Find the package directories in the XEmacs installation.
ROOTS is a list of installation roots."
- (let ((version-directory (paths-find-version-directory roots "" nil nil t))
- (site-directory (paths-find-site-directory roots "")))
- (paths-uniq-append
- (and version-directory (list version-directory))
- (and site-directory (list site-directory)))))
+ (paths-uniq-append (paths-find-version-directories roots "" nil nil t)
+ (paths-find-site-directories roots "")))
(defun packages-find-package-hierarchies (package-directories &optional default)
"Find package hierarchies in a list of package directories.
Index: lisp/find-paths.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/find-paths.el,v
retrieving revision 1.28
diff -u -r1.28 find-paths.el
--- lisp/find-paths.el 27 Dec 2004 12:25:14 -0000 1.28
+++ lisp/find-paths.el 8 Jan 2005 11:46:08 -0000
＠＠ -136,9 +136,13 ＠＠
suffix
base))))
-(defun paths-find-emacs-directory (roots suffix base
- &optional envvar default keep-suffix)
- "Find a directory in the XEmacs hierarchy.
+
+(defun paths-for-each-emacs-directory (func
+ roots suffix base
+ &optional envvar default keep-suffix)
+ "Iterate over directories in the XEmacs hierarchy.
+FUNC is a function that called for each directory, with the directory
+as the only argument.
ROOTS must be a list of installation roots.
SUFFIX is the subdirectory from there.
BASE is the base to look for.
＠＠ -152,20 +156,56 ＠＠
(if (and preferred-value
(paths-file-readable-directory-p preferred-value))
(file-name-as-directory preferred-value)
- (catch 'gotcha
- (while roots
- (let* ((root (car roots))
- ;; installed
- (path (paths-construct-emacs-directory root suffix base)))
- (if (paths-file-readable-directory-p path)
- (throw 'gotcha path)
- ;; in-place
- (if (null keep-suffix)
- (let ((path (paths-construct-emacs-directory root "" base)))
- (if (paths-file-readable-directory-p path)
- (throw 'gotcha path))))))
- (setq roots (cdr roots)))
- nil))))
+ (while roots
+ (let* ((root (car roots))
+ ;; installed
+ (path (paths-construct-emacs-directory root suffix base)))
+ (if (paths-file-readable-directory-p path)
+ (funcall func path)
+ ;; in-place
+ (if (null keep-suffix)
+ (let ((path (paths-construct-emacs-directory root "" base)))
+ (if (paths-file-readable-directory-p path)
+ (funcall func path))))))
+ (setq roots (cdr roots))))))
+
+(defun paths-find-emacs-directories (roots
+ suffix base
+ &optional envvar default keep-suffix)
+ "Find a list of directories in the XEmacs hierarchy.
+ROOTS must be a list of installation roots.
+SUFFIX is the subdirectory from there.
+BASE is the base to look for.
+ENVVAR is the name of the environment variable that might also
+specify the directory.
+DEFAULT is the preferred value.
+If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
+the directory."
+ (let ((l '()))
+ (paths-for-each-emacs-directory #'(lambda (dir)
+ (setq l (cons dir l)))
+ roots
+ suffix base
+ envvar default keep-suffix)
+ (reverse l)))
+
+(defun paths-find-emacs-directory (roots suffix base
+ &optional envvar default keep-suffix)
+ "Find a directory in the XEmacs hierarchy.
+ROOTS must be a list of installation roots.
+SUFFIX is the subdirectory from there.
+BASE is the base to look for.
+ENVVAR is the name of the environment variable that might also
+specify the directory.
+DEFAULT is the preferred value.
+If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
+the directory."
+ (catch 'gotcha
+ (paths-for-each-emacs-directory #'(lambda (dir)
+ (throw 'gotcha dir))
+ roots
+ suffix base
+ envvar default keep-suffix)))
(defun paths-find-site-directory (roots base &optional envvar default)
"Find a site-specific directory in the XEmacs hierarchy.
＠＠ -182,10 +222,24 ＠＠
base
envvar default))
+(defun paths-find-site-directories (roots base &optional envvar default)
+ "Find a list of site-specific directories in the XEmacs hierarchy.
+ROOT must be a an installation root.
+BASE is the base to look for.
+ENVVAR is the name of the environment variable that might also
+specify the directory.
+DEFAULT is the preferred value."
+ (paths-find-emacs-directories roots
+ (file-name-as-directory
+ (paths-construct-path (list
+ "lib"
+ emacs-program-name)))
+ base
+ envvar default))
+
(defun paths-find-version-directory (roots base
&optional envvar default enforce-version)
"Find a version-specific directory in the XEmacs hierarchy.
-
ROOT must be a an installation root.
BASE is the base to look for.
ENVVAR is the name of the environment variable that might also
＠＠ -200,6 +254,24 ＠＠
base
envvar default
enforce-version))
+
+(defun paths-find-version-directories (roots base
+ &optional envvar default enforce-version)
+ "Find a list of version-specific directories in the XEmacs hierarchy.
+ROOT must be a an installation root.
+BASE is the base to look for.
+ENVVAR is the name of the environment variable that might also
+specify the directory.
+DEFAULT is the preferred value.
+If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
+ (paths-find-emacs-directories roots
+ (file-name-as-directory
+ (paths-construct-path
+ (list "lib"
+ (construct-emacs-version-name))))
+ base
+ envvar default
+ enforce-version))
(defun paths-find-architecture-directory (roots base &optional envvar default)
"Find an architecture-specific directory in the XEmacs hierarchy.
--
Cheers =8-} Mike
Friede, Völkerverständigung und überhaupt blabla