comparison lisp/loadup.el @ 4246:9fec7fedbf1b

[xemacs-hg @ 2007-10-31 11:21:02 by aidan] Use correct coding system information for Installation-string.
author aidan
date Wed, 31 Oct 2007 11:21:15 +0000
parents 6b2ef948e140
children 061e030e3270
comparison
equal deleted inserted replaced
4245:119b227b734c 4246:9fec7fedbf1b
66 "Root of tree containing source code for the current build. 66 "Root of tree containing source code for the current build.
67 Used during loadup and for documenting source of symbols defined in C.") 67 Used during loadup and for documenting source of symbols defined in C.")
68 68
69 (defvar preloaded-file-list nil 69 (defvar preloaded-file-list nil
70 "List of files preloaded into the XEmacs binary image.") 70 "List of files preloaded into the XEmacs binary image.")
71
72 (defvar Installation-string nil
73 "Description of XEmacs installation.")
74 71
75 ;(start-profiling) 72 ;(start-profiling)
76 73
77 (let ((gc-cons-threshold 74 (let ((gc-cons-threshold
78 ;; setting it low makes loadup incredibly fucking slow. 75 ;; setting it low makes loadup incredibly fucking slow.
86 (let ((stack-trace-on-error nil)) 83 (let ((stack-trace-on-error nil))
87 84
88 ;; This is awfully damn early to be getting an error, right? 85 ;; This is awfully damn early to be getting an error, right?
89 (call-with-condition-handler 'really-early-error-handler 86 (call-with-condition-handler 'really-early-error-handler
90 #'(lambda () 87 #'(lambda ()
91
92 ;; Initialize Installation-string. We do it before loading
93 ;; anything so that dumped code can make use of its value.
94 (setq Installation-string
95 (save-current-buffer
96 (set-buffer (get-buffer-create (generate-new-buffer-name
97 " *temp*")))
98 ;; insert-file-contents-internal bogusly calls
99 ;; format-decode without checking if it's defined.
100 (fset 'format-decode #'(lambda (f l &optional v) l))
101 (insert-file-contents-internal
102 (expand-file-name "Installation" build-directory))
103 (fmakunbound 'format-decode)
104 (prog1 (buffer-substring)
105 (kill-buffer (current-buffer)))))
106
107 (setq load-path (list source-lisp)) 88 (setq load-path (list source-lisp))
108 (setq module-load-path (list 89 (setq module-load-path (list
109 (expand-file-name "modules" build-directory))) 90 (expand-file-name "modules" build-directory)))
110 91
111 ;; message not defined yet ... 92 ;; message not defined yet ...