--- a/lisp/setup-paths.el	Fri Feb 28 22:52:30 2003 +0000
+++ b/lisp/setup-paths.el	Sat Mar 01 07:25:56 2003 +0000
@@ -3,6 +3,7 @@
 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc.
 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc.
 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
+;; Copyright (C) 2003 Ben Wing.
 
 ;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de>
 ;; Maintainer: XEmacs Development Team
@@ -36,8 +37,56 @@
 ;; This file doesn't actually do anything.
 
 ;; It requires find-paths.el and packages.el.
+
+;;; Code:
+
+;(setq debug-paths t)
+
 
-;;; Code:
+;;; Path-related variables.
+;;; NOTE: Many of them (`lisp-directory', `data-directory', etc.) are
+;;; built-in.
+
+(defvar emacs-roots nil
+  "List of plausible roots of the XEmacs hierarchy.
+This is a list of plausible directories in which to search for the important
+directories used by XEmacs at run-time, for example `exec-directory',
+`data-directory' and `lisp-directory'.
+
+Normally set at startup by calling `paths-find-emacs-roots'.")
+
+(defvar emacs-data-roots nil
+  "List of plausible data roots of the XEmacs hierarchy.")
+
+(defvar user-init-directory-base ".xemacs"
+  "Base of directory where user-installed init files may go.")
+
+(defvar user-init-directory
+  (file-name-as-directory
+   (paths-construct-path (list "~" user-init-directory-base)))
+  "Directory where user-installed init files may go.")
+
+(defvar user-init-file-base "init.el"
+  "Default name of the user init file if uncompiled.
+This should be used for migration purposes only.")
+
+(defvar user-init-file-base-list '("init.el")
+  "List of allowed init files in the user's init directory.
+The first one found takes precedence.  .elc files do not need to be listed.")
+
+(defvar user-home-init-file-base-list
+  (append '(".emacs.el" ".emacs")
+	  (and (eq system-type 'windows-nt)
+	       '("_emacs.el" "_emacs")))
+  "List of allowed init files in the user's home directory.
+The first one found takes precedence.  .elc files do not need to be listed.")
+
+(defvar load-home-init-file nil
+  "Non-nil if XEmacs should load the init file from the home directory.
+Otherwise, XEmacs will offer migration to the init directory.")
+
+(defvar load-user-init-file-p t
+  "Non-nil if XEmacs should load the user's init file.")
 
 (defvar paths-core-load-path-depth 0
   "Depth of load-path searches in core Lisp paths.")
@@ -59,6 +108,81 @@
 	    ("usr" "share" "info")))
   "Directories appended to the end of the info path by default.")
 
+
+;;; Basic utility functions.
+
+(defun paths-emacs-root-p (directory)
+  "Check if DIRECTORY is a plausible installation root."
+  (or
+   ;; installed
+   (paths-file-readable-directory-p (paths-construct-path (list directory
+								"lib"
+								(construct-emacs-version-name))))
+   ;; in-place or windows-nt.  windows-nt equivalent of --srcdir is
+   ;; BUILD_DIR in config.inc, and has no lisp/ or etc/ since symlinks
+   ;; don't exist.  instead, xemacs.mak points configure-lisp-directory and
+   ;; configure-data-directory at the right places.
+   (and
+    (or configure-exec-directory (paths-file-readable-directory-p (paths-construct-path (list directory "lib-src"))))
+    (or configure-lisp-directory (paths-file-readable-directory-p (paths-construct-path (list directory "lisp"))))
+    (or configure-data-directory (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))))))
+
+(defun paths-emacs-data-root-p (directory)
+  "Check if DIRECTORY is a plausible data installation root.
+A data installation root is one containing data files that may be shared
+among multiple different versions of XEmacs, the packages in particular."
+  (or
+   ;; installed
+   (paths-file-readable-directory-p (paths-construct-path (list directory
+								"lib"
+								emacs-program-name)))
+   (paths-file-readable-directory-p (paths-construct-path (list directory
+								"lib"
+								(construct-emacs-version-name))))
+   ;; in-place or windows-nt
+   (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-find-emacs-root (invocation-directory invocation-name)
+  "Find the run-time root of XEmacs."
+  (let* ((executable-file-name (paths-chase-symlink
+				(concat invocation-directory
+					invocation-name)))
+	 (executable-directory (file-name-directory executable-file-name))
+	 (maybe-root-1 (file-name-as-directory
+			(paths-construct-path '("..") executable-directory)))
+	 (maybe-root-2 (file-name-as-directory
+			(paths-construct-path '(".." "..") executable-directory))))
+    (or (and (paths-emacs-root-p maybe-root-1)
+	     maybe-root-1)
+	(and (paths-emacs-root-p maybe-root-2)
+	     maybe-root-2))))
+
+(defun paths-find-emacs-roots (root-p)
+  "Find all plausible installation roots for XEmacs.
+This is a list of plausible directories in which to search for the important
+directories used by XEmacs at run-time, for example `exec-directory',
+`data-directory' and `lisp-directory'.
+ROOT-P is a function that tests whether a root is plausible."
+  (let* ((potential-invocation-root
+	  (paths-find-emacs-root invocation-directory invocation-name))
+	 (invocation-roots
+	  (and potential-invocation-root
+	       (list potential-invocation-root)))
+	 (potential-installation-roots
+	  (paths-uniq-append
+	   (and configure-exec-prefix-directory
+		(list (file-name-as-directory
+		       configure-exec-prefix-directory)))
+	   (and configure-prefix-directory
+		(list (file-name-as-directory
+		       configure-prefix-directory)))))
+	 (installation-roots
+	  (paths-filter root-p potential-installation-roots)))
+    (paths-uniq-append invocation-roots
+		       installation-roots)))
+
 (defun paths-find-site-lisp-directory (roots)
   "Find the site Lisp directory of the XEmacs hierarchy."
   (paths-find-site-directory roots "site-lisp"
@@ -202,4 +326,222 @@
    (list data-directory)
    (packages-find-package-data-path last-packages)))
 
+
+;;; High-level functions to set up the paths.
+
+(defun startup-find-load-path (&optional inhibit-packages
+			       set-global-package-paths)
+  "Determine the value for `load-path'.
+INHIBIT-PACKAGES says which types of packages, if any, to omit from the
+returned value.  It can be `t' (omit all), one of the symbols `early',
+`late', or `last', or a list of one or more of the symbols.
+
+If SET-GLOBAL-PACKAGE-PATHS is non-nil, initialize the global package path
+variables referring to the particular types of packages (`early-packages',
+`early-package-load-path', `late-packages', `late-package-load-path',
+`last-packages', `last-package-load-path')."
+  (let (earlyp latep lastp earlyp-lp latep-lp lastp-lp)
+    (apply #'(lambda (early late last)
+	       (setq earlyp (and (not (memq 'early inhibit-packages)) early))
+	       (setq latep (and (not (memq 'late inhibit-packages)) late))
+	       (setq lastp (and (not (memq 'last inhibit-packages)) last)))
+	   (packages-find-packages
+	    emacs-data-roots
+	    (packages-compute-package-locations user-init-directory)))
+
+  (setq earlyp-lp (packages-find-package-load-path earlyp))
+  (setq latep-lp (packages-find-package-load-path latep))
+  (setq lastp-lp (packages-find-package-load-path lastp))
+
+  (when set-global-package-paths
+    (setq early-packages earlyp
+	  late-packages latep
+	  last-packages lastp
+	  early-package-load-path earlyp-lp
+	  late-package-load-path latep-lp
+	  last-package-load-path lastp-lp))
+
+  (paths-construct-load-path emacs-roots earlyp-lp latep-lp lastp-lp
+			     lisp-directory site-directory
+			     mule-lisp-directory)))
+
+(defun startup-setup-paths (&optional inhibit-packages called-early)
+  "Setup all the various paths.
+INHIBIT-PACKAGES says which types of packages, if any, to omit from the
+returned value.  It can be `t' (omit all), one of the symbols `early',
+`late', or `last', or a list of one or more of the symbols.
+
+This function is idempotent, so call this as often as you like!"
+
+  (setq debug-paths (or debug-paths
+			(and (getenv "EMACSDEBUGPATHS")
+			     t)))
+
+  (setq emacs-roots (paths-find-emacs-roots #'paths-emacs-data-root-p))
+
+  (setq emacs-data-roots (paths-find-emacs-roots #'paths-emacs-data-root-p))
+
+  (if (null emacs-roots)
+      (save-excursion
+	(set-buffer (get-buffer-create " *warning-tmp*"))
+	(erase-buffer)
+	(buffer-disable-undo (current-buffer))
+
+	(insert "Couldn't find an obvious default for the root of the\n"
+		"XEmacs hierarchy.")
+
+	(princ "\nWARNING:\n" 'external-debugging-output)
+	(princ (buffer-string) 'external-debugging-output)))
+
+  (if (eq inhibit-packages t)
+      (setq inhibit-packages '(early late last)))
+  (if (not (listp inhibit-packages))
+      (setq inhibit-packages (list inhibit-packages)))
+
+  (when debug-paths
+    (princ (format
+"startup-setup-paths arguments:
+  inhibit-packages: %S
+  inhibit-site-lisp: %S
+  called-early: %S
+" inhibit-packages inhibit-site-lisp called-early)
+	   'external-debugging-output)
+    (princ (format
+"emacs-roots:
+%S
+emacs-data-roots:
+%S
+user-init-directory: %S
+configure-package-path: %S
+" emacs-roots emacs-data-roots user-init-directory configure-package-path)
+	   'external-debugging-output)
+    )
+
+  (setq lisp-directory (paths-find-lisp-directory emacs-roots))
+
+  (if debug-paths
+      (princ (format "lisp-directory:\n%S\n" lisp-directory)
+	     'external-debugging-output))
+
+  (if (featurep 'mule)
+      (progn
+	(setq mule-lisp-directory
+	      (paths-find-mule-lisp-directory emacs-roots
+					      lisp-directory))
+	(if debug-paths
+	    (princ (format "mule-lisp-directory:\n%S\n"
+			   mule-lisp-directory)
+		   'external-debugging-output)))
+    (setq mule-lisp-directory '()))
+
+  (setq site-directory (and (null inhibit-site-lisp)
+			    (paths-find-site-lisp-directory emacs-roots)))
+
+  (if (and debug-paths (null inhibit-site-lisp))
+      (princ (format "site-directory:\n%S\n" site-directory)
+	     'external-debugging-output))
+
+  (setq load-path (startup-find-load-path inhibit-packages t))
+
+  (when debug-paths
+    (princ (format "early-packages and early-package-load-path:\n%S\n%S\n"
+		   early-packages early-package-load-path)
+	   'external-debugging-output)
+    (princ (format "late-packages and late-package-load-path:\n%S\n%S\n"
+		   late-packages late-package-load-path)
+	   'external-debugging-output)
+    (princ (format "last-packages and last-package-load-path:\n%S\n%S\n"
+		   last-packages last-package-load-path)
+	   'external-debugging-output))
+
+  (if debug-paths
+      (princ (format "load-path:\n%S\n" load-path)
+            'external-debugging-output))
+  (setq module-directory (paths-find-module-directory emacs-roots))
+  (if debug-paths
+      (princ (format "module-directory:\n%S\n" module-directory)
+	     'external-debugging-output))
+  (setq site-module-directory (and (null inhibit-site-modules)
+				   (paths-find-site-module-directory
+				    emacs-roots)))
+  (if (and debug-paths (null inhibit-site-modules))
+      (princ (format "site-module-directory:\n%S\n"
+		     site-module-directory)
+	     'external-debugging-output))
+
+  (setq module-load-path (paths-construct-module-load-path
+			  emacs-roots
+			  module-directory
+			  site-module-directory))
+
+  (unless called-early
+    (setq Info-directory-list
+	  (paths-construct-info-path
+	   emacs-roots early-packages late-packages last-packages))
+
+    (if debug-paths
+	(princ (format "Info-directory-list:\n%S\n" Info-directory-list)
+	       'external-debugging-output))
+
+    (setq exec-directory (paths-find-exec-directory emacs-roots))
+
+    (if debug-paths
+	(princ (format "exec-directory:\n%s\n" exec-directory)
+	       'external-debugging-output))
+
+    (setq exec-path
+	  (paths-construct-exec-path emacs-roots exec-directory
+				     early-packages late-packages
+				     last-packages))
+
+    (if debug-paths
+	(princ (format "exec-path:\n%S\n" exec-path)
+	       'external-debugging-output))
+
+    (setq doc-directory (paths-find-doc-directory emacs-roots))
+
+    (if debug-paths
+	(princ (format "doc-directory:\n%S\n" doc-directory)
+	       'external-debugging-output))
+    
+    (setq data-directory (paths-find-data-directory emacs-roots))
+    
+    (if debug-paths
+	(princ (format "data-directory:\n%S\n" data-directory)
+	       'external-debugging-output))
+
+    (setq data-directory-list (paths-construct-data-directory-list
+			       data-directory early-packages
+			       late-packages last-packages))
+    (if debug-paths
+	(princ (format "data-directory-list:\n%S\n" data-directory-list)
+	       'external-debugging-output))))
+
+(defun startup-find-load-path-for-packages (packages)
+  "Return a suitable load-path for PACKAGES.
+PACKAGES is a list of package names (strings).  This looks for package
+directories in the load path whose last component is one of the members of
+PACKAGES."
+  (mapcan
+   #'(lambda (package)
+       (and (member (file-name-nondirectory (directory-file-name package))
+		    packages)
+	    (list package)))
+   (startup-find-load-path)))
+
+; (defun startup-set-basic-packages-load-path ()
+;   "#### This is a hack.  When recompiling .el files, we use -no-packages
+; to avoid problems with packages shadowing standard Lisp files
+; (e.g. unicode.el), but we really still need the stuff in xemacs-base and
+; xemacs-devel, which SHOULD NOT be in the packages."
+;   (setq load-path (startup-find-load-path-for-packages
+; 		   '("xemacs-base" "xemacs-devel"))))
+
+
+;;; Now actually set the paths up, for bootstrapping purposes.  This is run
+;;; at early dump time and in certain cases where we use a minimal temacs
+;;; to do useful things, like rebuild DOC.
+
+(startup-setup-paths (if inhibit-all-packages t '(early last)) t)
+
 ;;; setup-paths.el ends here