diff lisp/setup-paths.el @ 2456:f4e405a9d18d

[xemacs-hg @ 2004-12-27 12:25:14 by michaels] 2004-12-18 Mike Sperber <mike@xemacs.org> * package-admin.el: * startup.el: Reflect the changes made in packages.el. * packages.el: * loadup.el: * make-docfile.el: * package-admin.el: * startup.el: * update-elc.el (early-package-hierarchies) (late-package-hierarchies) (last-package-hierarchies): Renamed these from `early-packages', `late-packages' and `last-packages'. * packages.el: Rewrote package-finding logic to separate the concepts of "package directories" and "package hierarchies". Added explanation of these concepts. * setup-paths.el: * find-paths.el: Added parameter descriptions to some of the docstrings. * packages.el, setup-paths.el: Make terminology more explicit about "package hierarchies" * startup.el (emacs-roots, emacs-data-roots) (user-init-directory-base, user-init-directory) (user-init-file-base, user-init-file-base-list) (user-home-init-file-base-list) (load-home-init-file, load-user-init-file-p) (startup-find-load-path, startup-setup-paths) (startup-find-load-path-for-packages): Moved these back from setup-paths.el where they belong---setup-paths.el now again, as documented, contains no code that sets global variables. (They were moved from startup.el to setup-paths.el on 2003-02-28.) Clarify that in the comment at the top. * setup-paths.el (paths-find-emacs-roots): Restored `invocation-directory' 'invocation-name' parameters removed on 2003-02-28; they're useful for debugging.
author michaels
date Mon, 27 Dec 2004 12:27:05 +0000
parents 8b284a83dd90
children 57711e9aac15
line wrap: on
line diff
--- a/lisp/setup-paths.el	Sun Dec 26 22:52:34 2004 +0000
+++ b/lisp/setup-paths.el	Mon Dec 27 12:27:05 2004 +0000
@@ -5,7 +5,7 @@
 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
 ;; Copyright (C) 2003 Ben Wing.
 
-;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de>
+;; Author: Mike Sperber <mike@xemacs.orgx>
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: internal, dumped
 
@@ -34,7 +34,10 @@
 
 ;; This file contains functions and variables that describe and construct
 ;; the various paths into the XEmacs hierarchy from a global viewpoint.
-;; This file doesn't actually do anything.
+
+;; This file doesn't actually set any global variable, and doesn't
+;; contain any state---it just contains the functionality for
+;; searching directories and constructing paths.
 
 ;; It requires find-paths.el and packages.el.
 
@@ -43,51 +46,6 @@
 ;(setq debug-paths t)
 
 
-;;; 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.")
 
@@ -130,7 +88,9 @@
 (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."
+among multiple different versions of XEmacs, the packages in particular.
+This serves as an additional filter to narrow down the list of plausible
+installation roots."
   (or
    ;; installed
    (paths-file-readable-directory-p (paths-construct-path (list directory
@@ -145,7 +105,9 @@
     (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."
+  "Find the run-time root of XEmacs.
+INVOCATION-DIRECTORY is a directory containing the XEmacs executable.
+INVOCATION-NAME is the name of the executable itself."
   (let* ((executable-file-name (paths-chase-symlink
 				(concat invocation-directory
 					invocation-name)))
@@ -159,7 +121,9 @@
 	(and (paths-emacs-root-p maybe-root-2)
 	     maybe-root-2))))
 
-(defun paths-find-emacs-roots (root-p)
+(defun paths-find-emacs-roots (invocation-directory
+			       invocation-name
+			       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',
@@ -184,25 +148,29 @@
 		       installation-roots)))
 
 (defun paths-find-site-lisp-directory (roots)
-  "Find the site Lisp directory of the XEmacs hierarchy."
+  "Find the site Lisp directory of the XEmacs hierarchy.
+ROOTS is a list of installation roots."
   (paths-find-site-directory roots "site-lisp"
 			     nil
 			     configure-site-directory))
 
 (defun paths-find-site-module-directory (roots)
-  "Find the site modules directory of the XEmacs hierarchy."
+  "Find the site modules directory of the XEmacs hierarchy.
+ROOTS is a list of installation roots."
   (paths-find-site-directory roots "site-modules"
 			     nil
 			     configure-site-module-directory))
 
 (defun paths-find-lisp-directory (roots)
-  "Find the main Lisp directory of the XEmacs hierarchy."
+  "Find the main Lisp directory of the XEmacs hierarchy.
+ROOTS is a list of installation roots."
   (paths-find-version-directory roots "lisp"
 				nil
 				configure-lisp-directory))
 
 (defun paths-find-mule-lisp-directory (roots &optional lisp-directory)
-  "Find the Mule Lisp directory of the XEmacs hierarchy."
+  "Find the Mule Lisp directory of the XEmacs hierarchy.
+ROOTS is a list of installation roots."
   ;; #### kludge
   (if lisp-directory
       (let ((guess
@@ -215,7 +183,8 @@
 					configure-mule-lisp-directory)))))
 
 (defun paths-find-module-directory (roots)
-  "Find the main modules directory of the XEmacs hierarchy."
+  "Find the main modules directory of the XEmacs hierarchy.
+ROOTS is a list of installation roots."
   (paths-find-architecture-directory roots "modules"
 				     nil configure-module-directory))
 
@@ -223,7 +192,14 @@
   (roots early-package-load-path late-package-load-path last-package-load-path
 	 lisp-directory
 	 &optional site-lisp-directory mule-lisp-directory)
-  "Construct the load path."
+  "Construct the complete load path.
+ROOTS is the list of installation roots.
+EARLY-PACKAGE-LOAD-PATH, LATE-PACKAGE-LOAD-PATH, and LAST-PACKAGE-LOAD-PATH
+are the load paths for the package hierarchies.
+SITE-LISP-DIRECTORY and MULE-LISP-DIRECTORY are optional directories to be
+included in the load path---SITE-LISP-DIRECTORY for the obsolete site-specific
+Lisp files, and MULE-LISP-DIRECTORY for the Mule Lisp files, which exist
+only in Mule installations."
   (let* ((envvar-value (getenv "EMACSLOADPATH"))
 	 (env-load-path
 	  (and envvar-value
@@ -263,12 +239,19 @@
 	  (and module-directory
 	       (paths-find-recursive-load-path (list module-directory)
 					       paths-core-load-path-depth))))
-     (append env-module-path
+    (append env-module-path
 	    site-module-load-path
 	    module-load-path)))
 
-(defun paths-construct-info-path (roots early-packages late-packages last-packages)
-  "Construct the info path."
+(defun paths-construct-info-path (roots
+				  early-package-hierarchies
+				  late-package-hierarchies
+				  last-package-hierarchies)
+  "Construct the info path.
+ROOTS is the list of installation roots.
+EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and
+LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots,
+respectively."
   (let ((info-path-envval (getenv "INFOPATH")))
     (paths-uniq-append
      (append
@@ -278,9 +261,9 @@
 					   configure-info-directory)))
 	(and info-directory
 	     (list info-directory)))
-      (packages-find-package-info-path early-packages)
-      (packages-find-package-info-path late-packages)
-      (packages-find-package-info-path last-packages)
+      (packages-find-package-info-path early-package-hierarchies)
+      (packages-find-package-info-path late-package-hierarchies)
+      (packages-find-package-info-path last-package-hierarchies)
       (and info-path-envval
 	   (paths-decode-directory-path info-path-envval 'drop-empties)))
      (and (null info-path-envval)
@@ -289,259 +272,60 @@
 	   (paths-directories-which-exist paths-default-info-directories))))))
 
 (defun paths-find-doc-directory (roots)
-  "Find the documentation directory."
+  "Find the documentation directory.
+ROOTS is the list of installation roots."
   (paths-find-architecture-directory roots "lib-src" nil configure-doc-directory))
 
 (defun paths-find-exec-directory (roots)
-  "Find the binary directory."
+  "Find the binary directory.
+ROOTS is the list of installation roots."
   (paths-find-architecture-directory roots "lib-src"
 				     nil configure-exec-directory))
 
 (defun paths-construct-exec-path (roots exec-directory
-				  early-packages late-packages last-packages)
-  "Find the binary path."
+				  early-package-hierarchies
+				  late-package-hierarchies
+				  last-package-hierarchies)
+  "Find the binary path.
+ROOTS is the list of installation roots.
+EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and
+LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots,
+respectively.
+EXEC-DIRECTORY is the directory of architecture-dependent files that
+come with XEmacs.
+EARLY-PACKAGES, LATE-PACKAGES, and LAST-PACKAGES are lists of
+package hierarchy roots, respectively."
   (append
    (let ((path-envval (getenv "PATH")))
      (if path-envval
 	 (paths-decode-directory-path path-envval 'drop-empties)))
-   (packages-find-package-exec-path early-packages)
-   (packages-find-package-exec-path late-packages)
+   (packages-find-package-exec-path early-package-hierarchies)
+   (packages-find-package-exec-path late-package-hierarchies)
    (let ((emacspath-envval (getenv "EMACSPATH")))
      (and emacspath-envval
 	  (split-path emacspath-envval)))
    (and exec-directory
 	(list exec-directory))
-   (packages-find-package-exec-path last-packages)))
+   (packages-find-package-exec-path last-package-hierarchies)))
 
 (defun paths-find-data-directory (roots)
-  "Find the data directory."
+  "Find the data directory.
+ROOTS is the list of installation roots."
   (paths-find-version-directory roots "etc" "EMACSDATA" configure-data-directory))
 
 (defun paths-construct-data-directory-list (data-directory
-					    early-packages late-packages last-packages)
-  "Find the data path."
+					    early-package-hierarchies
+					    late-package-hierarchies
+					    last-package-hierarchies)
+  "Construct the data path.
+DATA-DIRECTORY is the data directory of the XEmacs installation.
+EARLY-PACKAGE-HIERARCHIES, LATE-PACKAGE-HIERARCHIES, and
+LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots,
+respectively."
   (append
-   (packages-find-package-data-path early-packages)
-   (packages-find-package-data-path late-packages)
+   (packages-find-package-data-path early-package-hierarchies)
+   (packages-find-package-data-path late-package-hierarchies)
    (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)
+   (packages-find-package-data-path last-package-hierarchies)))
 
 ;;; setup-paths.el ends here