X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Floadup.el;h=f29dac8540e7cf69bb6c5f411e5872c8da004e8a;hp=35cc183d5938ecf144618fae46eee9cc7be93117;hb=113b194be934327de99a168d809271db252c07c4;hpb=72a705551741d6f85a40eea486c222bac482d8dc diff --git a/lisp/loadup.el b/lisp/loadup.el index 35cc183..f29dac8 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -34,21 +34,44 @@ ;;; Code: -(if (fboundp 'error) - (error "loadup.el already loaded!")) +(when (fboundp 'error) + (error "loadup.el already loaded!")) (defvar running-xemacs t "Non-nil when the current emacs is XEmacs.") (defvar preloaded-file-list nil "List of files preloaded into the XEmacs binary image.") +(defvar Installation-string nil + "Description of XEmacs installation.") + +(let ((gc-cons-threshold 30000)) + ;; This is awfully damn early to be getting an error, right? (call-with-condition-handler 'really-early-error-handler #'(lambda () - ;; message not defined yet ... + + ;; Initializa Installation-string. We do it before loading + ;; anything so that dumped code can make use of its value. + (setq Installation-string + (save-current-buffer + (set-buffer (get-buffer-create (generate-new-buffer-name + " *temp*"))) + ;; insert-file-contents-internal bogusly calls + ;; format-decode without checking if it's defined. + (fset 'format-decode #'(lambda (f l &optional v) l)) + (insert-file-contents-internal "../Installation") + (fmakunbound 'format-decode) + (prog1 (buffer-substring) + (kill-buffer (current-buffer))))) + (setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH"))) + (setq module-load-path (split-path (getenv "EMACSBOOTSTRAPMODULEPATH"))) + ;; message not defined yet ... (external-debugging-output (format "\nUsing load-path %s" load-path)) + (external-debugging-output (format "\nUsing module-load-path %s" + module-load-path)) ;; We don't want to have any undo records in the dumped XEmacs. (buffer-disable-undo (get-buffer "*scratch*")) @@ -79,11 +102,10 @@ ;; there will be lots of extra space in the data segment filled ;; with garbage-collected junk) (defun pureload (file) - (let ((full-path (locate-file file - load-path - (if load-ignore-elc-files - ".el:" - ".elc:.el:")))) + (let ((full-path + (locate-file file load-path + (if load-ignore-elc-files + '(".el" "") '(".elc" ".el" ""))))) (if full-path (prog1 (load full-path) @@ -95,21 +117,19 @@ ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) nil))) - (load (concat default-directory "../lisp/dumped-lisp.el")) + (load (expand-file-name "../lisp/dumped-lisp.el")) (let ((files preloaded-file-list) file) (while (setq file (car files)) - (or (pureload file) - (progn - (external-debugging-output "Fatal error during load, aborting") - (kill-emacs 1))) + (unless (pureload file) + (external-debugging-output "Fatal error during load, aborting") + (kill-emacs 1)) (setq files (cdr files))) - (if (not (featurep 'toolbar)) - (progn - ;; else still define a few functions. - (defun toolbar-button-p (obj) "No toolbar support." nil) - (defun toolbar-specifier-p (obj) "No toolbar support." nil))) + (when (not (featurep 'toolbar)) + ;; else still define a few functions. + (defun toolbar-button-p (obj) "No toolbar support." nil) + (defun toolbar-specifier-p (obj) "No toolbar support." nil)) (fmakunbound 'pureload)) (packages-load-package-dumped-lisps late-package-load-path) @@ -134,8 +154,8 @@ ;; But you must also cause them to be scanned when the DOC file ;; is generated. For VMS, you must edit ../../vms/makedoc.com. ;; For other systems, you must edit ../../src/Makefile.in.in. -(if (load "site-load" t) - (garbage-collect)) +(when (load "site-load" t) + (garbage-collect)) ;;FSFmacs randomness ;;(if (fboundp 'x-popup-menu) @@ -144,7 +164,6 @@ ;;; for the sake of the next call to precompute-menubar-bindings. ;(setq define-key-rebound-commands nil) - ;; Note: all compiled Lisp files loaded above this point ;; must be among the ones parsed by make-docfile ;; to construct DOC. Any that are not processed @@ -158,29 +177,30 @@ (message "Finding pointers to doc strings...") (Snarf-documentation "DOC") (message "Finding pointers to doc strings...done") - (Verify-documentation) - ) + (Verify-documentation)) ;; Note: You can cause additional libraries to be preloaded ;; by writing a site-init.el that loads them. ;; See also "site-load" above. -(if (stringp site-start-file) - (load "site-init" t)) +(when (stringp site-start-file) + (load "site-init" t)) (setq current-load-list nil) (garbage-collect) ;;; At this point, we're ready to resume undo recording for scratch. (buffer-enable-undo "*scratch*") +) ;; frequent garbage collection + ;; Dump into the name `xemacs' (only) (when (member "dump" command-line-args) - (message "Dumping under the name xemacs") - ;; This is handled earlier in the build process. - ;; (condition-case () (delete-file "xemacs") (file-error nil)) - (when (fboundp 'really-free) - (really-free)) - (dump-emacs (if (featurep 'infodock) "infodock" "xemacs") "temacs") - (kill-emacs)) + (message "Dumping under the name xemacs") + ;; This is handled earlier in the build process. + ;; (condition-case () (delete-file "xemacs") (file-error nil)) + (when (fboundp 'really-free) + (really-free)) + (dump-emacs (if (featurep 'infodock) "infodock" "xemacs") "temacs") + (kill-emacs)) ;; Avoid error if user loads some more libraries now. (setq purify-flag nil) @@ -197,9 +217,9 @@ ;; so that the .el files always get loaded (the .elc files may be out-of- ;; date or bad). (when (member "recompile" command-line-args) - (let ((command-line-args-left (cdr (member "recompile" command-line-args)))) - (batch-byte-recompile-directory) - (kill-emacs))) + (setq command-line-args-left (cdr (member "recompile" command-line-args))) + (batch-byte-recompile-directory) + (kill-emacs)) ;; For machines with CANNOT_DUMP defined in config.h, ;; this file must be loaded each time Emacs is run.