Mercurial > hg > xemacs-beta

comparison lisp/startup.el @ 276:6330739388db r21-0b36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b36
author cvs
date Mon, 13 Aug 2007 10:30:37 +0200
parents ca9a9ec9c1c1
children 90d73dddcdc4
comparison
equal deleted inserted replaced
275:a68ae4439f57 276:6330739388db
97 XEmacs runs this hook after processing the command line arguments and loading 97 XEmacs runs this hook after processing the command line arguments and loading
98 the user's init file.") 98 the user's init file.")
99 99
100 (defconst initial-major-mode 'lisp-interaction-mode 100 (defconst initial-major-mode 'lisp-interaction-mode
101 "Major mode command symbol to use for the initial *scratch* buffer.") 101 "Major mode command symbol to use for the initial *scratch* buffer.")
102
103 (defvar emacs-roots nil
104 "List of plausible roots of the XEmacs hierarchy.")
102 105
103 (defvar init-file-user nil 106 (defvar init-file-user nil
104 "Identity of user whose `~/.xemacs/init.el' file is or was read. 107 "Identity of user whose `~/.xemacs/init.el' file is or was read.
105 The value is nil if no init file is being used; otherwise, it may be either 108 The value is nil if no init file is being used; otherwise, it may be either
106 the null string, meaning that the init file was taken from the user that 109 the null string, meaning that the init file was taken from the user that
209 -batch Execute noninteractively (messages go to stderr). 212 -batch Execute noninteractively (messages go to stderr).
210 -debug-init Enter the debugger if an error in the init file occurs. 213 -debug-init Enter the debugger if an error in the init file occurs.
211 -unmapped Do not map the initial frame. 214 -unmapped Do not map the initial frame.
212 -no-site-file Do not load the site-specific init file (site-start.el). 215 -no-site-file Do not load the site-specific init file (site-start.el).
213 -no-init-file Do not load the user-specific init file (~/.emacs). 216 -no-init-file Do not load the user-specific init file (~/.emacs).
214 -no-packages Do not process the package path. 217 -no-early-packages Do not process early packages.
215 -no-autoloads Do not load global symbol files (auto-autoloads) at 218 -no-autoloads Do not load global symbol files (auto-autoloads) at
216 startup. Also implies `-vanilla'. 219 startup. Also implies `-vanilla'.
217 -vanilla Equivalent to -q -no-site-file -no-packages. 220 -vanilla Equivalent to -q -no-site-file -no-early-packages.
218 -q Same as -no-init-file. 221 -q Same as -no-init-file.
219 -user <user> Load user's init file instead of your own. 222 -user <user> Load user's init file instead of your own.
220 -u <user> Same as -user.\n") 223 -u <user> Same as -user.\n")
221 (let ((l command-switch-alist) 224 (let ((l command-switch-alist)
222 (insert (lambda (&rest x) 225 (insert (lambda (&rest x)
371 (setq default-directory (abbreviate-file-name default-directory)) 374 (setq default-directory (abbreviate-file-name default-directory))
372 (initialize-xemacs-paths) 375 (initialize-xemacs-paths)
373 376
374 (startup-set-invocation-environment) 377 (startup-set-invocation-environment)
375 378
376 (let ((roots (paths-find-emacs-roots invocation-directory 379 (let ((debug-paths (or debug-paths
377 invocation-name))) 380 (and (getenv "EMACSDEBUGPATHS")
378 (if (null roots) 381 t))))
382
383 (setq emacs-roots (paths-find-emacs-roots invocation-directory
384 invocation-name))
385
386 (if debug-paths
387 (princ (format "emacs-roots:\n%S\n" emacs-roots)
388 'external-debugging-output))
389
390 (if (null emacs-roots)
379 (startup-find-roots-warning) 391 (startup-find-roots-warning)
380 (startup-setup-paths roots 392 (startup-setup-paths emacs-roots
381 inhibit-package-init 393 inhibit-early-packages
382 inhibit-site-lisp)) 394 inhibit-site-lisp
395 debug-paths))
383 (startup-setup-paths-warning)) 396 (startup-setup-paths-warning))
384 397
385 (if (not inhibit-package-init) 398 (if (not inhibit-autoloads)
399 (load (expand-file-name (file-name-sans-extension autoload-file-name)
400 lisp-directory) nil t))
401
402 (if (not inhibit-autoloads)
386 (progn 403 (progn
387 (packages-load-package-auto-autoloads last-package-load-path) 404 (packages-load-package-auto-autoloads last-package-load-path)
388 (packages-load-package-auto-autoloads late-package-load-path) 405 (packages-load-package-auto-autoloads late-package-load-path)
389 (packages-load-package-auto-autoloads early-package-load-path))) 406 (if (not inhibit-early-packages)
407 (packages-load-package-auto-autoloads early-package-load-path))))
390 408
391 (unwind-protect 409 (unwind-protect
392 (command-line) 410 (command-line)
393 ;; Do this again, in case .emacs defined more abbreviations. 411 ;; Do this again, in case .emacs defined more abbreviations.
394 (setq default-directory (abbreviate-file-name default-directory)) 412 (setq default-directory (abbreviate-file-name default-directory))
482 ((or (string= arg "-q") 500 ((or (string= arg "-q")
483 (string= arg "-no-init-file")) 501 (string= arg "-no-init-file"))
484 (setq init-file-user nil)) 502 (setq init-file-user nil))
485 ((string= arg "-no-site-file") 503 ((string= arg "-no-site-file")
486 (setq site-start-file nil)) 504 (setq site-start-file nil))
487 ((or (string= arg "-no-packages") 505 ((or (string= arg "-no-early-packages")
488 (string= arg "--no-packages")) 506 (string= arg "--no-early-packages"))
489 (setq inhibit-package-init t)) 507 (setq inhibit-early-packages t))
490 ((or (string= arg "-vanilla") 508 ((or (string= arg "-vanilla")
491 (string= arg "--vanilla") 509 (string= arg "--vanilla")
492 ;; Some work on this one already done in emacs.c. 510 ;; Some work on this one already done in emacs.c.
493 (string= arg "-no-autoloads") 511 (string= arg "-no-autoloads")
494 (string= arg "--no-autoloads")) 512 (string= arg "--no-autoloads"))
495 (setq init-file-user nil 513 (setq init-file-user nil
496 site-start-file nil 514 site-start-file nil))
497 inhibit-package-init t))
498 ((or (string= arg "-u") 515 ((or (string= arg "-u")
499 (string= arg "-user")) 516 (string= arg "-user"))
500 (setq init-file-user (pop args))) 517 (setq init-file-user (pop args)))
501 ((string= arg "-debug-init") 518 ((string= arg "-debug-init")
502 (setq init-file-debug t)) 519 (setq init-file-debug t))
503 ((string= arg "-unmapped") 520 ((string= arg "-unmapped")
504 (setq initial-frame-unmapped-p t)) 521 (setq initial-frame-unmapped-p t))
522 ((or (string= arg "-debug-paths")
523 (string= arg "--debug-paths"))
524 t)
505 ((or (string= arg "--") (string= arg "-")) 525 ((or (string= arg "--") (string= arg "-"))
506 (while args 526 (while args
507 (push (pop args) new-args))) 527 (push (pop args) new-args)))
508 (t (push arg new-args)))) 528 (t (push arg new-args))))
509 529
628 ;; Don't you dare turn this off for anyone except yourself. 648 ;; Don't you dare turn this off for anyone except yourself.
629 (load "default" t t))))) 649 (load "default" t t)))))
630 650
631 ;;; Load user's init file and default ones. 651 ;;; Load user's init file and default ones.
632 (defun load-init-file () 652 (defun load-init-file ()
633 ;; Disabled for now
634 (unless inhibit-update-dumped-lisp
635 (packages-reload-dumped-lisp))
636
637 ;; (unless inhibit-update-autoloads
638 ;; (packages-reload-autoloads))
639 (unless inhibit-update-autoloads
640 (let ((dir load-path))
641 (while dir
642 (condition-case nil
643 (load (expand-file-name "auto-autoloads" (car dir)) nil t)
644 (t nil))
645 (pop dir))))
646
647 (run-hooks 'before-init-hook) 653 (run-hooks 'before-init-hook)
648 654
649 ;; Run the site-start library if it exists. The point of this file is 655 ;; Run the site-start library if it exists. The point of this file is
650 ;; that it is run before .emacs. There is no point in doing this after 656 ;; that it is run before .emacs. There is no point in doing this after
651 ;; .emacs; that is useless. 657 ;; .emacs; that is useless.
1008 (or invocation-directory (setq invocation-directory default-directory)) 1014 (or invocation-directory (setq invocation-directory default-directory))
1009 (setq invocation-directory 1015 (setq invocation-directory
1010 ;; don't let /tmp_mnt/... get into the load-path or exec-path. 1016 ;; don't let /tmp_mnt/... get into the load-path or exec-path.
1011 (abbreviate-file-name invocation-directory))) 1017 (abbreviate-file-name invocation-directory)))
1012 1018
1013 (defun startup-setup-paths (roots &optional inhibit-packages inhibit-site-lisp) 1019 (defun startup-setup-paths (roots &optional
1020 inhibit-early-packages inhibit-site-lisp
1021 debug-paths)
1014 "Setup all the various paths. 1022 "Setup all the various paths.
1015 ROOTS is a list of plausible roots of the XEmacs directory hierarchy. 1023 ROOTS is a list of plausible roots of the XEmacs directory hierarchy.
1016 If INHIBIT-PACKAGES is non-NIL, don't do packages. 1024 If INHIBIT-PACKAGES is non-NIL, don't do packages.
1017 If INHIBIT-SITE-LISP is non-NIL, don't do site-lisp. 1025 If INHIBIT-SITE-LISP is non-NIL, don't do site-lisp.
1026 If DEBUG-PATHS is non-NIL, print paths as they are detected.
1018 It's idempotent, so call this as often as you like!" 1027 It's idempotent, so call this as often as you like!"
1019 1028
1020 (apply #'(lambda (early late last) 1029 (apply #'(lambda (early late last)
1021 (setq early-packages early) 1030 (setq early-packages (and (not inhibit-early-packages)
1031 early))
1022 (setq late-packages late) 1032 (setq late-packages late)
1023 (setq last-packages last)) 1033 (setq last-packages last))
1024 (packages-find-packages roots inhibit-packages)) 1034 (packages-find-packages roots))
1025 1035
1026 (setq early-package-load-path (packages-find-package-load-path early-packages)) 1036 (setq early-package-load-path (packages-find-package-load-path early-packages))
1027 (setq late-package-load-path (packages-find-package-load-path late-packages)) 1037 (setq late-package-load-path (packages-find-package-load-path late-packages))
1028 (setq last-package-load-path (packages-find-package-load-path last-packages)) 1038 (setq last-package-load-path (packages-find-package-load-path last-packages))
1039
1040 (if debug-paths
1041 (progn
1042 (princ (format "configure-package-path:\n%S\n" configure-package-path)
1043 'external-debugging-output)
1044 (princ (format "early-packages and early-package-load-path:\n%S\n%S\n"
1045 early-packages early-package-load-path)
1046 'external-debugging-output)
1047 (princ (format "late-packages and late-package-load-path:\n%S\n%S\n"
1048 late-packages late-package-load-path)
1049 'external-debugging-output)
1050 (princ (format "last-packages and last-package-load-path:\n%S\n%S\n"
1051 last-packages last-package-load-path)
1052 'external-debugging-output)))
1053
1054 (setq lisp-directory (paths-find-lisp-directory roots))
1055
1056 (if debug-paths
1057 (princ (format "lisp-directory:\n%S\n" lisp-directory)
1058 'external-debugging-output))
1059
1060 (setq site-directory (and (null inhibit-site-lisp)
1061 (paths-find-site-lisp-directory roots)))
1062
1063 (if (and debug-paths (null inhibit-site-lisp))
1064 (princ (format "site-directory:\n%S\n" site-directory)
1065 'external-debugging-output))
1029 1066
1030 (setq load-path (paths-construct-load-path roots 1067 (setq load-path (paths-construct-load-path roots
1031 early-package-load-path 1068 early-package-load-path
1032 late-package-load-path 1069 late-package-load-path
1033 last-package-load-path 1070 last-package-load-path
1034 inhibit-site-lisp)) 1071 lisp-directory
1072 site-directory))
1035 1073
1036 (setq Info-directory-list 1074 (setq Info-directory-list
1037 (paths-construct-info-path roots 1075 (paths-construct-info-path roots
1038 early-packages late-packages last-packages)) 1076 early-packages late-packages last-packages))
1039 1077
1078
1079 (if debug-paths
1080 (princ (format "Info-directory-list:\n%S\n" Info-directory-list)
1081 'external-debugging-output))
1082
1040 (if (boundp 'lock-directory) 1083 (if (boundp 'lock-directory)
1041 (progn 1084 (progn
1042 (setq lock-directory (paths-find-lock-directory roots)) 1085 (setq lock-directory (paths-find-lock-directory roots))
1043 (setq superlock-file (paths-find-superlock-file lock-directory)))) 1086 (setq superlock-file (paths-find-superlock-file lock-directory))
1087
1088 (if debug-paths
1089 (progn
1090 (princ (format "lock-directory:\n%S\n" lock-directory)
1091 'external-debugging-output)
1092 (princ (format "superlock-file:\n%S\n" superlock-file)
1093 'external-debugging-output)))))
1044 1094
1045 (setq exec-directory (paths-find-exec-directory roots)) 1095 (setq exec-directory (paths-find-exec-directory roots))
1096
1097 (if debug-paths
1098 (princ (format "exec-directory:\n%s\n" exec-directory)
1099 'external-debugging-output))
1046 1100
1047 (setq exec-path 1101 (setq exec-path
1048 (paths-construct-exec-path roots exec-directory 1102 (paths-construct-exec-path roots exec-directory
1049 early-packages late-packages last-packages)) 1103 early-packages late-packages last-packages))
1104
1105 (if debug-paths
1106 (princ (format "exec-path:\n%S\n" exec-path)
1107 'external-debugging-output))
1050 1108
1051 (setq doc-directory (paths-find-doc-directory roots)) 1109 (setq doc-directory (paths-find-doc-directory roots))
1052 1110
1111 (if debug-paths
1112 (princ (format "doc-directory:\n%S\n" doc-directory)
1113 'external-debugging-output))
1114
1053 (setq data-directory (paths-find-data-directory roots)) 1115 (setq data-directory (paths-find-data-directory roots))
1116
1117 (if debug-paths
1118 (princ (format "data-directory:\n%S\n" data-directory)
1119 'external-debugging-output))
1054 1120
1055 (setq data-directory-list (paths-construct-data-directory-list data-directory 1121 (setq data-directory-list (paths-construct-data-directory-list data-directory
1056 early-packages 1122 early-packages
1057 late-packages 1123 late-packages
1058 last-packages))) 1124 last-packages))
1125 (if debug-paths
1126 (princ (format "data-directory-list:\n%S\n" data-directory-list)
1127 'external-debugging-output)))
1059 1128
1060 (defun startup-find-roots-warning () 1129 (defun startup-find-roots-warning ()
1061 (save-excursion 1130 (save-excursion
1062 (set-buffer (get-buffer-create " *warning-tmp*")) 1131 (set-buffer (get-buffer-create " *warning-tmp*"))
1063 (erase-buffer) 1132 (erase-buffer)