changeset 2481:505a24c07ba9

[xemacs-hg @ 2005-01-15 15:17:32 by michaels] 2005-01-08 Mike Sperber <mike@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.
author michaels
date Sat, 15 Jan 2005 15:17:36 +0000
parents 6acae43a57f1
children 8130382f7727
files lisp/ChangeLog lisp/find-paths.el lisp/packages.el
diffstat 3 files changed, 157 insertions(+), 40 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri Jan 14 22:51:48 2005 +0000
+++ b/lisp/ChangeLog	Sat Jan 15 15:17:36 2005 +0000
@@ -1,3 +1,21 @@
+2005-01-08  Mike Sperber  <mike@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.
+
 2005-01-09  Adrian Aichner  <adrian@xemacs.org>
 
 	* dumped-lisp.el (preloaded-file-list): Fix typo in
--- a/lisp/find-paths.el	Fri Jan 14 22:51:48 2005 +0000
+++ b/lisp/find-paths.el	Sat Jan 15 15:17:36 2005 +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,74 @@
     (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-for-each-site-directory (func roots base &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.
+ENVVAR is the name of the environment variable that might also
+specify the directory.
+DEFAULT is the preferred value."
+  (paths-for-each-emacs-directory func
+				  roots
+				  (file-name-as-directory
+				   (paths-construct-path (list
+							  "lib"
+							  emacs-program-name)))
+				  base
+				  envvar default))
 
 (defun paths-find-site-directory (roots base &optional envvar default)
   "Find a site-specific directory in the XEmacs hierarchy.
@@ -174,32 +232,76 @@
 ENVVAR is the name of the environment variable that might also
 specify the directory.
 DEFAULT is the preferred value."
-  (paths-find-emacs-directory roots
-			      (file-name-as-directory
-			       (paths-construct-path (list
-						      "lib"
-						      emacs-program-name)))
-			      base
-			      envvar default))
+  (catch 'gotcha
+    (paths-for-each-site-directory #'(lambda (dir)
+				       (throw 'gotcha dir))
+				   roots base
+				   envvar default)))
 
-(defun paths-find-version-directory (roots base
-				     &optional envvar default enforce-version)
-  "Find a version-specific directory in the XEmacs hierarchy.
+(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."
+  (let ((l '()))
+    (paths-for-each-site-directory #'(lambda (dir)
+					(setq l (cons dir l)))
+				   roots base
+				   envvar default)
+    (reverse l)))
 
+(defun paths-for-each-version-directory (func roots base
+					 &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.
 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-directory roots
-			      (file-name-as-directory
-			       (paths-construct-path
-				(list "lib"
-				      (construct-emacs-version-name))))
-			      base
-			      envvar default
-			      enforce-version))
+  (paths-for-each-emacs-directory func
+				  roots
+				  (file-name-as-directory
+				   (paths-construct-path
+				    (list "lib"
+					  (construct-emacs-version-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
+specify the directory.
+DEFAULT is the preferred value.
+If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
+  (catch 'gotcha
+    (paths-for-each-version-directory #'(lambda (dir)
+					  (throw 'gotcha dir))
+				      roots base
+				      envvar default)))
+
+(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."
+  (let ((l '()))
+    (paths-for-each-site-directory #'(lambda (dir)
+				       (setq l (cons dir l)))
+				   roots base
+				   envvar default)
+    (reverse l)))
 
 (defun paths-find-architecture-directory (roots base &optional envvar default)
   "Find an architecture-specific directory in the XEmacs hierarchy.
--- a/lisp/packages.el	Fri Jan 14 22:51:48 2005 +0000
+++ b/lisp/packages.el	Sat Jan 15 15:17:36 2005 +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.