Mercurial > hg > xemacs-beta
diff lisp/startup.el @ 276:6330739388db r21-0b36
Import from CVS: tag r21-0b36
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:30:37 +0200 |
parents | ca9a9ec9c1c1 |
children | 90d73dddcdc4 |
line wrap: on
line diff
--- a/lisp/startup.el Mon Aug 13 10:29:43 2007 +0200 +++ b/lisp/startup.el Mon Aug 13 10:30:37 2007 +0200 @@ -100,6 +100,9 @@ (defconst initial-major-mode 'lisp-interaction-mode "Major mode command symbol to use for the initial *scratch* buffer.") +(defvar emacs-roots nil + "List of plausible roots of the XEmacs hierarchy.") + (defvar init-file-user nil "Identity of user whose `~/.xemacs/init.el' file is or was read. The value is nil if no init file is being used; otherwise, it may be either @@ -211,10 +214,10 @@ -unmapped Do not map the initial frame. -no-site-file Do not load the site-specific init file (site-start.el). -no-init-file Do not load the user-specific init file (~/.emacs). - -no-packages Do not process the package path. + -no-early-packages Do not process early packages. -no-autoloads Do not load global symbol files (auto-autoloads) at startup. Also implies `-vanilla'. - -vanilla Equivalent to -q -no-site-file -no-packages. + -vanilla Equivalent to -q -no-site-file -no-early-packages. -q Same as -no-init-file. -user <user> Load user's init file instead of your own. -u <user> Same as -user.\n") @@ -373,20 +376,35 @@ (startup-set-invocation-environment) - (let ((roots (paths-find-emacs-roots invocation-directory - invocation-name))) - (if (null roots) + (let ((debug-paths (or debug-paths + (and (getenv "EMACSDEBUGPATHS") + t)))) + + (setq emacs-roots (paths-find-emacs-roots invocation-directory + invocation-name)) + + (if debug-paths + (princ (format "emacs-roots:\n%S\n" emacs-roots) + 'external-debugging-output)) + + (if (null emacs-roots) (startup-find-roots-warning) - (startup-setup-paths roots - inhibit-package-init - inhibit-site-lisp)) + (startup-setup-paths emacs-roots + inhibit-early-packages + inhibit-site-lisp + debug-paths)) (startup-setup-paths-warning)) - (if (not inhibit-package-init) + (if (not inhibit-autoloads) + (load (expand-file-name (file-name-sans-extension autoload-file-name) + lisp-directory) nil t)) + + (if (not inhibit-autoloads) (progn (packages-load-package-auto-autoloads last-package-load-path) (packages-load-package-auto-autoloads late-package-load-path) - (packages-load-package-auto-autoloads early-package-load-path))) + (if (not inhibit-early-packages) + (packages-load-package-auto-autoloads early-package-load-path)))) (unwind-protect (command-line) @@ -484,17 +502,16 @@ (setq init-file-user nil)) ((string= arg "-no-site-file") (setq site-start-file nil)) - ((or (string= arg "-no-packages") - (string= arg "--no-packages")) - (setq inhibit-package-init t)) + ((or (string= arg "-no-early-packages") + (string= arg "--no-early-packages")) + (setq inhibit-early-packages t)) ((or (string= arg "-vanilla") (string= arg "--vanilla") ;; Some work on this one already done in emacs.c. (string= arg "-no-autoloads") (string= arg "--no-autoloads")) (setq init-file-user nil - site-start-file nil - inhibit-package-init t)) + site-start-file nil)) ((or (string= arg "-u") (string= arg "-user")) (setq init-file-user (pop args))) @@ -502,6 +519,9 @@ (setq init-file-debug t)) ((string= arg "-unmapped") (setq initial-frame-unmapped-p t)) + ((or (string= arg "-debug-paths") + (string= arg "--debug-paths")) + t) ((or (string= arg "--") (string= arg "-")) (while args (push (pop args) new-args))) @@ -630,20 +650,6 @@ ;;; Load user's init file and default ones. (defun load-init-file () - ;; Disabled for now - (unless inhibit-update-dumped-lisp - (packages-reload-dumped-lisp)) - -;; (unless inhibit-update-autoloads -;; (packages-reload-autoloads)) - (unless inhibit-update-autoloads - (let ((dir load-path)) - (while dir - (condition-case nil - (load (expand-file-name "auto-autoloads" (car dir)) nil t) - (t nil)) - (pop dir)))) - (run-hooks 'before-init-hook) ;; Run the site-start library if it exists. The point of this file is @@ -1010,52 +1016,115 @@ ;; don't let /tmp_mnt/... get into the load-path or exec-path. (abbreviate-file-name invocation-directory))) -(defun startup-setup-paths (roots &optional inhibit-packages inhibit-site-lisp) +(defun startup-setup-paths (roots &optional + inhibit-early-packages inhibit-site-lisp + debug-paths) "Setup all the various paths. ROOTS is a list of plausible roots of the XEmacs directory hierarchy. If INHIBIT-PACKAGES is non-NIL, don't do packages. If INHIBIT-SITE-LISP is non-NIL, don't do site-lisp. +If DEBUG-PATHS is non-NIL, print paths as they are detected. It's idempotent, so call this as often as you like!" (apply #'(lambda (early late last) - (setq early-packages early) + (setq early-packages (and (not inhibit-early-packages) + early)) (setq late-packages late) (setq last-packages last)) - (packages-find-packages roots inhibit-packages)) + (packages-find-packages roots)) (setq early-package-load-path (packages-find-package-load-path early-packages)) (setq late-package-load-path (packages-find-package-load-path late-packages)) (setq last-package-load-path (packages-find-package-load-path last-packages)) + (if debug-paths + (progn + (princ (format "configure-package-path:\n%S\n" configure-package-path) + 'external-debugging-output) + (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))) + + (setq lisp-directory (paths-find-lisp-directory roots)) + + (if debug-paths + (princ (format "lisp-directory:\n%S\n" lisp-directory) + 'external-debugging-output)) + + (setq site-directory (and (null inhibit-site-lisp) + (paths-find-site-lisp-directory roots))) + + (if (and debug-paths (null inhibit-site-lisp)) + (princ (format "site-directory:\n%S\n" site-directory) + 'external-debugging-output)) + (setq load-path (paths-construct-load-path roots early-package-load-path late-package-load-path last-package-load-path - inhibit-site-lisp)) + lisp-directory + site-directory)) (setq Info-directory-list (paths-construct-info-path roots early-packages late-packages last-packages)) + + (if debug-paths + (princ (format "Info-directory-list:\n%S\n" Info-directory-list) + 'external-debugging-output)) + (if (boundp 'lock-directory) (progn (setq lock-directory (paths-find-lock-directory roots)) - (setq superlock-file (paths-find-superlock-file lock-directory)))) + (setq superlock-file (paths-find-superlock-file lock-directory)) + + (if debug-paths + (progn + (princ (format "lock-directory:\n%S\n" lock-directory) + 'external-debugging-output) + (princ (format "superlock-file:\n%S\n" superlock-file) + 'external-debugging-output))))) (setq exec-directory (paths-find-exec-directory roots)) + (if debug-paths + (princ (format "exec-directory:\n%s\n" exec-directory) + 'external-debugging-output)) + (setq exec-path (paths-construct-exec-path 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 roots)) + (if debug-paths + (princ (format "doc-directory:\n%S\n" doc-directory) + 'external-debugging-output)) + (setq data-directory (paths-find-data-directory 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))) + last-packages)) + (if debug-paths + (princ (format "data-directory-list:\n%S\n" data-directory-list) + 'external-debugging-output))) (defun startup-find-roots-warning () (save-excursion