Mercurial > hg > xemacs-beta

comparison lisp/startup.el @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents b2472a1930f2
children ca9a9ec9c1c1
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
372 372
373 (startup-set-invocation-environment) 373 (startup-set-invocation-environment)
374 374
375 (let ((roots (paths-find-emacs-roots invocation-directory 375 (let ((roots (paths-find-emacs-roots invocation-directory
376 invocation-name))) 376 invocation-name)))
377 (startup-setup-paths roots 377 (if (null roots)
378 inhibit-package-init 378 (startup-find-roots-warning)
379 inhibit-site-lisp) 379 (startup-setup-paths roots
380 inhibit-package-init
381 inhibit-site-lisp))
380 (startup-setup-paths-warning)) 382 (startup-setup-paths-warning))
381 383
382 (if (not inhibit-package-init) 384 (if (not inhibit-package-init)
383 (progn 385 (progn
384 (packages-load-package-auto-autoloads early-package-load-path) 386 (packages-load-package-auto-autoloads last-package-load-path)
385 (packages-load-package-auto-autoloads late-package-load-path))) 387 (packages-load-package-auto-autoloads late-package-load-path)
388 (packages-load-package-auto-autoloads early-package-load-path)))
386 389
387 (unwind-protect 390 (unwind-protect
388 (command-line) 391 (command-line)
389 ;; Do this again, in case .emacs defined more abbreviations. 392 ;; Do this again, in case .emacs defined more abbreviations.
390 (setq default-directory (abbreviate-file-name default-directory)) 393 (setq default-directory (abbreviate-file-name default-directory))
1013 If INHIBIT-SITE-LISP is non-NIL, don't do site-lisp. 1016 If INHIBIT-SITE-LISP is non-NIL, don't do site-lisp.
1014 It's idempotent, so call this as often as you like!" 1017 It's idempotent, so call this as often as you like!"
1015 1018
1016 (setq package-path (packages-find-package-path roots)) 1019 (setq package-path (packages-find-package-path roots))
1017 1020
1018 (let ((stuff (packages-find-packages package-path inhibit-packages))) 1021 (apply #'(lambda (early late last)
1019 (setq early-packages (car stuff)) 1022 (setq early-packages early)
1020 (setq late-packages (cdr stuff))) 1023 (setq late-packages late)
1024 (setq last-packages last))
1025 (packages-find-packages package-path inhibit-packages))
1021 1026
1022 (setq early-package-load-path (packages-find-package-load-path early-packages)) 1027 (setq early-package-load-path (packages-find-package-load-path early-packages))
1023 (setq late-package-load-path (packages-find-package-load-path late-packages)) 1028 (setq late-package-load-path (packages-find-package-load-path late-packages))
1029 (setq last-package-load-path (packages-find-package-load-path last-packages))
1024 1030
1025 (setq load-path (paths-construct-load-path roots 1031 (setq load-path (paths-construct-load-path roots
1026 early-package-load-path 1032 early-package-load-path
1027 late-package-load-path 1033 late-package-load-path
1034 last-package-load-path
1028 inhibit-site-lisp)) 1035 inhibit-site-lisp))
1029 1036
1030 (setq Info-directory-list 1037 (setq Info-directory-list
1031 (paths-construct-info-path roots early-packages late-packages)) 1038 (paths-construct-info-path roots
1039 early-packages late-packages last-packages))
1032 1040
1033 (if (boundp 'lock-directory) 1041 (if (boundp 'lock-directory)
1034 (progn 1042 (progn
1035 (setq lock-directory (paths-find-lock-directory roots)) 1043 (setq lock-directory (paths-find-lock-directory roots))
1036 (setq superlock-file (paths-find-superlock-file lock-directory)))) 1044 (setq superlock-file (paths-find-superlock-file lock-directory))))
1037 1045
1038 (setq exec-directory (paths-find-exec-directory roots)) 1046 (setq exec-directory (paths-find-exec-directory roots))
1039 1047
1040 (setq exec-path (paths-construct-exec-path roots exec-directory 1048 (setq exec-path
1041 early-packages late-packages)) 1049 (paths-construct-exec-path roots exec-directory
1042 1050 early-packages late-packages last-packages))
1051
1043 (setq doc-directory (paths-find-doc-directory roots)) 1052 (setq doc-directory (paths-find-doc-directory roots))
1044 1053
1045 (setq data-directory (paths-find-data-directory roots)) 1054 (setq data-directory (paths-find-data-directory roots))
1046 1055
1047 (setq data-directory-list (paths-construct-data-directory-list data-directory 1056 (setq data-directory-list (paths-construct-data-directory-list data-directory
1048 early-packages 1057 early-packages
1049 late-packages))) 1058 late-packages
1059 last-packages)))
1060
1061 (defun startup-find-roots-warning ()
1062 (save-excursion
1063 (set-buffer (get-buffer-create " *warning-tmp*"))
1064 (erase-buffer)
1065 (buffer-disable-undo (current-buffer))
1066
1067 (insert "Couldn't find an obvious default for the root of the "
1068 "XEmacs hierarchy.")
1069
1070 (let ((fill-column 76))
1071 (fill-region (point-min) (point-max)))
1072
1073 (princ "\nWARNING:\n" 'external-debugging-output)
1074 (princ (buffer-string) 'external-debugging-output)))
1050 1075
1051 (defun startup-setup-paths-warning () 1076 (defun startup-setup-paths-warning ()
1052 (let ((lock (if (boundp 'lock-directory) lock-directory 't)) 1077 (let ((lock (if (boundp 'lock-directory) lock-directory 't))
1053 warnings message) 1078 warnings message)
1054 (if (and (stringp lock) (null (file-directory-p lock))) 1079 (if (and (stringp lock) (null (file-directory-p lock)))
1074 "XEmacs was built. Perhaps some directories don't exist, " 1099 "XEmacs was built. Perhaps some directories don't exist, "
1075 "or the XEmacs executable, " (concat invocation-directory 1100 "or the XEmacs executable, " (concat invocation-directory
1076 invocation-name) 1101 invocation-name)
1077 " is in a strange place?") 1102 " is in a strange place?")
1078 1103
1079 (if (fboundp 'fill-region) 1104 (let ((fill-column 76))
1080 ;; Might not be bound in the cold load environment... 1105 (fill-region (point-min) (point-max)))
1081 (let ((fill-column 76)) 1106
1082 (fill-region (point-min) (point-max))))
1083 (goto-char (point-min))
1084 (princ "\nWARNING:\n" 'external-debugging-output) 1107 (princ "\nWARNING:\n" 'external-debugging-output)
1085 (princ (buffer-string) 'external-debugging-output) 1108 (princ (buffer-string) 'external-debugging-output)
1086 (erase-buffer) 1109 (erase-buffer)
1087 t))))) 1110 t)))))
1088 1111