Mercurial > hg > xemacs-beta

comparison lisp/loadup.el @ 406:b8cc9ab3f761 r21-2-33

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-33
author cvs
date Mon, 13 Aug 2007 11:17:09 +0200
parents 5a2589c672dc
children 697ef44129c6
comparison
equal deleted inserted replaced
405:0e08f63c74d2 406:b8cc9ab3f761
43 "List of files preloaded into the XEmacs binary image.") 43 "List of files preloaded into the XEmacs binary image.")
44 44
45 (defvar Installation-string nil 45 (defvar Installation-string nil
46 "Description of XEmacs installation.") 46 "Description of XEmacs installation.")
47 47
48 (let ((gc-cons-threshold 30000)) 48 ;(start-profiling)
49
50 (let ((gc-cons-threshold
51 ;; setting it low makes loadup incredibly fucking slow.
52 ;; no need to do it when not dumping.
53 (if (and purify-flag
54 (not (memq 'quick-build internal-error-checking)))
55 30000 3000000)))
49 56
50 ;; This is awfully damn early to be getting an error, right? 57 ;; This is awfully damn early to be getting an error, right?
51 (call-with-condition-handler 'really-early-error-handler 58 (call-with-condition-handler 'really-early-error-handler
52 #'(lambda () 59 #'(lambda ()
53 60
108 (if load-ignore-elc-files 115 (if load-ignore-elc-files
109 '(".el" "") '(".elc" ".el" ""))))) 116 '(".el" "") '(".elc" ".el" "")))))
110 (if full-path 117 (if full-path
111 (prog1 118 (prog1
112 (load full-path) 119 (load full-path)
113 (garbage-collect)) 120 ;; but garbage collection really slows down loading.
121 (unless (memq 'quick-build internal-error-checking)
122 (garbage-collect)))
114 (external-debugging-output (format "\nLoad file %s: not found\n" 123 (external-debugging-output (format "\nLoad file %s: not found\n"
115 file)) 124 file))
116 ;; Uncomment in case of trouble 125 ;; Uncomment in case of trouble
117 ;;(print (format "late-packages: %S" late-packages)) 126 ;;(print (format "late-packages: %S" late-packages))
118 ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) 127 ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name)))
154 ;; you may load them with a "site-load.el" file. 163 ;; you may load them with a "site-load.el" file.
155 ;; But you must also cause them to be scanned when the DOC file 164 ;; But you must also cause them to be scanned when the DOC file
156 ;; is generated. For VMS, you must edit ../../vms/makedoc.com. 165 ;; is generated. For VMS, you must edit ../../vms/makedoc.com.
157 ;; For other systems, you must edit ../../src/Makefile.in.in. 166 ;; For other systems, you must edit ../../src/Makefile.in.in.
158 (when (load "site-load" t) 167 (when (load "site-load" t)
159 (garbage-collect)) 168 (garbage-collect)
169 )
160 170
161 ;;FSFmacs randomness 171 ;;FSFmacs randomness
162 ;;(if (fboundp 'x-popup-menu) 172 ;;(if (fboundp 'x-popup-menu)
163 ;; (precompute-menubar-bindings)) 173 ;; (precompute-menubar-bindings))
164 ;;; Turn on recording of which commands get rebound, 174 ;;; Turn on recording of which commands get rebound,
190 200
191 ;;; At this point, we're ready to resume undo recording for scratch. 201 ;;; At this point, we're ready to resume undo recording for scratch.
192 (buffer-enable-undo "*scratch*") 202 (buffer-enable-undo "*scratch*")
193 203
194 ) ;; frequent garbage collection 204 ) ;; frequent garbage collection
205
206 ;(stop-profiling)
207
208 ;; yuck! need to insert the function def here, and rewrite the dolist
209 ;; loop below.
210
211 ;(defun loadup-profile-results (&optional info stream)
212 ; "Print profiling info INFO to STREAM in a pretty format.
213 ;If INFO is omitted, the current profiling info is retrieved using
214 ; `get-profiling-info'.
215 ;If STREAM is omitted, either a *Profiling Results* buffer or standard
216 ; output are used, depending on whether the function was called
217 ; interactively or not."
218 ; (interactive)
219 ; (setq info (if info
220 ; (copy-alist info)
221 ; (get-profiling-info)))
222 ; (when (and (not stream)
223 ; (interactive-p))
224 ; (pop-to-buffer (get-buffer-create "*Profiling Results*"))
225 ; (erase-buffer))
226 ; (let ((standard-output (or stream (if (interactive-p)
227 ; (current-buffer)
228 ; standard-output)))
229 ; ;; Calculate the longest function
230 ; (maxfunlen (apply #'max
231 ; (length "Function Name")
232 ; (mapcar
233 ; (lambda (el)
234 ; ;; Functions longer than 50 characters (usually
235 ; ;; anonymous functions) don't qualify
236 ; (let ((l (length (format "%s" (car el)))))
237 ; (if (< l 50)
238 ; l 0)))
239 ; info))))
240 ; (princ (format "%-*s Ticks %%/Total Call Count\n"
241 ; maxfunlen "Function Name"))
242 ; (princ (make-string maxfunlen ?=))
243 ; (princ " ===== ======= ==========\n")
244 ; (let ((sum (float (apply #'+ (mapcar #'cdr info)))))
245 ; (let (entry
246 ; (entry-list (nreverse (sort info #'cdr-less-than-cdr))))
247 ; (while entry-list
248 ; (setq entry (car entry-list))
249 ; (princ (format "%-*s %-5d %-6.3f %s\n"
250 ; maxfunlen (car entry) (cdr entry)
251 ; (* 100 (/ (cdr entry) sum))
252 ; (or (gethash (car entry) call-count-profile-table)
253 ; "")))
254 ; (setq entry-list (cdr entry-list))))
255 ; (princ (make-string maxfunlen ?-))
256 ; (princ "---------------------------------\n")
257 ; (princ (format "%-*s %-5d %-6.2f\n" maxfunlen "Total" sum 100.0))
258 ; (princ (format "\n\nOne tick = %g ms\n"
259 ; (/ default-profiling-interval 1000.0)))
260 ; (and (boundp 'internal-error-checking)
261 ; internal-error-checking
262 ; (princ "
263 ;WARNING: Error checking is turned on in this XEmacs. This might make
264 ; the measurements very unreliable.\n"))))
265 ; (when (and (not stream)
266 ; (interactive-p))
267 ; (goto-char (point-min))))
268
269 ;(loadup-profile-results nil 'external-debugging-output)
195 270
196 ;; Dump into the name `xemacs' (only) 271 ;; Dump into the name `xemacs' (only)
197 (when (member "dump" command-line-args) 272 (when (member "dump" command-line-args)
198 (message "Dumping under the name xemacs") 273 (message "Dumping under the name xemacs")
199 ;; This is handled earlier in the build process. 274 ;; This is handled earlier in the build process.