"Stephen J. Turnbull" <stephen(a)xemacs.org> writes:
`paths-find-module-directory' uses
`paths-find-architecture-directory'.
Unfortunately, `paths-find-architecture-directory' does a breadth-
first search across roots, looking for architecture-specific
directories first, so it will definitely find
"/usr/local/xemacs/xemacs-21.5-b27/powerpc-apple-darwin8.8.0/modules"
before it finds "~/Software/XEmacs/git-staging/+build/modules" even
though I'm running in-place.
The attached patch fixes this. Will commit Thursday if nobody objects.
2007-08-07 Mike Sperber <mike(a)xemacs.org>
* setup-paths.el (paths-find-doc-directory):
(paths-find-exec-directory):
(paths-find-lisp-directory):
(paths-find-mule-lisp-directory):
(paths-construct-info-path):
(paths-find-data-directory):
* packages.el (packages-find-installation-package-directories):
* find-paths.el (paths-for-each-emacs-directory):
(paths-find-emacs-directories):
(paths-find-emacs-directory):
(paths-for-each-site-directory):
(paths-find-site-directory):
(paths-find-site-directories):
(paths-for-each-version-directory):
(paths-find-version-directories):
(paths-find-version-directory): Generalize to multiple bases.
(paths-find-architecture-directory): Use above to give roots
precedence over bases. This means, for example, that a directory
in an in-place root will always get precedence over an installed
root.
--
Cheers =8-} Mike
Friede, Völkerverständigung und überhaupt blabla
Index: lisp/setup-paths.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/setup-paths.el,v
retrieving revision 1.24
diff -u -r1.24 setup-paths.el
--- lisp/setup-paths.el 2 Aug 2007 06:33:59 -0000 1.24
+++ lisp/setup-paths.el 7 Aug 2007 15:20:39 -0000
@@ -158,21 +158,21 @@
(defun paths-find-site-lisp-directory (roots)
"Find the site Lisp directory of the XEmacs hierarchy.
ROOTS is a list of installation roots."
- (paths-find-site-directory roots "site-lisp"
+ (paths-find-site-directory roots (list "site-lisp")
nil nil
configure-site-directory))
(defun paths-find-site-module-directory (roots)
"Find the site modules directory of the XEmacs hierarchy.
ROOTS is a list of installation roots."
- (paths-find-site-directory roots "site-modules"
+ (paths-find-site-directory roots (list "site-modules")
t nil
configure-site-module-directory))
(defun paths-find-lisp-directory (roots)
"Find the main Lisp directory of the XEmacs hierarchy.
ROOTS is a list of installation roots."
- (paths-find-version-directory roots "lisp"
+ (paths-find-version-directory roots (list "lisp")
nil nil
configure-lisp-directory))
@@ -186,14 +186,14 @@
(paths-construct-path (list lisp-directory "mule")))))
(if (paths-file-readable-directory-p guess)
guess
- (paths-find-version-directory roots "mule-lisp"
+ (paths-find-version-directory roots (list "mule-lisp")
nil nil
configure-mule-lisp-directory)))))
(defun paths-find-module-directory (roots)
"Find the main modules directory of the XEmacs hierarchy.
ROOTS is a list of installation roots."
- (paths-find-architecture-directory roots "modules"
+ (paths-find-architecture-directory roots (list "modules")
nil configure-module-directory))
(defun paths-construct-load-path
@@ -264,7 +264,7 @@
(paths-uniq-append
(append
(let ((info-directory
- (paths-find-version-directory roots "info"
+ (paths-find-version-directory roots (list "info")
nil nil
configure-info-directory)))
(and info-directory
@@ -282,12 +282,12 @@
(defun paths-find-doc-directory (roots)
"Find the documentation directory.
ROOTS is the list of installation roots."
- (paths-find-architecture-directory roots "lib-src" nil
configure-doc-directory))
+ (paths-find-architecture-directory roots (list "lib-src") nil
configure-doc-directory))
(defun paths-find-exec-directory (roots)
"Find the binary directory.
ROOTS is the list of installation roots."
- (paths-find-architecture-directory roots "lib-src"
+ (paths-find-architecture-directory roots (list "lib-src")
nil configure-exec-directory))
(defun paths-construct-exec-path (roots exec-directory
@@ -319,7 +319,7 @@
(defun paths-find-data-directory (roots)
"Find the data directory.
ROOTS is the list of installation roots."
- (paths-find-version-directory roots "etc" nil "EMACSDATA"
configure-data-directory))
+ (paths-find-version-directory roots (list "etc") nil "EMACSDATA"
configure-data-directory))
(defun paths-construct-data-directory-list (data-directory
early-package-hierarchies
Index: lisp/find-paths.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/find-paths.el,v
retrieving revision 1.31
diff -u -r1.31 find-paths.el
--- lisp/find-paths.el 2 Aug 2007 06:33:58 -0000 1.31
+++ lisp/find-paths.el 7 Aug 2007 15:20:39 -0000
@@ -138,14 +138,14 @@
(defun paths-for-each-emacs-directory (func
- roots suffix base
+ roots suffix bases
&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.
+BASEA is a list of possible bases to look for.
ENVVAR is the name of the environment variable that might also
specify the directory.
DEFAULT is the preferred value.
@@ -157,25 +157,29 @@
(paths-file-readable-directory-p preferred-value))
(file-name-as-directory preferred-value)
(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))))))
+ (let ((root (car roots))
+ (bases bases))
+ (while bases
+ (let* ((base (car bases))
+ ;; 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 bases (cdr bases))))
(setq roots (cdr roots))))))
(defun paths-find-emacs-directories (roots
- suffix base
+ suffix bases
&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.
+BASES is a list of bases to look for.
ENVVAR is the name of the environment variable that might also
specify the directory.
DEFAULT is the preferred value.
@@ -185,16 +189,16 @@
(paths-for-each-emacs-directory #'(lambda (dir)
(setq l (cons dir l)))
roots
- suffix base
+ suffix bases
envvar default keep-suffix)
(reverse l)))
-(defun paths-find-emacs-directory (roots suffix base
+(defun paths-find-emacs-directory (roots suffix bases
&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.
+BASES is a list of possible bases to look for.
ENVVAR is the name of the environment variable that might also
specify the directory.
DEFAULT is the preferred value.
@@ -204,15 +208,18 @@
(paths-for-each-emacs-directory #'(lambda (dir)
(throw 'gotcha dir))
roots
- suffix base
+ suffix bases
envvar default keep-suffix)))
-(defun paths-for-each-site-directory (func roots base arch-dependent-p &optional
envvar default)
+(defun paths-for-each-site-directory (func
+ roots bases
+ arch-dependent-p
+ &optional envvar default)
"Iterate over the site-specific 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.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
@@ -223,13 +230,13 @@
(paths-construct-path (list
(if arch-dependent-p "lib" "share")
emacs-program-name)))
- base
+ bases
envvar default))
-(defun paths-find-site-directory (roots base arch-dependent-p &optional envvar
default)
+(defun paths-find-site-directory (roots bases arch-dependent-p &optional envvar
default)
"Find a site-specific directory in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
@@ -237,13 +244,13 @@
(catch 'gotcha
(paths-for-each-site-directory #'(lambda (dir)
(throw 'gotcha dir))
- roots base arch-dependent-p
+ roots bases arch-dependent-p
envvar default)))
-(defun paths-find-site-directories (roots base arch-dependent-p &optional envvar
default)
+(defun paths-find-site-directories (roots bases arch-dependent-p &optional envvar
default)
"Find a list of site-specific directories in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
@@ -251,17 +258,17 @@
(let ((l '()))
(paths-for-each-site-directory #'(lambda (dir)
(setq l (cons dir l)))
- roots base arch-dependent-p
+ roots bases arch-dependent-p
envvar default)
(reverse l)))
-(defun paths-for-each-version-directory (func roots base arch-dependent-p
+(defun paths-for-each-version-directory (func roots bases arch-dependent-p
&optional envvar default enforce-version)
"Iterate over version-specific 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.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
@@ -273,14 +280,14 @@
(paths-construct-path
(list (if arch-dependent-p "lib" "share")
(construct-emacs-version-name))))
- base
+ bases
envvar default))
-(defun paths-find-version-directory (roots base arch-dependent-p
+(defun paths-find-version-directory (roots bases arch-dependent-p
&optional envvar default enforce-version)
"Find a version-specific directory in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
@@ -289,14 +296,14 @@
(catch 'gotcha
(paths-for-each-version-directory #'(lambda (dir)
(throw 'gotcha dir))
- roots base arch-dependent-p
+ roots bases arch-dependent-p
envvar default)))
-(defun paths-find-version-directories (roots base arch-dependent-p
+(defun paths-find-version-directories (roots bases arch-dependent-p
&optional envvar default enforce-version)
"Find a list of version-specific directories in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ARCH-DEPENDENT-P says whether the file is architecture-specific.
ENVVAR is the name of the environment variable that might also
specify the directory.
@@ -305,30 +312,29 @@
(let ((l '()))
(paths-for-each-version-directory #'(lambda (dir)
(setq l (cons dir l)))
- roots base arch-dependent-p
+ roots bases arch-dependent-p
envvar default)
(reverse l)))
-(defun paths-find-architecture-directory (roots base &optional envvar default)
+(defun paths-find-architecture-directory (roots bases &optional envvar default)
"Find an architecture-specific directory in the XEmacs hierarchy.
ROOTS must be a list of installation roots.
-BASE is the base to look for.
+BASES is a list of possible bases to look for.
ENVVAR is the name of the environment variable that might also
specify the directory.
DEFAULT is the preferred value."
- (or
- ;; from more to less specific
- (paths-find-version-directory roots
- (paths-construct-path
- (list system-configuration base))
- t
- envvar default)
- (paths-find-version-directory roots
- base t
- envvar)
- (paths-find-version-directory roots
- system-configuration t
- envvar)))
+ (paths-find-version-directory roots
+ ;; from more to less specific
+ (append
+ (mapcar
+ #'(lambda (base)
+ (paths-construct-path
+ (list system-configuration base)))
+ bases)
+ bases
+ (list system-configuration))
+ t
+ envvar default))
(defun construct-emacs-version-name ()
"Construct a string from the raw XEmacs version number."
Index: lisp/packages.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/packages.el,v
retrieving revision 1.56
diff -u -r1.56 packages.el
--- lisp/packages.el 2 Aug 2007 06:33:58 -0000 1.56
+++ lisp/packages.el 7 Aug 2007 15:20:39 -0000
@@ -386,8 +386,8 @@
(defun packages-find-installation-package-directories (roots)
"Find the package directories in the XEmacs installation.
ROOTS is a list of installation roots."
- (paths-uniq-append (paths-find-version-directories roots "" nil nil nil t)
- (paths-find-site-directories roots "" nil)))
+ (paths-uniq-append (paths-find-version-directories roots (list "") nil nil
nil t)
+ (paths-find-site-directories roots (list "") nil)))
(defun packages-find-package-hierarchies (package-directories &optional envvar
default)
"Find package hierarchies in a list of package directories.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches