Mercurial > hg > xemacs-beta

comparison lisp/loadup.el @ 380:8626e4521993 r21-2-5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents 6240c7796c7a
children aabb7f5b1c81
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
32 32
33 ;; This is loaded into a bare XEmacs to make a dumpable one. 33 ;; This is loaded into a bare XEmacs to make a dumpable one.
34 34
35 ;;; Code: 35 ;;; Code:
36 36
37 (if (fboundp 'error) 37 (when (fboundp 'error)
38 (error "loadup.el already loaded!")) 38 (error "loadup.el already loaded!"))
39 39
40 (defvar running-xemacs t 40 (defvar running-xemacs t
41 "Non-nil when the current emacs is XEmacs.") 41 "Non-nil when the current emacs is XEmacs.")
42 (defvar preloaded-file-list nil 42 (defvar preloaded-file-list nil
43 "List of files preloaded into the XEmacs binary image.") 43 "List of files preloaded into the XEmacs binary image.")
44 44
45
46 (let ((gc-cons-threshold 30000))
47
45 ;; This is awfully damn early to be getting an error, right? 48 ;; This is awfully damn early to be getting an error, right?
46 (call-with-condition-handler 'really-early-error-handler 49 (call-with-condition-handler 'really-early-error-handler
47 #'(lambda () 50 #'(lambda ()
48 ;; message not defined yet ... 51 ;; message not defined yet ...
49 (setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH"))) 52 (setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH")))
77 ;; garbage collect after loading every file in an attempt to 80 ;; garbage collect after loading every file in an attempt to
78 ;; minimize the size of the dumped image (if we don't do this, 81 ;; minimize the size of the dumped image (if we don't do this,
79 ;; there will be lots of extra space in the data segment filled 82 ;; there will be lots of extra space in the data segment filled
80 ;; with garbage-collected junk) 83 ;; with garbage-collected junk)
81 (defun pureload (file) 84 (defun pureload (file)
82 (let ((full-path (locate-file file 85 (let ((full-path
83 load-path 86 (locate-file file load-path
84 (if load-ignore-elc-files 87 (if load-ignore-elc-files ".el:" ".elc:.el:"))))
85 ".el:"
86 ".elc:.el:"))))
87 (if full-path 88 (if full-path
88 (prog1 89 (prog1
89 (load full-path) 90 (load full-path)
90 (garbage-collect)) 91 (garbage-collect))
91 (external-debugging-output (format "\nLoad file %s: not found\n" 92 (external-debugging-output (format "\nLoad file %s: not found\n"
98 (load (concat default-directory "../lisp/dumped-lisp.el")) 99 (load (concat default-directory "../lisp/dumped-lisp.el"))
99 100
100 (let ((files preloaded-file-list) 101 (let ((files preloaded-file-list)
101 file) 102 file)
102 (while (setq file (car files)) 103 (while (setq file (car files))
103 (or (pureload file) 104 (unless (pureload file)
104 (progn 105 (external-debugging-output "Fatal error during load, aborting")
105 (external-debugging-output "Fatal error during load, aborting") 106 (kill-emacs 1))
106 (kill-emacs 1)))
107 (setq files (cdr files))) 107 (setq files (cdr files)))
108 (if (not (featurep 'toolbar)) 108 (when (not (featurep 'toolbar))
109 (progn 109 ;; else still define a few functions.
110 ;; else still define a few functions. 110 (defun toolbar-button-p (obj) "No toolbar support." nil)
111 (defun toolbar-button-p (obj) "No toolbar support." nil) 111 (defun toolbar-specifier-p (obj) "No toolbar support." nil))
112 (defun toolbar-specifier-p (obj) "No toolbar support." nil)))
113 (fmakunbound 'pureload)) 112 (fmakunbound 'pureload))
114 113
115 (packages-load-package-dumped-lisps late-package-load-path) 114 (packages-load-package-dumped-lisps late-package-load-path)
116 115
117 )) ;; end of call-with-condition-handler 116 )) ;; end of call-with-condition-handler
132 ;; doc strings kept in the DOC file rather than in core, 131 ;; doc strings kept in the DOC file rather than in core,
133 ;; you may load them with a "site-load.el" file. 132 ;; you may load them with a "site-load.el" file.
134 ;; But you must also cause them to be scanned when the DOC file 133 ;; But you must also cause them to be scanned when the DOC file
135 ;; is generated. For VMS, you must edit ../../vms/makedoc.com. 134 ;; is generated. For VMS, you must edit ../../vms/makedoc.com.
136 ;; For other systems, you must edit ../../src/Makefile.in.in. 135 ;; For other systems, you must edit ../../src/Makefile.in.in.
137 (if (load "site-load" t) 136 (when (load "site-load" t)
138 (garbage-collect)) 137 (garbage-collect))
139 138
140 ;;FSFmacs randomness 139 ;;FSFmacs randomness
141 ;;(if (fboundp 'x-popup-menu) 140 ;;(if (fboundp 'x-popup-menu)
142 ;; (precompute-menubar-bindings)) 141 ;; (precompute-menubar-bindings))
143 ;;; Turn on recording of which commands get rebound, 142 ;;; Turn on recording of which commands get rebound,
156 ;; purify-flag is nil if called from loadup-el.el. 155 ;; purify-flag is nil if called from loadup-el.el.
157 (when purify-flag 156 (when purify-flag
158 (message "Finding pointers to doc strings...") 157 (message "Finding pointers to doc strings...")
159 (Snarf-documentation "DOC") 158 (Snarf-documentation "DOC")
160 (message "Finding pointers to doc strings...done") 159 (message "Finding pointers to doc strings...done")
161 (Verify-documentation) 160 (Verify-documentation))
162 )
163 161
164 ;; Note: You can cause additional libraries to be preloaded 162 ;; Note: You can cause additional libraries to be preloaded
165 ;; by writing a site-init.el that loads them. 163 ;; by writing a site-init.el that loads them.
166 ;; See also "site-load" above. 164 ;; See also "site-load" above.
167 (if (stringp site-start-file) 165 (when (stringp site-start-file)
168 (load "site-init" t)) 166 (load "site-init" t))
169 (setq current-load-list nil) 167 (setq current-load-list nil)
170 (garbage-collect) 168 (garbage-collect)
171 169
172 ;;; At this point, we're ready to resume undo recording for scratch. 170 ;;; At this point, we're ready to resume undo recording for scratch.
173 (buffer-enable-undo "*scratch*") 171 (buffer-enable-undo "*scratch*")
174 172
173 ) ;; frequent garbage collection
174
175 ;; Dump into the name `xemacs' (only) 175 ;; Dump into the name `xemacs' (only)
176 (when (member "dump" command-line-args) 176 (when (member "dump" command-line-args)
177 (message "Dumping under the name xemacs") 177 (message "Dumping under the name xemacs")
178 ;; This is handled earlier in the build process. 178 ;; This is handled earlier in the build process.
179 ;; (condition-case () (delete-file "xemacs") (file-error nil)) 179 ;; (condition-case () (delete-file "xemacs") (file-error nil))
180 (when (fboundp 'really-free) 180 (when (fboundp 'really-free)
181 (really-free)) 181 (really-free))
182 (dump-emacs (if (featurep 'infodock) "infodock" "xemacs") "temacs") 182 (dump-emacs (if (featurep 'infodock) "infodock" "xemacs") "temacs")
183 (kill-emacs)) 183 (kill-emacs))
184 184
185 ;; Avoid error if user loads some more libraries now. 185 ;; Avoid error if user loads some more libraries now.
186 (setq purify-flag nil) 186 (setq purify-flag nil)
187 187
188 (when (member "run-temacs" command-line-args) 188 (when (member "run-temacs" command-line-args)
195 ;; XEmacs change 195 ;; XEmacs change
196 ;; If you are using 'recompile', then you should have used -l loadup-el.el 196 ;; If you are using 'recompile', then you should have used -l loadup-el.el
197 ;; so that the .el files always get loaded (the .elc files may be out-of- 197 ;; so that the .el files always get loaded (the .elc files may be out-of-
198 ;; date or bad). 198 ;; date or bad).
199 (when (member "recompile" command-line-args) 199 (when (member "recompile" command-line-args)
200 (let ((command-line-args-left (cdr (member "recompile" command-line-args)))) 200 (setq command-line-args-left (cdr (member "recompile" command-line-args)))
201 (batch-byte-recompile-directory) 201 (batch-byte-recompile-directory)
202 (kill-emacs))) 202 (kill-emacs))
203 203
204 ;; For machines with CANNOT_DUMP defined in config.h, 204 ;; For machines with CANNOT_DUMP defined in config.h,
205 ;; this file must be loaded each time Emacs is run. 205 ;; this file must be loaded each time Emacs is run.
206 ;; So run the startup code now. 206 ;; So run the startup code now.
207 207