--- a/lisp/setup-paths.el	Mon Aug 13 10:25:39 2007 +0200
+++ b/lisp/setup-paths.el	Mon Aug 13 10:26:29 2007 +0200
@@ -31,322 +31,51 @@
 
 ;; This file is dumped with XEmacs.
 
-;; This file contains the machinery necessary to find the various
-;; paths into the XEmacs hierarchy.
-
-(defvar paths-version-control-bases '("RCS" "CVS" "SCCS")
-  "File bases associated with version control.")
-
-(defun paths-find-recursive-path (directories &optional exclude)
-  "Return a list of the directory hierarchy underneath DIRECTORIES.
-The returned list is sorted by pre-order and lexicographically."
-  (let ((path '()))
-    (while directories
-      (let ((directory (file-name-as-directory
-			(expand-file-name
-			 (car directories)))))
-	(if (file-directory-p directory)
-	    (let ((raw-dirs (directory-files directory nil "^[^-.]" nil 'dirs-only))
-		  (reverse-dirs '()))
-
-	      (while raw-dirs
-		(if (null (member (car raw-dirs) exclude))
-		    (setq reverse-dirs
-			  (cons (expand-file-name (car raw-dirs) directory)
-				reverse-dirs)))
-		(setq raw-dirs (cdr raw-dirs)))
-
-	      (let ((sub-path
-		     (paths-find-recursive-path (reverse reverse-dirs) exclude)))
-		(setq path (nconc path
-				  (list directory)
-				  sub-path))))))
-      (setq directories (cdr directories)))
-    path))
-
-(defun paths-find-recursive-load-path (directories)
-  "Construct a recursive load path underneath DIRECTORIES."
-  (paths-find-recursive-path directories paths-version-control-bases))
-
-(defun paths-emacs-root-p (directory)
-  "Check if DIRECTORY is a plausible installation root for XEmacs."
-  (or
-   ;; installed
-   (and (boundp 'emacs-version)
-	(file-directory-p
-	 (concat directory "lib/xemacs-" (construct-emacs-version))))
-   ;; in-place
-   (and 
-    (file-directory-p (concat directory "lib-src"))
-    (file-directory-p (concat directory "lisp"))
-    (file-directory-p (concat directory "src")))))
+;; This file describes and constructs the various paths into the
+;; XEmacs hierarchy from a global viewpoint.
 
-(defun paths-find-emacs-root
-  (invocation-directory invocation-name)
-  "Find the run-time root of XEmacs."
-  (let ((maybe-root-1 (file-name-as-directory
-		       (expand-file-name ".." invocation-directory)))
-	(maybe-root-2 (file-name-as-directory
-		       (expand-file-name "../.." invocation-directory))))
-    (cond
-     ((paths-emacs-root-p maybe-root-1)
-      maybe-root-1)
-     ((paths-emacs-root-p maybe-root-2)
-      maybe-root-2)
-     (t
-      (let ((maybe-symlink (file-symlink-p (concat invocation-directory
-						   invocation-name))))
-	(if maybe-symlink
-	    (let ((directory (file-name-directory maybe-symlink)))
-	      (paths-find-emacs-root directory invocation-name))
-	  nil))))))
-
-(defun paths-construct-emacs-directory (root suffix base)
-  "Construct a directory name within the XEmacs hierarchy."
-  (file-name-as-directory
-   (expand-file-name 
-    (concat
-     (file-name-as-directory root)
-     suffix
-     base))))
-
-(defun paths-find-emacs-directory (roots suffix base &optional envvar default)
-  "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 a fall-back value."
-  (let ((envvar-value (and envvar (getenv envvar))))
-    (if (and envvar-value
-	     (file-directory-p envvar-value))
-	(file-name-as-directory envvar-value)
-      (catch 'gotcha
-	(while roots
-	  (let* ((root (car roots))
-		 (path (paths-construct-emacs-directory root suffix base)))
-	    ;; installed
-	    (if (file-directory-p path)
-		(throw 'gotcha path)
-	      (let ((path (paths-construct-emacs-directory root "" base)))
-		;; in-place
-		(if (file-directory-p path)
-		    (throw 'gotcha path)))))
-	  (setq roots (cdr roots)))
-	(if (and default
-		 (file-directory-p default))
-	    (file-name-as-directory default)
-	  nil)))))
-
-(defun paths-find-site-directory (roots base &optional envvar default)
-  "Find a site-specific directory in the XEmacs hierarchy."
-  (paths-find-emacs-directory roots "lib/xemacs/" base envvar default))
-
-(defun paths-find-version-directory (roots base &optional envvar default)
-  "Find a version-specific directory in the XEmacs hierarchy."
-  (paths-find-emacs-directory roots
-			      (concat "lib/xemacs-" (construct-emacs-version) "/")
-			      base
-			      envvar default))
-
-(defun paths-find-architecture-directory (roots base &optional envvar default)
-  "Find an architecture-specific directory in the XEmacs hierarchy."
-  (or
-   ;; from more to less specific
-   (paths-find-version-directory roots
-				 (concat base system-configuration)
-				 envvar default)
-   (paths-find-version-directory roots
-				 system-configuration
-				 envvar default)
-   (paths-find-version-directory roots
-				 base
-				 envvar default)))
-  
-(defvar paths-path-emacs-version nil
-  "Emacs version as it appears in paths.")
+;; It requires find-paths.el and packages.el.
+
+;;; Code:
 
-(defun construct-emacs-version ()
-  "Construct the raw version number of XEmacs in the form XX.XX."
-  ;; emacs-version isn't available early, but we really don't care then
-  (if (null (boundp 'emacs-version))
-      ""
-  (or paths-path-emacs-version		; cache
-      (progn
-	(string-match "\\`[^0-9]*\\([0-9]+\\.[0-9]+\\)" emacs-version)
-	(let ((version (substring emacs-version
-				  (match-beginning 1) (match-end 1))))
-	  (if (string-match "(beta *\\([0-9]+\\))" emacs-version)
-	      (setq version (concat version
-				    "-b"
-				    (substring emacs-version
-					       (match-beginning 1) (match-end 1)))))
-	  (setq paths-path-emacs-version version)
-	  version)))))
-  
-(defun paths-find-emacs-path (roots suffix base &optional envvar default)
-  "Find a path 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 path.
-DEFAULT is a fall-back value."
-  (let ((envvar-value (and envvar (getenv envvar))))
-    (if (and (fboundp 'parse-colon-path) envvar-value)
-	(parse-colon-path envvar-value)
-      (let ((directory (paths-find-emacs-directory roots base suffix)))
-	(if (and directory (file-directory-p directory))
-	    (list directory)
-	  (paths-directories-which-exist default))))))
-
-(defun paths-directories-which-exist (directories)
-  "Return the directories among DIRECTORIES."
-  (let ((reverse-directories '()))
-    (while directories
-      (if (file-directory-p (car directories))
-	  (setq reverse-directories 
-		(cons (car directories)
-		      reverse-directories)))
-      (setq directories (cdr directories)))
-    (reverse reverse-directories)))
-
-(defun paths-find-site-path (roots base &optional envvar default)
-  "Find a path underneath the site hierarchy."
-  (paths-find-emacs-path roots "lib/xemacs/" base envvar default))
-
-(defun paths-find-version-path (roots base &optional envvar default)
-  "Find a path underneath the site hierarchy."
-  (paths-find-emacs-path roots
-			 (concat "lib/xemacs-" (construct-emacs-version) "/")
-			 base
-			 envvar default))
-		   
-; Packages are special ...
-
-(defun paths-find-package-path (roots)
-  "Construct the package path underneath installation roots ROOTS."
-  (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
-    (if (and (fboundp 'parse-colon-path) envvar-value)
-	(parse-colon-path envvar-value)
-      (let ((base-directory (paths-find-site-directory roots "packages")))
-	(if base-directory
-	    (let ((mule-directory (and (featurep 'mule)
-				       (paths-find-site-directory roots
-								  "mule-packages"))))
-	      (append '("~/.xemacs/")
-		      '(nil)
-		      (and mule-directory
-			   (list mule-directory))
-		      (list base-directory)))
-	  configure-package-path)))))
+(defun paths-find-site-lisp-directory (roots)
+  "Find the site Lisp directory of the XEmacs hierarchy."
+  (paths-find-site-directory roots "site-lisp"
+			     nil
+			     configure-site-directory))
 
-(defvar paths-package-special-bases '("etc" "info" "lisp" "lib-src" "bin")
-  "Special subdirectories of packages.")
-
-(defun paths-find-packages-in-directories (directories)
-  "Find all packages underneath directories in DIRECTORIES."
-  (paths-find-recursive-path directories
-			     (append paths-version-control-bases
-				     paths-package-special-bases)))
-
-(defun paths-split-path (path)
-  "Split PATH at NIL, return pair with two components.
-The second component is shared with PATH."
-  (let ((reverse-early '()))
-    (while (and path (null (null (car path))))
-      (setq reverse-early (cons (car path) reverse-early))
-      (setq path (cdr path)))
-    (if (null path)
-	(cons nil path)
-      (cons (reverse reverse-early) (cdr path)))))
-
-(defun paths-find-packages (package-path)
-  "Search for all packages in PACKAGE-PATH.
-PACKAGE-PATH may distinguish (by NIL-separation) between early
-and late packages.
-This returns (CONS EARLY-PACKAGES LATE-PACKAGES)."
-  (let* ((stuff (paths-split-path package-path))
-	 (early (car stuff))
-	 (late (cdr stuff)))
-    (cons (paths-find-packages-in-directories early)
-	  (paths-find-packages-in-directories late))))
+(defun paths-find-lisp-directory (roots)
+  "Find the main Lisp directory of the XEmacs hierarchy."
+  (paths-find-version-directory roots "lisp"
+				nil
+				configure-lisp-directory))
 
-(defun paths-find-package-library-path (packages suffixes)
-  "Construct a path into a component of the packages hierarchy.
-PACKAGES is a list of package directories.
-SUFFIXES is a list of names of package subdirectories to look for."
-  (let ((directories
-	 (apply
-	  #'append
-	  (mapcar #'(lambda (package)
-		      (mapcar #'(lambda (suffix)
-				  (concat package suffix))
-			      suffixes))
-		  packages))))
-    (paths-directories-which-exist directories)))
-
-(defun paths-find-package-load-path (packages)
-  "Construct the load-path component for packages.
-PACKAGES is a list of package directories."
-  (paths-find-recursive-load-path
-   (paths-find-package-library-path packages '("lisp/"))))
-
-(defun paths-find-package-exec-path (packages)
-  (paths-find-package-library-path packages
-				   (list (concat "bin/" system-configuration "/")
-					 "lib-src/")))
-
-(defun paths-find-package-info-path (packages)
-  (paths-find-package-library-path packages '("info/")))
-
-(defun paths-find-package-data-path (packages)
-  (paths-find-package-library-path packages '("etc/")))
-
-(defun paths-find-emacs-roots (invocation-directory
-			       invocation-name)
-  "Find all plausible installation roots for XEmacs."
-  (let ((invocation-root
-	 (paths-find-emacs-root invocation-directory invocation-name))
-	(installation-root
-	 (if (and configure-prefix-directory
-		  (file-directory-p configure-prefix-directory))
-	     configure-prefix-directory)))
-    (append (and invocation-root
-		 (list invocation-root))
-	    (and installation-root
-		 (list installation-root)))))
-
-(defun paths-find-load-path (roots early-package-load-path late-package-load-path)
+(defun paths-construct-load-path
+  (roots early-package-load-path late-package-load-path
+	 &optional inhibit-site-lisp)
   "Construct the load path."
   (let ((envvar-value (getenv "EMACSLOADPATH")))
-    (if (and (fboundp 'parse-colon-path) envvar-value)
-	(parse-colon-path envvar-value)
+    (if envvar-value
+	(decode-path-internal envvar-value)
       (let* ((site-lisp-directory
-	      (and allow-site-lisp
-		   (paths-find-site-directory roots "site-lisp"
-					      nil
-					      configure-site-directory)))
+	      (and (null inhibit-site-lisp)
+		   (paths-find-site-lisp-directory roots)))
 	     (site-lisp-load-path
 	      (and site-lisp-directory
 		   (paths-find-recursive-load-path (list site-lisp-directory))))
-	     (lisp-directory
-	      (paths-find-version-directory roots "lisp"
-					    nil
-					    configure-lisp-directory))
+	     (lisp-directory (paths-find-lisp-directory roots))
 	     (lisp-load-path
 	      (paths-find-recursive-load-path (list lisp-directory))))
-	(nconc early-package-load-path
-	       site-lisp-load-path
-	       late-package-load-path
-	       lisp-load-path)))))
+	(append early-package-load-path
+		site-lisp-load-path
+		late-package-load-path
+		lisp-load-path)))))
 
-(defun paths-find-info-path (roots early-packages late-packages)
+(defun paths-construct-info-path (roots early-packages late-packages)
   "Construct the info path."
   (append
-   (paths-find-package-info-path early-packages)
-   (paths-find-package-info-path late-packages)
+   (packages-find-package-info-path early-packages)
+   (packages-find-package-info-path late-packages)
    (let ((info-directory
 	  (paths-find-version-directory roots "info"
 					nil
@@ -357,8 +86,8 @@
      (and info-directory
 	  (list info-directory)))
    (let ((info-path-envval (getenv "INFOPATH")))
-     (if (and (fboundp 'parse-colon-path) info-path-envval)
-	 (parse-colon-path info-path-envval)))))
+     (if info-path-envval
+	 (decode-path-internal info-path-envval)))))
 
 (defun paths-find-doc-directory (roots)
   "Find the documentation directory."
@@ -383,17 +112,17 @@
   "Find the binary directory."
   (paths-find-architecture-directory roots "lib-src"))
 
-(defun paths-find-exec-path (roots exec-directory early-packages late-packages)
+(defun paths-construct-exec-path (roots exec-directory early-packages late-packages)
   "Find the binary path."
   (append
    (let ((path-envval (getenv "PATH")))
-     (and (fboundp 'parse-colon-path) path-envval
-	  (parse-colon-path path-envval)))
-   (paths-find-package-exec-path early-packages)
-   (paths-find-package-exec-path late-packages)
+     (if path-envval
+	 (decode-path-internal path-envval)))
+   (packages-find-package-exec-path early-packages)
+   (packages-find-package-exec-path late-packages)
    (let ((emacspath-envval (getenv "EMACSPATH")))
-     (if (and (fboundp 'parse-colon-path) emacspath-envval)
-	 (parse-colon-path path-envval)
+     (if emacspath-envval
+	 (decode-path-internal emacspath-envval)
        (paths-directories-which-exist configure-exec-path)))
    (and exec-directory
 	(list exec-directory))))
@@ -402,132 +131,11 @@
   "Find the data directory."
   (paths-find-version-directory roots "etc" "EMACSDATA" configure-data-directory))
 
-(defun paths-find-data-directory-list (data-directory early-packages late-packages)
+(defun paths-construct-data-directory-list (data-directory early-packages late-packages)
   "Find the data path."
   (append
-   (paths-find-package-data-path early-packages)
-   (paths-find-package-data-path late-packages)
+   (packages-find-package-data-path early-packages)
+   (packages-find-package-data-path late-packages)
    (list data-directory)))
 
-(defun paths-setup-paths ()
-  "Setup all the various paths.
-Call this as often as you like!"
-  ;; XEmacs -- Steven Baur says invocation directory is nil if you
-  ;; try to use XEmacs as a login shell.
-  (or invocation-directory (setq invocation-directory default-directory))
-  (if (fboundp 'abbreviate-file-name)
-      ;; No abbreviate-file-name in temacs
-      (setq invocation-directory
-	    ;; don't let /tmp_mnt/... get into the load-path or exec-path.
-	    (abbreviate-file-name invocation-directory)))
-
-  (let ((roots (paths-find-emacs-roots invocation-directory invocation-name)))
-
-    (setq package-path (paths-find-package-path roots))
-
-    (let ((stuff (paths-find-packages package-path)))
-      (setq early-packages (car stuff))
-      (setq late-packages (cdr stuff)))
-
-    (setq early-package-load-path (paths-find-package-load-path early-packages))
-    (setq late-package-load-path (paths-find-package-load-path late-packages))
-
-    (setq load-path (paths-find-load-path roots
-					  early-package-load-path
-					  late-package-load-path))
-
-    (setq info-path (paths-find-info-path roots early-packages late-packages))
-
-    (if (boundp 'lock-directory)
-	(progn
-	  (setq lock-directory (paths-find-lock-directory roots))
-	  (setq superlock-file (paths-find-superlock-file lock-directory))))
-
-    (setq exec-directory (paths-find-exec-directory roots))
-
-    (setq exec-path (paths-find-exec-path roots exec-directory
-					  early-packages late-packages))
-
-    (setq doc-directory (paths-find-doc-directory roots))
-
-    (setq data-directory (paths-find-data-directory roots))
-
-    (setq data-directory-list (paths-find-data-directory-list data-directory
-							      early-packages
-							      late-packages))))
-
-(defun paths-setup-paths-warning ()
-  (let ((lock (if (boundp 'lock-directory) lock-directory 't))
-	warnings message guess)
-    (if (and (stringp lock) (null (file-directory-p lock)))
-	(setq lock nil))
-    (cond
-     ((null (and exec-directory data-directory doc-directory load-path lock))
-      (save-excursion
-	(set-buffer (get-buffer-create " *warning-tmp*"))
-	(erase-buffer)
-	(buffer-disable-undo (current-buffer))
-	(if (null lock)           (push "lock-directory" warnings))
-	(if (null exec-directory) (push "exec-directory" warnings))
-	(if (null data-directory) (push "data-directory" warnings))
-	(if (null doc-directory)  (push "doc-directory"  warnings))
-	(if (null load-path)      (push "load-path"      warnings))
-	(cond ((cdr (cdr warnings))
-	       (setq message (apply 'format "%s, %s, and %s" warnings)))
-	      ((cdr warnings)
-	       (setq message (apply 'format "%s and %s" warnings)))
-	      (t (setq message (format "variable %s" (car warnings)))))
-	(insert "couldn't find an obvious default for " message
-		", and there were no defaults specified in paths.h when "
-		"XEmacs was built.  Perhaps some directories don't exist, "
-		"or the XEmacs executable, " (concat invocation-directory
-						     invocation-name)
-		" is in a strange place?")
-
-	(if (fboundp 'fill-region)
-	    ;; Might not be bound in the cold load environment...
-	    (let ((fill-column 76))
-	      (fill-region (point-min) (point-max))))
-	(goto-char (point-min))
-	(princ "\nWARNING:\n" 'external-debugging-output)
-	(princ (buffer-string) 'external-debugging-output)
-	(erase-buffer)
-	t)))))
-
-(defun paths-load-package-lisps (package-load-path base)
-  "Load all Lisp files of a certain name along a load path.
-BASE is the base name of the files."
-  (mapc #'(lambda (dir)
-	    (let ((file-name (expand-file-name base dir)))
-	      (if (file-exists-p file-name)
-		  (condition-case error
-		      (load file-name)
-		    (error
-		     (warn (format "Autoload error in: %s:\n\t%s"
-				   file-name
-				   (with-output-to-string
-				     (display-error error nil)))))))))
-	package-load-path))
-
-(defun paths-load-package-auto-autoloads (package-load-path)
-  "Load auto-autoload files along a load path."
-  (paths-load-package-lisps package-load-path
-			    (file-name-sans-extension autoload-file-name)))
-
-(defun paths-load-package-dumped-lisps (package-load-path)
-  "Load dumped-lisp.el files along a load path."
-  (mapc #'(lambda (dir)
-	    (let ((file-name (expand-file-name "dumped-lisp.el" dir)))
-	      (if (file-exists-p file-name)
-		  (let (package-lisp
-			;; 20.4 packages could set this
-			preloaded-file-list)
-		    (load file-name)
-		    ;; dumped-lisp.el could have set this ...
-		    (if package-lisp
-			(mapc #'(lambda (base)
-				  (load (expand-file-name base dir)))
-			      package-lisp))))))
-	package-load-path))
-
 ;;; setup-paths.el ends here