X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Ffind-paths.el;h=cc1620178ce51540e6c79a4674b6cea4f4a460bc;hp=8ecbcc1d04f7379fa48dd2eb44e670b20314ab9f;hb=34360e98c9689b0a7eedab93e14df13281141bbd;hpb=72a705551741d6f85a40eea486c222bac482d8dc

diff --git a/lisp/find-paths.el b/lisp/find-paths.el
index 8ecbcc1..cc16201 100644
--- a/lisp/find-paths.el
+++ b/lisp/find-paths.el
@@ -66,9 +66,8 @@ from the search."
 	    (let ((raw-entries
 		   (if (equal 0 max-depth)
 		       '()
-		       (directory-files directory nil "^[^.-]")))
+		     (directory-files directory nil "^[^.-]")))
 		  (reverse-dirs '()))
-
 	      (while raw-entries
 		(if (null (string-match exclude-regexp (car raw-entries)))
 		    (setq reverse-dirs
@@ -106,10 +105,14 @@ from the search."
 								"lib"
 								emacs-program-name)))
    ;; in-place or windows-nt
-   (and 
+   (and
     (paths-file-readable-directory-p (paths-construct-path (list directory "lisp")))
     (paths-file-readable-directory-p (paths-construct-path (list directory "etc"))))))
 
+(defun paths-root-in-place-p (root)
+  "Check if ROOT is an in-place installation root for XEmacs."
+  (paths-file-readable-directory-p (paths-construct-path (list root "lisp"))))
+
 (defun paths-chase-symlink (file-name)
   "Chase a symlink until the bitter end."
       (let ((maybe-symlink (file-symlink-p file-name)))
@@ -153,14 +156,15 @@ to EXPAND-FILE-NAME."
 (defun paths-construct-emacs-directory (root suffix base)
   "Construct a directory name within the XEmacs hierarchy."
   (file-name-as-directory
-   (expand-file-name 
+   (expand-file-name
     (concat
      (file-name-as-directory root)
      suffix
      base))))
 
 (defun paths-find-emacs-directory (roots suffix base
-				   &optional envvar default keep-suffix)
+				   &optional envvar default keep-suffix
+				   	     in-place-external)
   "Find a directory in the XEmacs hierarchy.
 ROOTS must be a list of installation roots.
 SUFFIX is the subdirectory from there.
@@ -169,7 +173,9 @@ 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."
+the directory.
+If IN-PLACE-EXTERNAL is non-nil, the directory might be found outside
+an in-place root-hierarchy."
   (let ((preferred-value (or (and envvar (getenv envvar))
 			     default)))
     (if (and preferred-value
@@ -177,28 +183,39 @@ the directory."
 	(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))))))
+	  (let ((root (car roots)))
+	    ;; installed
+	    (let ((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))))
+	    (if (and in-place-external
+		     (paths-root-in-place-p root))
+		(let ((path (paths-construct-emacs-directory
+			     (paths-construct-path '("..") root)
+			     "" base)))
+		  (if (paths-file-readable-directory-p path)
+		      (throw 'gotcha path)))))
 	  (setq roots (cdr roots)))
 	nil))))
 
-(defun paths-find-site-directory (roots base &optional envvar default)
-  "Find a site-specific directory in the XEmacs hierarchy."
+(defun paths-find-site-directory (roots base &optional envvar default in-place-external)
+  "Find a site-specific directory in the XEmacs hierarchy.
+If IN-PLACE-EXTERNAL is non-nil, the directory might be found outside
+an in-place root-hierarchy."
   (paths-find-emacs-directory roots
 			      (file-name-as-directory
 			       (paths-construct-path (list
 						      "lib"
 						      emacs-program-name)))
 			      base
-			      envvar default))
+			      envvar default
+			      nil
+			      in-place-external))
 
 (defun paths-find-version-directory (roots base
 				     &optional envvar default enforce-version)
@@ -219,13 +236,13 @@ If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
    ;; from more to less specific
    (paths-find-version-directory roots
 				 (concat base system-configuration)
-				 envvar)
+				 envvar default)
    (paths-find-version-directory roots
 				 base
 				 envvar)
    (paths-find-version-directory roots
 				 system-configuration
-				 envvar default)))
+				 envvar)))
 
 (defun construct-emacs-version-name ()
   "Construct the raw XEmacs version number."
@@ -236,7 +253,7 @@ If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
   (let ((reverse-directories '()))
     (while directories
       (if (paths-file-readable-directory-p (car directories))
-	  (setq reverse-directories 
+	  (setq reverse-directories
 		(cons (car directories)
 		      reverse-directories)))
       (setq directories (cdr directories)))
@@ -263,7 +280,7 @@ If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
 
 (defun paths-decode-directory-path (string &optional drop-empties)
   "Split STRING at path separators into a directory list.
-Non-\"\" comonents are converted into directory form.
+Non-\"\" components are converted into directory form.
 If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output.
 Otherwise, they are left alone."
   (let* ((components (split-path string))