Mercurial > hg > xemacs-beta
diff lisp/startup.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 | 69a0933b86f1 |
children | 3e5a2d0d57e1 |
line wrap: on
line diff
--- a/lisp/startup.el Sun Dec 26 22:52:34 2004 +0000 +++ b/lisp/startup.el Mon Dec 27 12:27:05 2004 +0000 @@ -129,7 +129,52 @@ (defconst initial-major-mode 'lisp-interaction-mode "Major mode command symbol to use for the initial *scratch* buffer.") + +;;; 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.") + ;; #### called `site-run-file' in FSFmacs (defvar site-start-file "site-start" @@ -1347,6 +1392,219 @@ ;; don't let /tmp_mnt/... get into the load-path or exec-path. (abbreviate-file-name invocation-directory))) +;;; 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-package-hierarchies', `early-package-load-path', +`late-package-hierarchies', `late-package-load-path', +`last-package-hierarchies', `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-all-package-hierarchies + emacs-data-roots)) + + (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-package-hierarchies earlyp + late-package-hierarchies latep + last-package-hierarchies 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 invocation-directory invocation-name + #'paths-emacs-data-root-p)) + + (setq emacs-data-roots (paths-find-emacs-roots invocation-directory invocation-name + #'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-package-hierarchies and early-package-load-path:\n%S\n%S\n" + early-package-hierarchies early-package-load-path) + 'external-debugging-output) + (princ (format "late-package-hierarchies and late-package-load-path:\n%S\n%S\n" + late-package-hierarchies late-package-load-path) + 'external-debugging-output) + (princ (format "last-package-hierarchies and last-package-load-path:\n%S\n%S\n" + last-package-hierarchies 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-package-hierarchies late-package-hierarchies last-package-hierarchies)) + + (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-package-hierarchies late-package-hierarchies + last-package-hierarchies)) + + (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-package-hierarchies + late-package-hierarchies last-package-hierarchies)) + (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." +; (setq load-path (startup-find-load-path-for-packages +; '("xemacs-base" "xemacs-devel")))) + (defun startup-setup-paths-warning () (let ((warnings '())) (cond @@ -1379,6 +1637,14 @@ (erase-buffer) t))))) + +;;; 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) + + (defun startup-load-autoloads () (when (and (not inhibit-autoloads) lisp-directory) (load (expand-file-name (file-name-sans-extension autoload-file-name)