Mercurial > hg > xemacs-beta
comparison lisp/loadup.el @ 209:41ff10fd062f r20-4b3
Import from CVS: tag r20-4b3
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:04:58 +0200 |
parents | |
children | 1f0dabaa0855 |
comparison
equal
deleted
inserted
replaced
208:f427b8ec4379 | 209:41ff10fd062f |
---|---|
1 ;;; loadup.el --- load up standardly loaded Lisp files for XEmacs. | |
2 | |
3 ;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc. | |
4 ;; Copyright (C) 1996 Richard Mlynarik. | |
5 ;; Copyright (C) 1995, 1996 Ben Wing. | |
6 | |
7 ;; Keywords: internal | |
8 | |
9 ;; This file is part of XEmacs. | |
10 | |
11 ;; XEmacs is free software; you can redistribute it and/or modify it | |
12 ;; under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; XEmacs is distributed in the hope that it will be useful, but | |
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
19 ;; General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
24 ;; 02111-1307, USA. | |
25 | |
26 ;;; Synched up with: Last synched with FSF 19.30, with wild divergence since. | |
27 | |
28 ;;; Commentary: | |
29 | |
30 ;; It is not a good idea to edit this file. Use site-init.el or site-load.el | |
31 ;; instead. | |
32 ;; | |
33 ;; This is loaded into a bare Emacs to make a dumpable one. | |
34 | |
35 ;;; Code: | |
36 | |
37 (if (fboundp 'error) | |
38 (error "loadup.el already loaded!")) | |
39 | |
40 (define-function 'defalias 'define-function) | |
41 (defvar running-xemacs t | |
42 "Non-nil when the current emacsen is XEmacs.") | |
43 (defvar preloaded-file-list nil | |
44 "List of files preloaded into the XEmacs binary image.") | |
45 | |
46 (call-with-condition-handler | |
47 ;; This is awfully damn early to be getting an error, right? | |
48 'really-early-error-handler | |
49 #'(lambda () | |
50 ;; message not defined yet ... | |
51 (external-debugging-output (format "\nUsing load-path %s" load-path)) | |
52 | |
53 ;; We don't want to have any undo records in the dumped XEmacs. | |
54 (buffer-disable-undo (get-buffer "*scratch*")) | |
55 | |
56 ;; lread.c (or src/Makefile.in.in) has prepended "${srcdir}/../lisp/" | |
57 ;; to load-path, which is how this file has been found. At this point, | |
58 ;; enough of emacs has been initialized that we can call directory-files | |
59 ;; and get the rest of the dirs (so that we can dump stuff from modes/ | |
60 ;; and packages/.) | |
61 ;; | |
62 (let ((temp-path (expand-file-name "." (car load-path)))) | |
63 (setq source-directory temp-path) | |
64 (setq load-path (nconc (mapcar | |
65 #'(lambda (i) (concat i "/")) | |
66 (directory-files temp-path t "^[^-.]" | |
67 nil 'dirs-only)) | |
68 (cons (file-name-as-directory temp-path) | |
69 load-path)))) | |
70 | |
71 (setq load-warn-when-source-newer t ; set to nil at the end | |
72 load-warn-when-source-only t) | |
73 | |
74 ;; Inserted for debugging. Something is corrupting a single symbol | |
75 ;; somewhere to have an integer 0 property list. -slb 6/28/1997. | |
76 (defun test-atoms () | |
77 (mapatoms | |
78 #'(lambda (symbol) | |
79 (condition-case nil | |
80 (get symbol 'custom-group) | |
81 (t (princ | |
82 (format "Bad plist in %s, %s\n" | |
83 (symbol-name symbol) | |
84 (prin1-to-string (object-plist symbol))))))))) | |
85 | |
86 ;; garbage collect after loading every file in an attempt to | |
87 ;; minimize the size of the dumped image (if we don't do this, | |
88 ;; there will be lots of extra space in the data segment filled | |
89 ;; with garbage-collected junk) | |
90 (defmacro load-gc (file) | |
91 (list 'prog1 (list 'load file) | |
92 ;; '(test-atoms) | |
93 '(garbage-collect))) | |
94 ;; Need a minimal number hardcoded to get going for now. | |
95 ;; (load-gc "backquote") ; needed for defsubst etc. | |
96 ;; (load-gc "bytecomp-runtime") ; define defsubst | |
97 ;; (load-gc "subr") ; load the most basic Lisp functions | |
98 ;; (load-gc "replace") ; match-string used in version.el. | |
99 ;; (load-gc "version.el") ; Ignore compiled-by-mistake version.elc | |
100 ;; (load-gc "cl") | |
101 ;; (load-gc "featurep") ; OBSOLETE now | |
102 (load "dumped-lisp.el") | |
103 (let ((dumped-lisp-packages preloaded-file-list) | |
104 file) | |
105 (while (setq file (car dumped-lisp-packages)) | |
106 (load-gc file) | |
107 (setq dumped-lisp-packages (cdr dumped-lisp-packages))) | |
108 (if (not (featurep 'toolbar)) | |
109 (progn | |
110 ;; else still define a few functions. | |
111 (defun toolbar-button-p (obj) "No toolbar support." nil) | |
112 (defun toolbar-specifier-p (obj) "No toolbar support." nil))) | |
113 (fmakunbound 'load-gc)) | |
114 )) ;; end of call-with-condition-handler | |
115 | |
116 | |
117 ;; Fix up the preloaded file list | |
118 (setq preloaded-file-list (mapcar #'file-name-sans-extension | |
119 preloaded-file-list)) | |
120 | |
121 (setq load-warn-when-source-newer t ; set to t at top of file | |
122 load-warn-when-source-only nil) | |
123 | |
124 (setq debugger 'debug) | |
125 | |
126 (when (member "no-site-file" command-line-args) | |
127 (setq site-start-file nil)) | |
128 | |
129 ;; If you want additional libraries to be preloaded and their | |
130 ;; doc strings kept in the DOC file rather than in core, | |
131 ;; you may load them with a "site-load.el" file. | |
132 ;; But you must also cause them to be scanned when the DOC file | |
133 ;; is generated. For VMS, you must edit ../../vms/makedoc.com. | |
134 ;; For other systems, you must edit ../../src/Makefile.in.in. | |
135 (if (load "site-load" t) | |
136 (garbage-collect)) | |
137 | |
138 ;;FSFmacs randomness | |
139 ;;(if (fboundp 'x-popup-menu) | |
140 ;; (precompute-menubar-bindings)) | |
141 ;;; Turn on recording of which commands get rebound, | |
142 ;;; for the sake of the next call to precompute-menubar-bindings. | |
143 ;(setq define-key-rebound-commands nil) | |
144 | |
145 | |
146 ;; Note: all compiled Lisp files loaded above this point | |
147 ;; must be among the ones parsed by make-docfile | |
148 ;; to construct DOC. Any that are not processed | |
149 ;; for DOC will not have doc strings in the dumped XEmacs. | |
150 | |
151 ;; Don't bother with these if we're running temacs, i.e. if we're | |
152 ;; just debugging don't waste time finding doc strings. | |
153 | |
154 ;; purify-flag is nil if called from loadup-el.el. | |
155 (when purify-flag | |
156 (message "Finding pointers to doc strings...") | |
157 ;; (test-atoms) ; Debug -- Doesn't happen here | |
158 (Snarf-documentation "DOC") | |
159 ;; (test-atoms) ; Debug -- Doesn't happen here | |
160 (message "Finding pointers to doc strings...done") | |
161 (Verify-documentation) | |
162 ;; (test-atoms) ; Debug -- Doesn't happen here | |
163 ) | |
164 | |
165 ;; Note: You can cause additional libraries to be preloaded | |
166 ;; by writing a site-init.el that loads them. | |
167 ;; See also "site-load" above. | |
168 (if (stringp site-start-file) | |
169 (load "site-init" t)) | |
170 (setq current-load-list nil) | |
171 (garbage-collect) | |
172 | |
173 ;;; At this point, we're ready to resume undo recording for scratch. | |
174 (buffer-enable-undo "*scratch*") | |
175 | |
176 ;; Dump into the name `xemacs' (only) | |
177 (when (member "dump" command-line-args) | |
178 (message "Dumping under the name xemacs") | |
179 (condition-case () (delete-file "xemacs") (file-error nil)) | |
180 (when (fboundp 'really-free) | |
181 (really-free)) | |
182 (dump-emacs "xemacs" "temacs") | |
183 (kill-emacs)) | |
184 | |
185 (when (member "run-temacs" command-line-args) | |
186 (message "\nBootstrapping from temacs...") | |
187 (setq purify-flag nil) | |
188 ;; Remove all args up to and including "run-temacs" | |
189 (apply #'run-emacs-from-temacs (cdr (member "run-temacs" command-line-args))) | |
190 ;; run-emacs-from-temacs doesn't actually return anyway. | |
191 (kill-emacs)) | |
192 | |
193 ;; Avoid error if user loads some more libraries now. | |
194 (setq purify-flag nil) | |
195 | |
196 ;; XEmacs change | |
197 ;; If you are using 'recompile', then you should have used -l loadup-el.el | |
198 ;; so that the .el files always get loaded (the .elc files may be out-of- | |
199 ;; date or bad). | |
200 (when (member "recompile" command-line-args) | |
201 (let ((command-line-args-left (cdr (member "recompile" command-line-args)))) | |
202 (batch-byte-recompile-directory) | |
203 (kill-emacs))) | |
204 | |
205 ;; For machines with CANNOT_DUMP defined in config.h, | |
206 ;; this file must be loaded each time Emacs is run. | |
207 ;; So run the startup code now. | |
208 | |
209 (when (not (fboundp 'dump-emacs)) | |
210 ;; Avoid loading loadup.el a second time! | |
211 (setq command-line-args (cdr (cdr command-line-args))) | |
212 (eval top-level)) | |
213 | |
214 ;;; loadup.el ends here |