diff lisp/find-paths.el @ 5118:e0db3c197671 ben-lisp-object

merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents 5da4cc7d5968
children 9c6ea1581159
line wrap: on
line diff
--- a/lisp/find-paths.el	Sat Dec 26 00:20:27 2009 -0600
+++ b/lisp/find-paths.el	Sat Dec 26 21:18:49 2009 -0600
@@ -126,7 +126,7 @@
 
 (defun paths-construct-emacs-directory (root suffix base)
   "Construct a directory name within the XEmacs hierarchy.
-ROOT must be a an installation root.
+ROOT must be an installation root.
 SUFFIX is the subdirectory from there.
 BASE is the base to look for."
   (file-name-as-directory
@@ -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,19 @@
     (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 &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.
-ROOT must be a an installation root.
-BASE is the base to look for.
+ROOTS must be a list of installation roots.
+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.
 DEFAULT is the preferred value."
@@ -220,45 +228,48 @@
 				  roots
 				  (file-name-as-directory
 				   (paths-construct-path (list
-							  "lib"
+							  (if arch-dependent-p "lib" "share")
 							  emacs-program-name)))
-				  base
+				  bases
 				  envvar default))
 
-(defun paths-find-site-directory (roots base &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.
-ROOT must be a an installation root.
-BASE is the base to look for.
+ROOTS must be a list of installation roots.
+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.
 DEFAULT is the preferred value."
   (catch 'gotcha
     (paths-for-each-site-directory #'(lambda (dir)
 				       (throw 'gotcha dir))
-				   roots base
+				   roots bases arch-dependent-p
 				   envvar default)))
 
-(defun paths-find-site-directories (roots base &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.
-ROOT must be a an installation root.
-BASE is the base to look for.
+ROOTS must be a list of installation roots.
+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.
 DEFAULT is the preferred value."
   (let ((l '()))
     (paths-for-each-site-directory #'(lambda (dir)
 					(setq l (cons dir l)))
-				   roots base
+				   roots bases arch-dependent-p
 				   envvar default)
     (reverse l)))
 
-(defun paths-for-each-version-directory (func roots base
+(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.
-ROOT must be a an installation root.
-BASE is the base to look for.
+ROOTS must be a list of installation roots.
+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.
 DEFAULT is the preferred value.
@@ -267,16 +278,17 @@
 				  roots
 				  (file-name-as-directory
 				   (paths-construct-path
-				    (list "lib"
+				    (list (if arch-dependent-p "lib" "share")
 					  (construct-emacs-version-name))))
-				  base
+				  bases
 				  envvar default))
 
-(defun paths-find-version-directory (roots base
+(defun paths-find-version-directory (roots bases arch-dependent-p
 				     &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.
+ROOTS must be a list of installation roots.
+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.
 DEFAULT is the preferred value.
@@ -284,44 +296,45 @@
   (catch 'gotcha
     (paths-for-each-version-directory #'(lambda (dir)
 					  (throw 'gotcha dir))
-				      roots base
+				      roots bases arch-dependent-p
 				      envvar default)))
 
-(defun paths-find-version-directories (roots base
+(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.
-ROOT must be a an installation root.
-BASE is the base to look for.
+ROOTS must be a list of installation roots.
+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.
 DEFAULT is the preferred value.
 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
   (let ((l '()))
-    (paths-for-each-site-directory #'(lambda (dir)
-				       (setq l (cons dir l)))
-				   roots base
-				   envvar default)
+    (paths-for-each-version-directory #'(lambda (dir)
+					  (setq l (cons dir l)))
+				      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.
-ROOT must be a an installation root.
-BASE is the base to look for.
+ROOTS must be a list of installation roots.
+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))
-				 envvar default)
-   (paths-find-version-directory roots
-				 base
-				 envvar)
-   (paths-find-version-directory roots
-				 system-configuration
-				 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."