Mercurial > hg > xemacs-beta

changeset 4108:5da4cc7d5968

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2007-08-09 06:22:51 by michaels] 2007-08-07 Mike Sperber <mike@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.
author michaels
date Thu, 09 Aug 2007 06:22:53 +0000
parents d3a3bc2726d6
children a665c60d5279
files lisp/ChangeLog lisp/find-paths.el lisp/packages.el lisp/setup-paths.el
diffstat 4 files changed, 91 insertions(+), 62 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Aug 08 21:51:18 2007 +0000
+++ b/lisp/ChangeLog	Thu Aug 09 06:22:53 2007 +0000
@@ -1,3 +1,26 @@
+2007-08-07  Mike Sperber  <mike@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.
+	
 2007-08-06  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* mule/mule-coding.el (make-8-bit-coding-system): 
--- a/lisp/find-paths.el	Wed Aug 08 21:51:18 2007 +0000
+++ b/lisp/find-paths.el	Thu Aug 09 06:22:53 2007 +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."
--- a/lisp/packages.el	Wed Aug 08 21:51:18 2007 +0000
+++ b/lisp/packages.el	Thu Aug 09 06:22:53 2007 +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.
--- a/lisp/setup-paths.el	Wed Aug 08 21:51:18 2007 +0000
+++ b/lisp/setup-paths.el	Thu Aug 09 06:22:53 2007 +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