Mercurial > hg > xemacs-beta

comparison lisp/loadup.el @ 267:966663fcf606 r20-5b32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b32
author cvs
date Mon, 13 Aug 2007 10:26:29 +0200
parents 677f6a0ee643
children c5d627a313b1
comparison
equal deleted inserted replaced
266:18d185df8c54 267:966663fcf606
1 ;;; loadup.el --- load up standardly loaded Lisp files for XEmacs. 1 ;; loadup.el --- load up standardly loaded Lisp files for XEmacs.
2 2
3 ;; Copyright (C) 1985, 1986, 1992, 1994, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1986, 1992, 1994, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1996 Richard Mlynarik. 4 ;; Copyright (C) 1996 Richard Mlynarik.
5 ;; Copyright (C) 1995, 1996 Ben Wing. 5 ;; Copyright (C) 1995, 1996 Ben Wing.
6 6
46 46
47 ;; This is awfully damn early to be getting an error, right? 47 ;; This is awfully damn early to be getting an error, right?
48 (call-with-condition-handler 'really-early-error-handler 48 (call-with-condition-handler 'really-early-error-handler
49 #'(lambda () 49 #'(lambda ()
50 ;; message not defined yet ... 50 ;; message not defined yet ...
51 (setq load-path (decode-path-internal (getenv "EMACSBOOTSTRAPLOADPATH")))
52
51 (external-debugging-output (format "\nUsing load-path %s" load-path)) 53 (external-debugging-output (format "\nUsing load-path %s" load-path))
52 54
53 ;; We don't want to have any undo records in the dumped XEmacs. 55 ;; We don't want to have any undo records in the dumped XEmacs.
54 (buffer-disable-undo (get-buffer "*scratch*")) 56 (buffer-disable-undo (get-buffer "*scratch*"))
55 57
74 76
75 ;; garbage collect after loading every file in an attempt to 77 ;; garbage collect after loading every file in an attempt to
76 ;; minimize the size of the dumped image (if we don't do this, 78 ;; minimize the size of the dumped image (if we don't do this,
77 ;; there will be lots of extra space in the data segment filled 79 ;; there will be lots of extra space in the data segment filled
78 ;; with garbage-collected junk) 80 ;; with garbage-collected junk)
79 (defun load-gc (file) 81 (defun pureload (file)
80 (let ((full-path (locate-file file 82 (let ((full-path (locate-file file
81 load-path 83 load-path
82 (if load-ignore-elc-files 84 (if load-ignore-elc-files
83 ".el:" 85 ".el:"
84 ".elc:.el:")))) 86 ".elc:.el:"))))
89 (external-debugging-output (format "\nLoad file %s: not found\n" 91 (external-debugging-output (format "\nLoad file %s: not found\n"
90 file)) 92 file))
91 nil))) 93 nil)))
92 94
93 (load (concat default-directory "../lisp/dumped-lisp.el")) 95 (load (concat default-directory "../lisp/dumped-lisp.el"))
96
94 (let ((dumped-lisp-packages preloaded-file-list) 97 (let ((dumped-lisp-packages preloaded-file-list)
95 file) 98 file)
96 (while (setq file (car dumped-lisp-packages)) 99 (while (setq file (car dumped-lisp-packages))
97 (or (load-gc file) 100 (or (pureload file)
98 (progn 101 (progn
99 (external-debugging-output "Fatal error during load, aborting") 102 (external-debugging-output "Fatal error during load, aborting")
100 (kill-emacs 1))) 103 (kill-emacs 1)))
101 (setq dumped-lisp-packages (cdr dumped-lisp-packages))) 104 (setq dumped-lisp-packages (cdr dumped-lisp-packages)))
102 (if (not (featurep 'toolbar)) 105 (if (not (featurep 'toolbar))
103 (progn 106 (progn
104 ;; else still define a few functions. 107 ;; else still define a few functions.
105 (defun toolbar-button-p (obj) "No toolbar support." nil) 108 (defun toolbar-button-p (obj) "No toolbar support." nil)
106 (defun toolbar-specifier-p (obj) "No toolbar support." nil))) 109 (defun toolbar-specifier-p (obj) "No toolbar support." nil)))
107 (fmakunbound 'load-gc)) 110 (fmakunbound 'pureload))
111
112 (if (null inhibit-package-init)
113 (packages-load-package-dumped-lisps late-package-load-path))
114
108 )) ;; end of call-with-condition-handler 115 )) ;; end of call-with-condition-handler
109 116
110 ;; Fix up the preloaded file list 117 ;; Fix up the preloaded file list
111 (setq preloaded-file-list (mapcar #'file-name-sans-extension 118 (setq preloaded-file-list (mapcar #'file-name-sans-extension
112 preloaded-file-list)) 119 preloaded-file-list))