Mercurial > hg > xemacs-beta
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