diff lisp/prim/loadup.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ee648375d8d6
children 54cc21c15cbb
line wrap: on
line diff
--- a/lisp/prim/loadup.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/prim/loadup.el	Mon Aug 13 09:02:59 2007 +0200
@@ -7,7 +7,6 @@
 ;; Copyright (C) 1996 Richard Mlynarik.
 ;; Copyright (C) 1995, 1996 Ben Wing.
 
-;; Maintainer: FSF
 ;; Keywords: internal
 
 ;; This file is part of XEmacs.
@@ -27,7 +26,7 @@
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 
-;;; Synched up with: Last synched with FSF 19.30, with divergence since.
+;;; Synched up with: Last synched with FSF 19.30, with wild divergence since.
 
 ;;; Commentary:
 
@@ -44,7 +43,7 @@
       ;; This is awfully damn early to be getting an error, right?
       'really-early-error-handler
  #'(lambda ()
-     ; message not defined yet ...
+     ;; message not defined yet ...
      (external-debugging-output (format "\nUsing load-path %s" load-path))
 
      ;; We don't want to have any undo records in the dumped XEmacs.
@@ -63,19 +62,7 @@
 			      (cons temp-path load-path))))
 
      (setq load-warn-when-source-newer t ; set to nil at the end
-	   load-warn-when-source-only t)
-
-     ;; Inserted for debugging.  Something is corrupting a single symbol
-     ;; somewhere to have an integer 0 property list.  -slb 6/28/1997.
-     (defun test-atoms ()
-       (mapatoms
-        #'(lambda (symbol)
-            (condition-case nil
-                (get symbol 'custom-group)
-              (t (princ
-                  (format "Bad plist in %s, %s\n"
-                          (symbol-name symbol)
-                          (prin1-to-string (object-plist symbol)))))))))
+	   load-warn-when-source-only  t)
 
      ;; garbage collect after loading every file in an attempt to
      ;; minimize the size of the dumped image (if we don't do this,
@@ -98,7 +85,7 @@
      (load-gc "obsolete")
      (load-gc "specifier")
      (load-gc "faces")	; must be loaded before any make-face call
-     ;(load-gc "facemenu") #### not yet ported
+     ;;(load-gc "facemenu") #### not yet ported
      (load-gc "glyphs")
      (load-gc "objects")
      (load-gc "extents")
@@ -113,30 +100,28 @@
      (load-gc "derived")
      (load-gc "minibuf")
      (load-gc "list-mode")
-     (load-gc "modeline") ; after simple.el so it can reference functions
-			  ; defined there.
-     (load-gc "help")
-     (load-gc "buff-menu")
-     ;; (load-gc "w3-sysdp")
-     (load-gc "widget")
-     (load-gc "custom") ; Before loaddefs so that defcustom exists.
+     (load-gc "modeline") ; needs simple.el to be loaded first
      ;; If SparcWorks support is included some additional packages are
      ;; dumped which would normally have autoloads.  To avoid
      ;; duplicate doc string warnings, SparcWorks uses a separate
      ;; autoloads file with the dumped packages removed.
-     ;;; After fixing, eos/loaddefs-eos and loaddefs appear identical?!!
-     ;;; So just make loaddefs-eos go away...
-     ;;;(load-gc (if (featurep 'sparcworks) "eos/loaddefs-eos" "loaddefs"))
-     (load-gc "loaddefs") ; <=== autoloads get put here
+     ;; After fixing, eos/loaddefs-eos and loaddefs appear identical?!!
+     ;; So just make loaddefs-eos go away...
+     ;;(load-gc (if (featurep 'sparcworks) "eos/loaddefs-eos" "loaddefs"))
+     (load-gc "loaddefs")
      (load-gc "misc")
      (load-gc "profile")
+     (load-gc "help")
      ;; (load-gc "hyper-apropos")  Soon...
+     (when (not (featurep 'mule))
+       (load-gc "files-nomule"))
      (load-gc "files")
      (load-gc "lib-complete")
      (load-gc "format")
      (load-gc "indent")
      (load-gc "isearch-mode")
      (load-gc "buffer")
+     (load-gc "buff-menu")
      (load-gc "undo-stack")
      (load-gc "window")
      (load-gc "paths.el")		; don't get confused if paths compiled.
@@ -150,8 +135,7 @@
      (load-gc "lisp-mode")
      (load-gc "text-mode")
      (load-gc "fill")
-     ;; (load-gc "cc-mode")		; as FSF goes so go we ..
-     ;; (load-gc "scroll-in-place")	; We're not ready for this :-(
+     (load-gc "cc-mode")
      ;; we no longer load buff-menu automatically.
      ;; it will get autoloaded if needed.
      
@@ -170,9 +154,8 @@
      (when (featurep 'lisp-float-type)
        (load-gc "float-sup"))
      (load-gc "itimer") ; for vars auto-save-timeout and auto-gc-threshold
-     (load-gc "itimer-autosave")
      (if (featurep 'toolbar)
-         (load-gc "toolbar")
+	 (load-gc "toolbar")
        ;; else still define a few functions.
        (defun toolbar-button-p    (obj) "No toolbar support." nil)
        (defun toolbar-specifier-p (obj) "No toolbar support." nil))
@@ -182,6 +165,8 @@
        (load-gc "menubar"))
      (when (featurep 'dialog)
        (load-gc "dialog"))
+     (when (featurep 'mule)
+       (load-gc "mule-load.el"))
      (when (featurep 'window-system)
        (load-gc "gui")
        (load-gc "mode-motion")
@@ -189,20 +174,20 @@
      (when (featurep 'x)
        ;; preload the X code, for faster startup.
        (when (featurep 'menubar)
-         (load-gc "x-menubar")
-         ;; autoload this.
-         ;;(load-gc "x-font-menu")
-         )
+	 (load-gc "x-menubar")
+	 ;; autoload this.
+	 ;;(load-gc "x-font-menu")
+	 )
        (load-gc "x-faces")
        (load-gc "x-iso8859-1")
        (load-gc "x-mouse")
        (load-gc "x-select")
        (when (featurep 'scrollbar)
-         (load-gc "x-scrollbar"))
+	 (load-gc "x-scrollbar"))
        (load-gc "x-misc")
        (load-gc "x-init")
        (when (featurep 'toolbar)
-         (load-gc "x-toolbar"))
+	 (load-gc "x-toolbar"))
        )
      (when (featurep 'tty)
        ;; preload the TTY init code.
@@ -217,7 +202,6 @@
        (load-gc "energize/energize-load.el"))
      (when (featurep 'sparcworks)
        (load-gc "sunpro/sunpro-load.el"))
-     (load-gc "custom-load")
      (fmakunbound 'load-gc)
      )) ;; end of call-with-condition-handler
 
@@ -227,9 +211,8 @@
 
 (setq debugger 'debug)
 
-(if (or (equal (nth 4 command-line-args) "no-site-file")
-	(equal (nth 5 command-line-args) "no-site-file"))
-    (setq site-start-file nil))
+(when (member "no-site-file" command-line-args)
+  (setq site-start-file nil))
 
 ;; If you want additional libraries to be preloaded and their
 ;; doc strings kept in the DOC file rather than in core,
@@ -240,29 +223,13 @@
 (if (load "site-load" t)
     (garbage-collect))
 
-;FSFmacs randomness
-;(if (fboundp 'x-popup-menu)
-;    (precompute-menubar-bindings))
+;;FSFmacs randomness
+;;(if (fboundp 'x-popup-menu)
+;;    (precompute-menubar-bindings))
 ;;; Turn on recording of which commands get rebound,
 ;;; for the sake of the next call to precompute-menubar-bindings.
 ;(setq define-key-rebound-commands nil)
 
-;;FSFmacs #### what?
-;; Determine which last version number to use
-;; based on the executables that now exist.
-;(if (and (or (equal (nth 3 command-line-args) "dump")
-;	      (equal (nth 4 command-line-args) "dump"))
-;	  (not (eq system-type 'ms-dos)))
-;    (let* ((base (concat "emacs-" emacs-version "."))
-;	    (files (file-name-all-completions base default-directory))
-;	    (versions (mapcar (function (lambda (name)
-;					  (string-to-int (substring name (length base)))))
-;			      files)))
-;      (setq emacs-version (format "%s.%d"
-;				   emacs-version
-;				   (if versions
-;				       (1+ (apply 'max versions))
-;				     1)))))
 
 ;; Note: all compiled Lisp files loaded above this point
 ;; must be among the ones parsed by make-docfile
@@ -272,38 +239,16 @@
 ;; Don't bother with these if we're running temacs, i.e. if we're
 ;; just debugging don't waste time finding doc strings.
 
-(if (or (equal (nth 3 command-line-args) "dump")
-	(equal (nth 4 command-line-args) "dump"))
-    (progn
-      (message "Finding pointers to doc strings...")
-      (if (fboundp 'dump-emacs)
-	  (let ((name emacs-version))
- 	    (string-match " Lucid" name)
- 	    (setq name (concat (substring name 0 (match-beginning 0))
- 			       (substring name (match-end 0))))
-	    (while (string-match "[^-+_.a-zA-Z0-9]+" name)
-	      (setq name (concat
-			  (downcase (substring name 0 (match-beginning 0)))
-			  "-"
-			  (substring name (match-end 0)))))
-	    (if (string-match "-+\\'" name)
-		(setq name (substring name 0 (match-beginning 0))))
-	    (if (memq system-type '(ms-dos windows-nt))
-		(setq name (expand-file-name
-			    (if (fboundp 'make-frame) "DOC-X" "DOC") "../etc"))
-	      (setq name (concat (expand-file-name "DOC-" "../lib-src") name))
-	      (if (file-exists-p name)
-		  (delete-file name))
-	      (copy-file (expand-file-name "DOC" "../lib-src") name t))
-	    (Snarf-documentation (file-name-nondirectory name)))
-	(Snarf-documentation "DOC"))
-      (message "Finding pointers to doc strings...done")
-      (Verify-documentation)
-      ))
+;; purify-flag is nil if called from loadup-el.el.
+(when purify-flag
+  (message "Finding pointers to doc strings...")
+  (Snarf-documentation "DOC")
+  (message "Finding pointers to doc strings...done")
+  (Verify-documentation))
 
-; Note: You can cause additional libraries to be preloaded
-; by writing a site-init.el that loads them.
-; See also "site-load" above.
+;; Note: You can cause additional libraries to be preloaded
+;; by writing a site-init.el that loads them.
+;; See also "site-load" above.
 (if (stringp site-start-file)
     (load "site-init" t))
 (setq current-load-list nil)
@@ -312,69 +257,22 @@
 ;;; At this point, we're ready to resume undo recording for scratch.
 (buffer-enable-undo "*scratch*")
 
-(if (or (equal (nth 3 command-line-args) "dump")
-	(equal (nth 4 command-line-args) "dump"))
-    (if (eq system-type 'vax-vms)
-	(progn 
-	  (setq command-line-args nil)
-	  (message "Dumping data as file temacs.dump")
-	  (dump-emacs "temacs.dump" "temacs")
-	  (kill-emacs))
-      (let ((name (concat "emacs-" emacs-version)))
- 	(string-match " Lucid" name)
- 	(setq name (concat (substring name 0 (match-beginning 0))
- 			   (substring name (match-end 0))))
-	(while (string-match "[^-+_.a-zA-Z0-9]+" name)
-	  (setq name (concat (downcase (substring name 0 (match-beginning 0)))
-			     "-"
-			     (substring name (match-end 0)))))
-	(if (string-match "-+\\'" name)
-	    (setq name (substring name 0 (match-beginning 0))))
-	(if (eq system-type 'ms-dos)
-	    (message "Dumping under the name xemacs")
-	  (message "Dumping under names xemacs and %s" name))
-        (condition-case () (delete-file  name   ) (file-error nil))
-        (condition-case () (delete-file "xemacs") (file-error nil))
-        )
-      (if (fboundp 'really-free)
-	  (really-free))
-      ;; Note that FSF used to dump under `xemacs'!
-      (dump-emacs "xemacs" "temacs")
-      ;This is done automatically.
-      ;(message "%d pure bytes used" pure-bytes-used)
-      ;; Recompute NAME now, so that it isn't set when we dump.
-      (if (not (memq system-type '(ms-dos windows-nt)))
-	  (let ((name (concat "emacs-" emacs-version)))
-	    (string-match " Lucid" name)
-	    (setq name (concat (substring name 0 (match-beginning 0))
-			       (substring name (match-end 0))))
-	    (while (string-match "[^-+_.a-zA-Z0-9]+" name)
-	      (setq name (concat (downcase (substring name 0 
-						      (match-beginning 0)))
-				 "-"
-				 (substring name (match-end 0)))))
-	    (if (string-match "-+\\'" name)
-		(setq name (substring name 0 (match-beginning 0))))
-	    (add-name-to-file "xemacs" name t)))
-      (kill-emacs)))
+;; Dump into the name `xemacs' (only)
+(when (member "dump" command-line-args)
+    (message "Dumping under the name xemacs")
+  (condition-case () (delete-file "xemacs") (file-error nil))
+  (when (fboundp 'really-free)
+    (really-free))
+  (dump-emacs "xemacs" "temacs")
+  (kill-emacs))
 
-(if (or (equal (nth 3 command-line-args) "run-temacs")
-	(equal (nth 4 command-line-args) "run-temacs"))
-    (progn
-      ;; purify-flag is nil if called from loadup-el.el.
-      (if purify-flag
-	  (progn
-	    (message "\nSnarfing doc...")
-	    (Snarf-documentation "DOC")
-	    (Verify-documentation)))
-      (message "\nBootstrapping from temacs...")
-      (setq purify-flag nil)
-      (apply #'run-emacs-from-temacs
-	     (nthcdr (if (equal (nth 3 command-line-args) "run-temacs")
-			 4 5)
-		     command-line-args))
-      ;; run-emacs-from-temacs doesn't actually return anyway.
-      (kill-emacs)))
+(when (member "run-temacs" command-line-args)
+  (message "\nBootstrapping from temacs...")
+  (setq purify-flag nil)
+  ;; Remove all args up to and including "run-temacs"
+  (apply #'run-emacs-from-temacs (cdr (member "run-temacs" command-line-args)))
+  ;; run-emacs-from-temacs doesn't actually return anyway.
+  (kill-emacs))
 
 ;; Avoid error if user loads some more libraries now.
 (setq purify-flag nil)
@@ -383,25 +281,18 @@
 ;; If you are using 'recompile', then you should have used -l loadup-el.el
 ;; so that the .el files always get loaded (the .elc files may be out-of-
 ;; date or bad).
-(if (or (equal (nth 3 command-line-args) "recompile")
-	(equal (nth 4 command-line-args) "recompile"))
-    (progn
-      (let ((command-line-args-left
-	     (nthcdr (if (equal (nth 3 command-line-args) "recompile")
-			 4 5)
-		     command-line-args)))
-	(batch-byte-recompile-directory)
-	(kill-emacs))))
-
+(when (member "recompile" command-line-args)
+  (let ((command-line-args-left (cdr (member "recompile" command-line-args))))
+    (batch-byte-recompile-directory)
+    (kill-emacs)))
 
 ;; For machines with CANNOT_DUMP defined in config.h,
 ;; this file must be loaded each time Emacs is run.
 ;; So run the startup code now.
 
-(or (fboundp 'dump-emacs)
-    (progn
-      ;; Avoid loading loadup.el a second time!
-      (setq command-line-args (cdr (cdr command-line-args)))
-      (eval top-level)))
+(when (not (fboundp 'dump-emacs))
+  ;; Avoid loading loadup.el a second time!
+  (setq command-line-args (cdr (cdr command-line-args)))
+  (eval top-level))
 
 ;;; loadup.el ends here