Mercurial > hg > xemacs-beta

comparison lisp/prim/loadup.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ee648375d8d6
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
5 ;; 5 ;;
6 ;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc. 6 ;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
7 ;; Copyright (C) 1996 Richard Mlynarik. 7 ;; Copyright (C) 1996 Richard Mlynarik.
8 ;; Copyright (C) 1995, 1996 Ben Wing. 8 ;; Copyright (C) 1995, 1996 Ben Wing.
9 9
10 ;; Maintainer: FSF
11 ;; Keywords: internal 10 ;; Keywords: internal
12 11
13 ;; This file is part of XEmacs. 12 ;; This file is part of XEmacs.
14 13
15 ;; XEmacs is free software; you can redistribute it and/or modify it 14 ;; XEmacs is free software; you can redistribute it and/or modify it
25 ;; You should have received a copy of the GNU General Public License 24 ;; You should have received a copy of the GNU General Public License
26 ;; along with XEmacs; see the file COPYING. If not, write to the Free 25 ;; along with XEmacs; see the file COPYING. If not, write to the Free
27 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 26 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
28 ;; 02111-1307, USA. 27 ;; 02111-1307, USA.
29 28
30 ;;; Synched up with: Last synched with FSF 19.30, with divergence since. 29 ;;; Synched up with: Last synched with FSF 19.30, with wild divergence since.
31 30
32 ;;; Commentary: 31 ;;; Commentary:
33 32
34 ;; This is loaded into a bare Emacs to make a dumpable one. 33 ;; This is loaded into a bare Emacs to make a dumpable one.
35 34
42 41
43 (call-with-condition-handler 42 (call-with-condition-handler
44 ;; This is awfully damn early to be getting an error, right? 43 ;; This is awfully damn early to be getting an error, right?
45 'really-early-error-handler 44 'really-early-error-handler
46 #'(lambda () 45 #'(lambda ()
47 ; message not defined yet ... 46 ;; message not defined yet ...
48 (external-debugging-output (format "\nUsing load-path %s" load-path)) 47 (external-debugging-output (format "\nUsing load-path %s" load-path))
49 48
50 ;; We don't want to have any undo records in the dumped XEmacs. 49 ;; We don't want to have any undo records in the dumped XEmacs.
51 (buffer-disable-undo (get-buffer "*scratch*")) 50 (buffer-disable-undo (get-buffer "*scratch*"))
52 51
61 (setq load-path (nconc (directory-files temp-path t "^[^-.]" 60 (setq load-path (nconc (directory-files temp-path t "^[^-.]"
62 nil 'dirs-only) 61 nil 'dirs-only)
63 (cons temp-path load-path)))) 62 (cons temp-path load-path))))
64 63
65 (setq load-warn-when-source-newer t ; set to nil at the end 64 (setq load-warn-when-source-newer t ; set to nil at the end
66 load-warn-when-source-only t) 65 load-warn-when-source-only t)
67
68 ;; Inserted for debugging. Something is corrupting a single symbol
69 ;; somewhere to have an integer 0 property list. -slb 6/28/1997.
70 (defun test-atoms ()
71 (mapatoms
72 #'(lambda (symbol)
73 (condition-case nil
74 (get symbol 'custom-group)
75 (t (princ
76 (format "Bad plist in %s, %s\n"
77 (symbol-name symbol)
78 (prin1-to-string (object-plist symbol)))))))))
79 66
80 ;; garbage collect after loading every file in an attempt to 67 ;; garbage collect after loading every file in an attempt to
81 ;; minimize the size of the dumped image (if we don't do this, 68 ;; minimize the size of the dumped image (if we don't do this,
82 ;; there will be lots of extra space in the data segment filled 69 ;; there will be lots of extra space in the data segment filled
83 ;; with garbage-collected junk) 70 ;; with garbage-collected junk)
96 (load-gc "device") 83 (load-gc "device")
97 (load-gc "console") 84 (load-gc "console")
98 (load-gc "obsolete") 85 (load-gc "obsolete")
99 (load-gc "specifier") 86 (load-gc "specifier")
100 (load-gc "faces") ; must be loaded before any make-face call 87 (load-gc "faces") ; must be loaded before any make-face call
101 ;(load-gc "facemenu") #### not yet ported 88 ;;(load-gc "facemenu") #### not yet ported
102 (load-gc "glyphs") 89 (load-gc "glyphs")
103 (load-gc "objects") 90 (load-gc "objects")
104 (load-gc "extents") 91 (load-gc "extents")
105 (load-gc "events") 92 (load-gc "events")
106 (load-gc "text-props") 93 (load-gc "text-props")
111 (load-gc "keydefs") ; Before loaddefs so that keymap vars exist. 98 (load-gc "keydefs") ; Before loaddefs so that keymap vars exist.
112 (load-gc "abbrev") 99 (load-gc "abbrev")
113 (load-gc "derived") 100 (load-gc "derived")
114 (load-gc "minibuf") 101 (load-gc "minibuf")
115 (load-gc "list-mode") 102 (load-gc "list-mode")
116 (load-gc "modeline") ; after simple.el so it can reference functions 103 (load-gc "modeline") ; needs simple.el to be loaded first
117 ; defined there.
118 (load-gc "help")
119 (load-gc "buff-menu")
120 ;; (load-gc "w3-sysdp")
121 (load-gc "widget")
122 (load-gc "custom") ; Before loaddefs so that defcustom exists.
123 ;; If SparcWorks support is included some additional packages are 104 ;; If SparcWorks support is included some additional packages are
124 ;; dumped which would normally have autoloads. To avoid 105 ;; dumped which would normally have autoloads. To avoid
125 ;; duplicate doc string warnings, SparcWorks uses a separate 106 ;; duplicate doc string warnings, SparcWorks uses a separate
126 ;; autoloads file with the dumped packages removed. 107 ;; autoloads file with the dumped packages removed.
127 ;;; After fixing, eos/loaddefs-eos and loaddefs appear identical?!! 108 ;; After fixing, eos/loaddefs-eos and loaddefs appear identical?!!
128 ;;; So just make loaddefs-eos go away... 109 ;; So just make loaddefs-eos go away...
129 ;;;(load-gc (if (featurep 'sparcworks) "eos/loaddefs-eos" "loaddefs")) 110 ;;(load-gc (if (featurep 'sparcworks) "eos/loaddefs-eos" "loaddefs"))
130 (load-gc "loaddefs") ; <=== autoloads get put here 111 (load-gc "loaddefs")
131 (load-gc "misc") 112 (load-gc "misc")
132 (load-gc "profile") 113 (load-gc "profile")
114 (load-gc "help")
133 ;; (load-gc "hyper-apropos") Soon... 115 ;; (load-gc "hyper-apropos") Soon...
116 (when (not (featurep 'mule))
117 (load-gc "files-nomule"))
134 (load-gc "files") 118 (load-gc "files")
135 (load-gc "lib-complete") 119 (load-gc "lib-complete")
136 (load-gc "format") 120 (load-gc "format")
137 (load-gc "indent") 121 (load-gc "indent")
138 (load-gc "isearch-mode") 122 (load-gc "isearch-mode")
139 (load-gc "buffer") 123 (load-gc "buffer")
124 (load-gc "buff-menu")
140 (load-gc "undo-stack") 125 (load-gc "undo-stack")
141 (load-gc "window") 126 (load-gc "window")
142 (load-gc "paths.el") ; don't get confused if paths compiled. 127 (load-gc "paths.el") ; don't get confused if paths compiled.
143 (load-gc "startup") 128 (load-gc "startup")
144 (load-gc "lisp") 129 (load-gc "lisp")
148 ; (sets standard syntax table.) 133 ; (sets standard syntax table.)
149 (load-gc "paragraphs") 134 (load-gc "paragraphs")
150 (load-gc "lisp-mode") 135 (load-gc "lisp-mode")
151 (load-gc "text-mode") 136 (load-gc "text-mode")
152 (load-gc "fill") 137 (load-gc "fill")
153 ;; (load-gc "cc-mode") ; as FSF goes so go we .. 138 (load-gc "cc-mode")
154 ;; (load-gc "scroll-in-place") ; We're not ready for this :-(
155 ;; we no longer load buff-menu automatically. 139 ;; we no longer load buff-menu automatically.
156 ;; it will get autoloaded if needed. 140 ;; it will get autoloaded if needed.
157 141
158 (cond ; Differences based on system-type 142 (cond ; Differences based on system-type
159 ((eq system-type 'vax-vms) 143 ((eq system-type 'vax-vms)
168 (load-gc "disp-table"))) ; needed to setup ibm-pc char set, 152 (load-gc "disp-table"))) ; needed to setup ibm-pc char set,
169 ; see internal.el 153 ; see internal.el
170 (when (featurep 'lisp-float-type) 154 (when (featurep 'lisp-float-type)
171 (load-gc "float-sup")) 155 (load-gc "float-sup"))
172 (load-gc "itimer") ; for vars auto-save-timeout and auto-gc-threshold 156 (load-gc "itimer") ; for vars auto-save-timeout and auto-gc-threshold
173 (load-gc "itimer-autosave")
174 (if (featurep 'toolbar) 157 (if (featurep 'toolbar)
175 (load-gc "toolbar") 158 (load-gc "toolbar")
176 ;; else still define a few functions. 159 ;; else still define a few functions.
177 (defun toolbar-button-p (obj) "No toolbar support." nil) 160 (defun toolbar-button-p (obj) "No toolbar support." nil)
178 (defun toolbar-specifier-p (obj) "No toolbar support." nil)) 161 (defun toolbar-specifier-p (obj) "No toolbar support." nil))
179 (when (featurep 'scrollbar) 162 (when (featurep 'scrollbar)
180 (load-gc "scrollbar")) 163 (load-gc "scrollbar"))
181 (when (featurep 'menubar) 164 (when (featurep 'menubar)
182 (load-gc "menubar")) 165 (load-gc "menubar"))
183 (when (featurep 'dialog) 166 (when (featurep 'dialog)
184 (load-gc "dialog")) 167 (load-gc "dialog"))
168 (when (featurep 'mule)
169 (load-gc "mule-load.el"))
185 (when (featurep 'window-system) 170 (when (featurep 'window-system)
186 (load-gc "gui") 171 (load-gc "gui")
187 (load-gc "mode-motion") 172 (load-gc "mode-motion")
188 (load-gc "mouse")) 173 (load-gc "mouse"))
189 (when (featurep 'x) 174 (when (featurep 'x)
190 ;; preload the X code, for faster startup. 175 ;; preload the X code, for faster startup.
191 (when (featurep 'menubar) 176 (when (featurep 'menubar)
192 (load-gc "x-menubar") 177 (load-gc "x-menubar")
193 ;; autoload this. 178 ;; autoload this.
194 ;;(load-gc "x-font-menu") 179 ;;(load-gc "x-font-menu")
195 ) 180 )
196 (load-gc "x-faces") 181 (load-gc "x-faces")
197 (load-gc "x-iso8859-1") 182 (load-gc "x-iso8859-1")
198 (load-gc "x-mouse") 183 (load-gc "x-mouse")
199 (load-gc "x-select") 184 (load-gc "x-select")
200 (when (featurep 'scrollbar) 185 (when (featurep 'scrollbar)
201 (load-gc "x-scrollbar")) 186 (load-gc "x-scrollbar"))
202 (load-gc "x-misc") 187 (load-gc "x-misc")
203 (load-gc "x-init") 188 (load-gc "x-init")
204 (when (featurep 'toolbar) 189 (when (featurep 'toolbar)
205 (load-gc "x-toolbar")) 190 (load-gc "x-toolbar"))
206 ) 191 )
207 (when (featurep 'tty) 192 (when (featurep 'tty)
208 ;; preload the TTY init code. 193 ;; preload the TTY init code.
209 (load-gc "tty-init")) 194 (load-gc "tty-init"))
210 (when (featurep 'tooltalk) 195 (when (featurep 'tooltalk)
215 (load-gc "auto-show") 200 (load-gc "auto-show")
216 (when (featurep 'energize) 201 (when (featurep 'energize)
217 (load-gc "energize/energize-load.el")) 202 (load-gc "energize/energize-load.el"))
218 (when (featurep 'sparcworks) 203 (when (featurep 'sparcworks)
219 (load-gc "sunpro/sunpro-load.el")) 204 (load-gc "sunpro/sunpro-load.el"))
220 (load-gc "custom-load")
221 (fmakunbound 'load-gc) 205 (fmakunbound 'load-gc)
222 )) ;; end of call-with-condition-handler 206 )) ;; end of call-with-condition-handler
223 207
224 208
225 (setq load-warn-when-source-newer t ; set to t at top of file 209 (setq load-warn-when-source-newer t ; set to t at top of file
226 load-warn-when-source-only nil) 210 load-warn-when-source-only nil)
227 211
228 (setq debugger 'debug) 212 (setq debugger 'debug)
229 213
230 (if (or (equal (nth 4 command-line-args) "no-site-file") 214 (when (member "no-site-file" command-line-args)
231 (equal (nth 5 command-line-args) "no-site-file")) 215 (setq site-start-file nil))
232 (setq site-start-file nil))
233 216
234 ;; If you want additional libraries to be preloaded and their 217 ;; If you want additional libraries to be preloaded and their
235 ;; doc strings kept in the DOC file rather than in core, 218 ;; doc strings kept in the DOC file rather than in core,
236 ;; you may load them with a "site-load.el" file. 219 ;; you may load them with a "site-load.el" file.
237 ;; But you must also cause them to be scanned when the DOC file 220 ;; But you must also cause them to be scanned when the DOC file
238 ;; is generated. For VMS, you must edit ../../vms/makedoc.com. 221 ;; is generated. For VMS, you must edit ../../vms/makedoc.com.
239 ;; For other systems, you must edit ../../src/Makefile.in.in. 222 ;; For other systems, you must edit ../../src/Makefile.in.in.
240 (if (load "site-load" t) 223 (if (load "site-load" t)
241 (garbage-collect)) 224 (garbage-collect))
242 225
243 ;FSFmacs randomness 226 ;;FSFmacs randomness
244 ;(if (fboundp 'x-popup-menu) 227 ;;(if (fboundp 'x-popup-menu)
245 ; (precompute-menubar-bindings)) 228 ;; (precompute-menubar-bindings))
246 ;;; Turn on recording of which commands get rebound, 229 ;;; Turn on recording of which commands get rebound,
247 ;;; for the sake of the next call to precompute-menubar-bindings. 230 ;;; for the sake of the next call to precompute-menubar-bindings.
248 ;(setq define-key-rebound-commands nil) 231 ;(setq define-key-rebound-commands nil)
249 232
250 ;;FSFmacs #### what?
251 ;; Determine which last version number to use
252 ;; based on the executables that now exist.
253 ;(if (and (or (equal (nth 3 command-line-args) "dump")
254 ; (equal (nth 4 command-line-args) "dump"))
255 ; (not (eq system-type 'ms-dos)))
256 ; (let* ((base (concat "emacs-" emacs-version "."))
257 ; (files (file-name-all-completions base default-directory))
258 ; (versions (mapcar (function (lambda (name)
259 ; (string-to-int (substring name (length base)))))
260 ; files)))
261 ; (setq emacs-version (format "%s.%d"
262 ; emacs-version
263 ; (if versions
264 ; (1+ (apply 'max versions))
265 ; 1)))))
266 233
267 ;; Note: all compiled Lisp files loaded above this point 234 ;; Note: all compiled Lisp files loaded above this point
268 ;; must be among the ones parsed by make-docfile 235 ;; must be among the ones parsed by make-docfile
269 ;; to construct DOC. Any that are not processed 236 ;; to construct DOC. Any that are not processed
270 ;; for DOC will not have doc strings in the dumped XEmacs. 237 ;; for DOC will not have doc strings in the dumped XEmacs.
271 238
272 ;; Don't bother with these if we're running temacs, i.e. if we're 239 ;; Don't bother with these if we're running temacs, i.e. if we're
273 ;; just debugging don't waste time finding doc strings. 240 ;; just debugging don't waste time finding doc strings.
274 241
275 (if (or (equal (nth 3 command-line-args) "dump") 242 ;; purify-flag is nil if called from loadup-el.el.
276 (equal (nth 4 command-line-args) "dump")) 243 (when purify-flag
277 (progn 244 (message "Finding pointers to doc strings...")
278 (message "Finding pointers to doc strings...") 245 (Snarf-documentation "DOC")
279 (if (fboundp 'dump-emacs) 246 (message "Finding pointers to doc strings...done")
280 (let ((name emacs-version)) 247 (Verify-documentation))
281 (string-match " Lucid" name) 248
282 (setq name (concat (substring name 0 (match-beginning 0)) 249 ;; Note: You can cause additional libraries to be preloaded
283 (substring name (match-end 0)))) 250 ;; by writing a site-init.el that loads them.
284 (while (string-match "[^-+_.a-zA-Z0-9]+" name) 251 ;; See also "site-load" above.
285 (setq name (concat
286 (downcase (substring name 0 (match-beginning 0)))
287 "-"
288 (substring name (match-end 0)))))
289 (if (string-match "-+\\'" name)
290 (setq name (substring name 0 (match-beginning 0))))
291 (if (memq system-type '(ms-dos windows-nt))
292 (setq name (expand-file-name
293 (if (fboundp 'make-frame) "DOC-X" "DOC") "../etc"))
294 (setq name (concat (expand-file-name "DOC-" "../lib-src") name))
295 (if (file-exists-p name)
296 (delete-file name))
297 (copy-file (expand-file-name "DOC" "../lib-src") name t))
298 (Snarf-documentation (file-name-nondirectory name)))
299 (Snarf-documentation "DOC"))
300 (message "Finding pointers to doc strings...done")
301 (Verify-documentation)
302 ))
303
304 ; Note: You can cause additional libraries to be preloaded
305 ; by writing a site-init.el that loads them.
306 ; See also "site-load" above.
307 (if (stringp site-start-file) 252 (if (stringp site-start-file)
308 (load "site-init" t)) 253 (load "site-init" t))
309 (setq current-load-list nil) 254 (setq current-load-list nil)
310 (garbage-collect) 255 (garbage-collect)
311 256
312 ;;; At this point, we're ready to resume undo recording for scratch. 257 ;;; At this point, we're ready to resume undo recording for scratch.
313 (buffer-enable-undo "*scratch*") 258 (buffer-enable-undo "*scratch*")
314 259
315 (if (or (equal (nth 3 command-line-args) "dump") 260 ;; Dump into the name `xemacs' (only)
316 (equal (nth 4 command-line-args) "dump")) 261 (when (member "dump" command-line-args)
317 (if (eq system-type 'vax-vms) 262 (message "Dumping under the name xemacs")
318 (progn 263 (condition-case () (delete-file "xemacs") (file-error nil))
319 (setq command-line-args nil) 264 (when (fboundp 'really-free)
320 (message "Dumping data as file temacs.dump") 265 (really-free))
321 (dump-emacs "temacs.dump" "temacs") 266 (dump-emacs "xemacs" "temacs")
322 (kill-emacs)) 267 (kill-emacs))
323 (let ((name (concat "emacs-" emacs-version))) 268
324 (string-match " Lucid" name) 269 (when (member "run-temacs" command-line-args)
325 (setq name (concat (substring name 0 (match-beginning 0)) 270 (message "\nBootstrapping from temacs...")
326 (substring name (match-end 0)))) 271 (setq purify-flag nil)
327 (while (string-match "[^-+_.a-zA-Z0-9]+" name) 272 ;; Remove all args up to and including "run-temacs"
328 (setq name (concat (downcase (substring name 0 (match-beginning 0))) 273 (apply #'run-emacs-from-temacs (cdr (member "run-temacs" command-line-args)))
329 "-" 274 ;; run-emacs-from-temacs doesn't actually return anyway.
330 (substring name (match-end 0))))) 275 (kill-emacs))
331 (if (string-match "-+\\'" name)
332 (setq name (substring name 0 (match-beginning 0))))
333 (if (eq system-type 'ms-dos)
334 (message "Dumping under the name xemacs")
335 (message "Dumping under names xemacs and %s" name))
336 (condition-case () (delete-file name ) (file-error nil))
337 (condition-case () (delete-file "xemacs") (file-error nil))
338 )
339 (if (fboundp 'really-free)
340 (really-free))
341 ;; Note that FSF used to dump under `xemacs'!
342 (dump-emacs "xemacs" "temacs")
343 ;This is done automatically.
344 ;(message "%d pure bytes used" pure-bytes-used)
345 ;; Recompute NAME now, so that it isn't set when we dump.
346 (if (not (memq system-type '(ms-dos windows-nt)))
347 (let ((name (concat "emacs-" emacs-version)))
348 (string-match " Lucid" name)
349 (setq name (concat (substring name 0 (match-beginning 0))
350 (substring name (match-end 0))))
351 (while (string-match "[^-+_.a-zA-Z0-9]+" name)
352 (setq name (concat (downcase (substring name 0
353 (match-beginning 0)))
354 "-"
355 (substring name (match-end 0)))))
356 (if (string-match "-+\\'" name)
357 (setq name (substring name 0 (match-beginning 0))))
358 (add-name-to-file "xemacs" name t)))
359 (kill-emacs)))
360
361 (if (or (equal (nth 3 command-line-args) "run-temacs")
362 (equal (nth 4 command-line-args) "run-temacs"))
363 (progn
364 ;; purify-flag is nil if called from loadup-el.el.
365 (if purify-flag
366 (progn
367 (message "\nSnarfing doc...")
368 (Snarf-documentation "DOC")
369 (Verify-documentation)))
370 (message "\nBootstrapping from temacs...")
371 (setq purify-flag nil)
372 (apply #'run-emacs-from-temacs
373 (nthcdr (if (equal (nth 3 command-line-args) "run-temacs")
374 4 5)
375 command-line-args))
376 ;; run-emacs-from-temacs doesn't actually return anyway.
377 (kill-emacs)))
378 276
379 ;; Avoid error if user loads some more libraries now. 277 ;; Avoid error if user loads some more libraries now.
380 (setq purify-flag nil) 278 (setq purify-flag nil)
381 279
382 ;; XEmacs change 280 ;; XEmacs change
383 ;; If you are using 'recompile', then you should have used -l loadup-el.el 281 ;; If you are using 'recompile', then you should have used -l loadup-el.el
384 ;; so that the .el files always get loaded (the .elc files may be out-of- 282 ;; so that the .el files always get loaded (the .elc files may be out-of-
385 ;; date or bad). 283 ;; date or bad).
386 (if (or (equal (nth 3 command-line-args) "recompile") 284 (when (member "recompile" command-line-args)
387 (equal (nth 4 command-line-args) "recompile")) 285 (let ((command-line-args-left (cdr (member "recompile" command-line-args))))
388 (progn 286 (batch-byte-recompile-directory)
389 (let ((command-line-args-left 287 (kill-emacs)))
390 (nthcdr (if (equal (nth 3 command-line-args) "recompile")
391 4 5)
392 command-line-args)))
393 (batch-byte-recompile-directory)
394 (kill-emacs))))
395
396 288
397 ;; For machines with CANNOT_DUMP defined in config.h, 289 ;; For machines with CANNOT_DUMP defined in config.h,
398 ;; this file must be loaded each time Emacs is run. 290 ;; this file must be loaded each time Emacs is run.
399 ;; So run the startup code now. 291 ;; So run the startup code now.
400 292
401 (or (fboundp 'dump-emacs) 293 (when (not (fboundp 'dump-emacs))
402 (progn 294 ;; Avoid loading loadup.el a second time!
403 ;; Avoid loading loadup.el a second time! 295 (setq command-line-args (cdr (cdr command-line-args)))
404 (setq command-line-args (cdr (cdr command-line-args))) 296 (eval top-level))
405 (eval top-level)))
406 297
407 ;;; loadup.el ends here 298 ;;; loadup.el ends here