xemacs-beta: lisp/loadup.el comparison

comparison lisp/loadup.el @ 227:0e522484dd2a r20-5b12

Import from CVS: tag r20-5b12

author	cvs
date	Mon, 13 Aug 2007 10:12:37 +0200
parents	2c611d1463a6
children	85a06df23a9a

comparison

equal deleted inserted replaced

-:eea38c7ad7b4
+:0e522484dd2a
 (defvar running-xemacs t
 "Non-nil when the current emacsen is XEmacs.")
 (defvar preloaded-file-list nil
 "List of files preloaded into the XEmacs binary image.")
-(call-with-condition-handler
+;; This is awfully damn early to be getting an error, right?
-;; This is awfully damn early to be getting an error, right?
+(call-with-condition-handler 'really-early-error-handler
-'really-early-error-handler
+#'(lambda ()
-#'(lambda ()
+	;; message not defined yet ...
-;; message not defined yet ...
+	(external-debugging-output (format "\nUsing load-path %s" load-path))
-(external-debugging-output (format "\nUsing load-path %s" load-path))
+	;; We don't want to have any undo records in the dumped XEmacs.
-;; We don't want to have any undo records in the dumped XEmacs.
+	(buffer-disable-undo (get-buffer "*scratch*"))
-(buffer-disable-undo (get-buffer "*scratch*"))
+	;; lread.c (or src/Makefile.in.in) has prepended
-;; lread.c (or src/Makefile.in.in) has prepended "${srcdir}/../lisp/"
+	;; "${srcdir}/../lisp/" to load-path, which is how this file
-;; to load-path, which is how this file has been found.  At this point,
+	;; has been found.  At this point, enough of XEmacs has been
-;; enough of emacs has been initialized that we can call directory-files
+	;; initialized that we can start dumping "standard" lisp.
-;; and get the rest of the dirs (so that we can dump stuff from modes/
+	;; Dumped lisp from external packages is added when we search
-;; and packages/.)
+	;; the `package-path'.
-;;
+	;; #### This code is duplicated in two other places.
-(let ((temp-path (expand-file-name "." (car load-path))))
+	(let ((temp-path (expand-file-name "." (car load-path))))
-(setq source-directory temp-path)
+	  (setq source-directory temp-path)
-(setq load-path (nconc (mapcar
+	  (setq load-path (nconc (mapcar
-			       #'(lambda (i) (concat i "/"))
+				  #'(lambda (i) (concat i "/"))
-			       (directory-files temp-path t "^[^-.]"
+				  (directory-files temp-path t "^[^-.]"
-						nil 'dirs-only))
+						   nil 'dirs-only))
-			      (cons (file-name-as-directory temp-path)
+				 (cons (file-name-as-directory temp-path)
-				    load-path))))
+				       load-path))))
-(setq load-warn-when-source-newer t ; set to nil at the end
+	(setq load-warn-when-source-newer t ; Used to be set to nil at the end
-	   load-warn-when-source-only  t)
+	      load-warn-when-source-only  t) ; Set to nil at the end
-;; Inserted for debugging.  Something is corrupting a single symbol
+	;; Inserted for debugging.  Something is corrupting a single symbol
-;; somewhere to have an integer 0 property list.  -slb 6/28/1997.
+	;; somewhere to have an integer 0 property list.  -slb 6/28/1997.
-(defun test-atoms ()
+	(defun test-atoms ()
-(mapatoms
+	  (mapatoms
-	#'(lambda (symbol)
+	   #'(lambda (symbol)
-	    (condition-case nil
+	       (condition-case nil
-		(get symbol 'custom-group)
+		   (get symbol 'custom-group)
-	      (t (princ
+		 (t (princ
-		  (format "Bad plist in %s, %s\n"
+		     (format "Bad plist in %s, %s\n"
-			  (symbol-name symbol)
+			     (symbol-name symbol)
-			  (prin1-to-string (object-plist symbol)))))))))
+			     (prin1-to-string (object-plist symbol)))))))))
-;; garbage collect after loading every file in an attempt to
+	;; garbage collect after loading every file in an attempt to
-;; minimize the size of the dumped image (if we don't do this,
+	;; minimize the size of the dumped image (if we don't do this,
-;; there will be lots of extra space in the data segment filled
+	;; there will be lots of extra space in the data segment filled
-;; with garbage-collected junk)
+	;; with garbage-collected junk)
-(defmacro load-gc (file)
+	(defmacro load-gc (file)
-(list 'prog1 (list 'load file)
+	  (list 'prog1
-	     ;; '(test-atoms)
+		(list 'load
-	     '(garbage-collect)))
+		      (list 'locate-file file
-;; Need a minimal number hardcoded to get going for now.
+			    'load-path
-;; (load-gc "backquote")		; needed for defsubst etc.
+			    (list 'if 'load-ignore-elc-files
-;; (load-gc "bytecomp-runtime")	; define defsubst
+				  ".el:"
-;; (load-gc "subr")		; load the most basic Lisp functions
+				  ".elc:.el:")))
-;; (load-gc "replace")		; match-string used in version.el.
+		;; '(test-atoms)
-;; (load-gc "version.el")	; Ignore compiled-by-mistake version.elc
+		'(garbage-collect)))
-;; (load-gc "cl")
-;; (load-gc "featurep") ; OBSOLETE now
+	(load (concat default-directory "../lisp/dumped-lisp.el"))
-(load "dumped-lisp.el")
+	(let ((dumped-lisp-packages preloaded-file-list)
-(let ((dumped-lisp-packages preloaded-file-list)
+	      file)
-	   file)
+	  (while (setq file (car dumped-lisp-packages))
-(while (setq file (car dumped-lisp-packages))
+	    (load-gc file)
-	 (load-gc file)
+	    (setq dumped-lisp-packages (cdr dumped-lisp-packages)))
-	 (setq dumped-lisp-packages (cdr dumped-lisp-packages)))
+	  (if (not (featurep 'toolbar))
-(if (not (featurep 'toolbar))
+	      (progn
-	   (progn
+		;; else still define a few functions.
-	     ;; else still define a few functions.
+		(defun toolbar-button-p    (obj) "No toolbar support." nil)
-	     (defun toolbar-button-p    (obj) "No toolbar support." nil)
+		(defun toolbar-specifier-p (obj) "No toolbar support." nil)))
-	     (defun toolbar-specifier-p (obj) "No toolbar support." nil)))
+	  (fmakunbound 'load-gc))
-(fmakunbound 'load-gc))
+	)) ;; end of call-with-condition-handler
-)) ;; end of call-with-condition-handler
 ;; Fix up the preloaded file list
 (setq preloaded-file-list (mapcar #'file-name-sans-extension
 				  preloaded-file-list))

Mercurial > hg > xemacs-beta

comparison lisp/loadup.el @ 227:0e522484dd2a r20-5b12