;;; startup.el --- process Emacs shell arguments
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;; 2001, 2002, 2004, 2005 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
"Non-nil once command line has been processed.")
(defgroup initialization nil
- "Emacs start-up procedure"
+ "Emacs start-up procedure."
:group 'internal)
-(defcustom inhibit-startup-message nil
- "*Non-nil inhibits the initial startup message.
-This is for use in your personal init file, once you are familiar
-with the contents of the startup message."
+(defcustom inhibit-splash-screen nil
+ "Non-nil inhibits the startup screen.
+It also inhibits display of the initial message in the `*scratch*' buffer.
+
+This is for use in your personal init file (but NOT site-start.el), once
+you are familiar with the contents of the startup screen."
:type 'boolean
:group 'initialization)
-(defvaralias 'inhibit-splash-screen 'inhibit-startup-message)
+(defvaralias 'inhibit-startup-message 'inhibit-splash-screen)
(defcustom inhibit-startup-echo-area-message nil
"*Non-nil inhibits the initial startup echo area message.
("-bg" 1 x-handle-switch background-color)
("-background" 1 x-handle-switch background-color)
("-ms" 1 x-handle-switch mouse-color)
- ("-itype" 0 x-handle-switch icon-type t)
- ("-i" 0 x-handle-switch icon-type t)
+ ("-nbi" 0 x-handle-switch icon-type nil)
("-iconic" 0 x-handle-iconic)
("-xrm" 1 x-handle-xrm-switch)
("-cr" 1 x-handle-switch cursor-color)
("--foreground-color" 1 x-handle-switch foreground-color)
("--background-color" 1 x-handle-switch background-color)
("--mouse-color" 1 x-handle-switch mouse-color)
- ("--icon-type" 0 x-handle-switch icon-type t)
+ ("--no-bitmap-icon" 0 x-handle-switch icon-type nil)
("--iconic" 0 x-handle-iconic)
("--xrm" 1 x-handle-xrm-switch)
("--cursor-color" 1 x-handle-switch cursor-color)
(defvar keyboard-type nil
"The brand of keyboard you are using.
-This variable is used to define
-the proper function and keypad keys for use under X. It is used in a
-fashion analogous to the environment variable TERM.")
+This variable is used to define the proper function and keypad
+keys for use under X. It is used in a fashion analogous to the
+environment variable TERM.")
(defvar window-setup-hook nil
"Normal hook run to initialize window system display.
the user's init file.")
(defcustom initial-major-mode 'lisp-interaction-mode
- "Major mode command symbol to use for the initial *scratch* buffer."
+ "Major mode command symbol to use for the initial `*scratch*' buffer."
:type 'function
:group 'initialization)
-(defcustom init-file-user nil
+(defvar init-file-user nil
"Identity of user whose `.emacs' file is or was read.
The value is nil if `-q' or `--no-init-file' was specified,
meaning do not load any init file.
-Otherwise, the value may be the null string, meaning use the init file
-for the user that originally logged in, or it may be a
-string containing a user's name meaning use that person's init file.
+Otherwise, the value may be an empty string, meaning
+use the init file for the user who originally logged in,
+or it may be a string containing a user's name meaning
+use that person's init file.
In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
evaluates to the name of the directory where the `.emacs' file was
looked for.
Setting `init-file-user' does not prevent Emacs from loading
-`site-start.el'. The only way to do that is to use `--no-site-file'."
- :type '(choice (const :tag "none" nil) string)
- :group 'initialization)
+`site-start.el'. The only way to do that is to use `--no-site-file'.")
(defcustom site-run-file "site-start"
"File containing site-wide run-time initializations.
This variable is defined for customization so as to make
it visible in the relevant context. However, actually customizing it
is not allowed, since it would not work anyway. The only way to set
-this variable usefully is to set it during while building and dumping Emacs."
+this variable usefully is to set it while building and dumping Emacs."
:type '(choice (const :tag "none" nil) string)
:group 'initialization
:initialize 'custom-initialize-default
:group 'mail)
(defcustom user-mail-address (if command-line-processed
- (concat (user-login-name) "@"
- (or mail-host-address
- (system-name)))
+ (or (getenv "EMAIL")
+ (concat (user-login-name) "@"
+ (or mail-host-address
+ (system-name))))
;; Empty string means "not set yet".
"")
"*Full mailing address of this user.
-This is initialized based on `mail-host-address',
-after your init file is read, in case it sets `mail-host-address'."
+This is initialized with environment variable `EMAIL' or, as a
+fallback, using `mail-host-address'. This is done after your
+init file is read, in case it sets `mail-host-address'."
:type 'string
:group 'mail)
(defvar init-file-debug nil)
-(defvar init-file-had-error nil)
+(defvar init-file-had-error nil
+ "Non-nil if there was an error loading the user's init file.")
(defvar normal-top-level-add-subdirs-inode-list nil)
(defvar no-blinking-cursor nil)
+(defvar default-frame-background-mode)
+
(defvar pure-space-overflow nil
"Non-nil if building Emacs overflowed pure space.")
;; of that dir into load-path,
;; Look for a leim-list.el file too. Loading it will register
;; available input methods.
- (dolist (dir load-path)
- (let ((default-directory dir))
- (load (expand-file-name "subdirs.el") t t t))
- (let ((default-directory dir))
- (load (expand-file-name "leim-list.el") t t t)))
+ (let ((tail load-path) dir)
+ (while tail
+ (setq dir (car tail))
+ (let ((default-directory dir))
+ (load (expand-file-name "subdirs.el") t t t))
+ (let ((default-directory dir))
+ (load (expand-file-name "leim-list.el") t t t))
+ ;; We don't use a dolist loop and we put this "setq-cdr" command at
+ ;; the end, because the subdirs.el files may add elements to the end
+ ;; of load-path and we want to take it into account.
+ (setq tail (cdr tail))))
(unless (eq system-type 'vax-vms)
;; If the PWD environment variable isn't accurate, delete it.
(let ((pwd (getenv "PWD")))
;; frame-notice-user-settings didn't (such as on a tty).
;; frame-set-background-mode is idempotent, so it won't
;; cause any harm if it's already been done.
- (let ((frame-background-mode frame-background-mode)
- (frame (selected-frame))
+ (let ((frame (selected-frame))
term)
(when (and (null window-system)
- ;; Don't override a possibly customized value.
- (null frame-background-mode)
- ;; Don't override user specifications.
- (null (frame-parameter frame 'reverse))
+ ;; Don't override default set by files in lisp/term.
+ (null default-frame-background-mode)
(let ((bg (frame-parameter frame 'background-color)))
(or (null bg)
- (member bg '(unspecified "unspecified-bg")))))
+ (member bg '(unspecified "unspecified-bg"
+ "unspecified-fg")))))
+
(setq term (getenv "TERM"))
;; Some files in lisp/term do a better job with the
;; background mode, but we leave this here anyway, in
;; case they remove those files.
(if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
term)
- (setq frame-background-mode 'light)))
+ (setq default-frame-background-mode 'light)))
(frame-set-background-mode (selected-frame)))))
;; Now we know the user's default font, so add it to the menu.
;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc.
(defun tty-handle-args (args)
(let (rest)
- (message "%s" args)
+ (message "%S" args)
(while (and args
(not (equal (car args) "--")))
(let* ((argi (pop args))
;; Choose a reasonable location for temporary files.
(custom-reevaluate-setting 'temporary-file-directory)
- (custom-reevaluate-setting 'small-emporary-file-directory)
+ (custom-reevaluate-setting 'small-temporary-file-directory)
(custom-reevaluate-setting 'auto-save-file-name-transforms)
;; See if we should import version-control from the environment variable.
(set-locale-environment nil)
+ ;; Convert preloaded file names in load-history to absolute.
+ (let ((simple-file-name
+ ;; Look for simple.el or simple.elc and use their directory
+ ;; as the place where all Lisp files live.
+ (locate-file "simple" load-path (get-load-suffixes)))
+ lisp-dir)
+ ;; Don't abort if simple.el cannot be found, but print a warning.
+ (if (null simple-file-name)
+ (progn
+ (princ "Warning: Could not find simple.el nor simple.elc"
+ 'external-debugging-output)
+ (terpri 'external-debugging-output))
+ (setq lisp-dir (file-truename (file-name-directory simple-file-name)))
+ (setq load-history
+ (mapcar (lambda (elt)
+ (if (and (stringp (car elt))
+ (not (file-name-absolute-p (car elt))))
+ (cons (concat lisp-dir
+ (car elt))
+ (cdr elt))
+ elt))
+ load-history))))
+
;; Convert the arguments to Emacs internal representation.
(let ((args (cdr command-line-args)))
(while args
;; processed. This is consistent with the way main in emacs.c
;; does things.
(while (and (not done) args)
- (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
- ("--debug-init") ("--iconic") ("--icon-type")
- ("--no-blinking-cursor") ("--bare-bones")))
+ (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--debug-init")
+ ("--user") ("--iconic") ("--icon-type") ("--quick")
+ ("--no-blinking-cursor") ("--basic-display")))
(argi (pop args))
(orig-argi argi)
argval)
(and command-line-args
(setcdr command-line-args args)))
+ (run-hooks 'before-init-hook)
+
;; Under X Window, this creates the X frame and deletes the terminal frame.
(when (fboundp 'frame-initialize)
(frame-initialize))
;; are not set.
(custom-reevaluate-setting 'blink-cursor-mode)
(custom-reevaluate-setting 'normal-erase-is-backspace)
-
- ;; If you change the code below, you need to also change the
- ;; corresponding code in the tooltip-mode defcustom. The two need
- ;; to be equivalent under all conditions, or Custom will get confused.
- (unless (or noninteractive
- emacs-basic-display
- (not (display-graphic-p))
- (not (fboundp 'x-show-tip)))
- (tooltip-mode 1))
+ (custom-reevaluate-setting 'tooltip-mode)
+ (custom-reevaluate-setting 'global-font-lock-mode)
+ (custom-reevaluate-setting 'mouse-wheel-down-event)
+ (custom-reevaluate-setting 'mouse-wheel-up-event)
+ (custom-reevaluate-setting 'file-name-shadow-mode)
+ (custom-reevaluate-setting 'send-mail-function)
+ (custom-reevaluate-setting 'focus-follows-mouse)
;; Register default TTY colors for the case the terminal hasn't a
;; terminal init file.
- (unless (memq window-system '(x w32))
+ (unless (memq window-system '(x w32 mac))
;; We do this regardles of whether the terminal supports colors
;; or not, since they can switch that support on or off in
;; mid-session by setting the tty-color-mode frame parameter.
(old-font-list-limit font-list-limit)
(old-face-ignored-fonts face-ignored-fonts))
- (run-hooks 'before-init-hook)
-
;; Run the site-start library if it exists. The point of this file is
;; that it is run before .emacs. There is no point in doing this after
;; .emacs; that is useless.
;; the startup message.
(setq inhibit-startup-message nil)
+ ;; Warn for invalid user name.
+ (when init-file-user
+ (if (string-match "[~/:\n]" init-file-user)
+ (display-warning 'initialization
+ (format "Invalid user name %s"
+ init-file-user)
+ :error)
+ (if (file-directory-p (expand-file-name
+ ;; We don't support ~USER on MS-Windows except
+ ;; for the current user, and always load .emacs
+ ;; from the current user's home directory (see
+ ;; below). So always check "~", even if invoked
+ ;; with "-u USER", or if $USER or $LOGNAME are
+ ;; set to something different.
+ (if (eq system-type 'windows-nt)
+ "~"
+ (concat "~" init-file-user))))
+ nil
+ (display-warning 'initialization
+ (format "User %s has no home directory"
+ init-file-user)
+ :error))))
+
;; Load that user's init file, or the default one, or none.
(let (debug-on-error-from-init-file
debug-on-error-should-be-set
(when (eq user-init-file t)
;; If we did not find ~/.emacs, try
- ;; ~/.emacs.d/.emacs.
+ ;; ~/.emacs.d/init.el.
(let ((otherfile
(expand-file-name
- (file-name-nondirectory user-init-file-1)
+ "init"
(file-name-as-directory
- (expand-file-name
- ".emacs.d"
- (file-name-directory user-init-file-1))))))
+ (concat "~" init-file-user "/.emacs.d")))))
(load otherfile t t)
;; If we did not find the user's init file,
(pop-to-buffer "*Messages*"))
(setq init-file-had-error t)))))
+ (if (and deactivate-mark transient-mark-mode)
+ (with-current-buffer (window-buffer)
+ (deactivate-mark)))
+
;; If the user has a file of abbrevs, read it.
- (if (file-exists-p abbrev-file-name)
+ ;; FIXME: after the 22.0 release this should be changed so
+ ;; that it does not read the abbrev file when -batch is used
+ ;; on the command line.
+ (when (and (file-exists-p abbrev-file-name)
+ (file-readable-p abbrev-file-name))
(quietly-read-abbrev-file abbrev-file-name))
;; If the abbrevs came entirely from the init file or the
;; Do this here in case the init file sets mail-host-address.
(if (equal user-mail-address "")
- (setq user-mail-address (concat (user-login-name) "@"
- (or mail-host-address
- (system-name)))))
+ (setq user-mail-address (or (getenv "EMAIL")
+ (concat (user-login-name) "@"
+ (or mail-host-address
+ (system-name))))))
+
+ ;; Originally face attributes were specified via
+ ;; `font-lock-face-attributes'. Users then changed the default
+ ;; face attributes by setting that variable. However, we try and
+ ;; be back-compatible and respect its value if set except for
+ ;; faces where M-x customize has been used to save changes for the
+ ;; face.
+ (when (boundp 'font-lock-face-attributes)
+ (let ((face-attributes font-lock-face-attributes))
+ (while face-attributes
+ (let* ((face-attribute (pop face-attributes))
+ (face (car face-attribute)))
+ ;; Rustle up a `defface' SPEC from a
+ ;; `font-lock-face-attributes' entry.
+ (unless (get face 'saved-face)
+ (let ((foreground (nth 1 face-attribute))
+ (background (nth 2 face-attribute))
+ (bold-p (nth 3 face-attribute))
+ (italic-p (nth 4 face-attribute))
+ (underline-p (nth 5 face-attribute))
+ face-spec)
+ (when foreground
+ (setq face-spec (cons ':foreground (cons foreground face-spec))))
+ (when background
+ (setq face-spec (cons ':background (cons background face-spec))))
+ (when bold-p
+ (setq face-spec (append '(:weight bold) face-spec)))
+ (when italic-p
+ (setq face-spec (append '(:slant italic) face-spec)))
+ (when underline-p
+ (setq face-spec (append '(:underline t) face-spec)))
+ (face-spec-set face (list (list t face-spec)) nil)))))))
;; If parameter have been changed in the init file which influence
;; face realization, clear the face cache so that new faces will
(unless (or noninteractive
window-system
(null term-file-prefix))
- (let ((term (getenv "TERM"))
+ (let* ((TERM (getenv "TERM"))
+ (term TERM)
hyphend)
(while (and term
(not (load (concat term-file-prefix term) t t)))
;; Strip off last hyphen and what follows, then try again
(setq term
- (if (setq hyphend (string-match "[-_][^-_]+$" term))
+ (if (setq hyphend (string-match "[-_][^-_]+\\'" term))
(substring term 0 hyphend)
- nil)))))
+ nil)))
+ (setq term TERM)
+ ;; The terminal file has been loaded, now call the terminal specific
+ ;; initialization function.
+ (while term
+ (let ((term-init-func (intern-soft (concat "terminal-init-" term))))
+ (if (not (fboundp term-init-func))
+ ;; Strip off last hyphen and what follows, then try again
+ (setq term
+ (if (setq hyphend (string-match "[-_][^-_]+\\'" term))
+ (substring term 0 hyphend)
+ nil))
+ (setq term nil)
+ (funcall term-init-func))))))
;; Update the out-of-memory error message based on user's key bindings
;; for save-some-buffers.
")
"Initial message displayed in *scratch* buffer at startup.
-If this is nil, no message will be displayed."
+If this is nil, no message will be displayed.
+If `inhibit-splash-screen' is non-nil, then no message is displayed,
+regardless of the value of this variable."
:type '(choice (text :tag "Message")
(const :tag "none" nil))
:group 'initialization)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar fancy-splash-text
- '((:face variable-pitch
- "You can do basic editing with the menu bar and scroll bar \
-using the mouse.\n\n"
- :face (variable-pitch :weight bold)
+ '((:face (variable-pitch :weight bold)
"Important Help menu items:\n"
:face variable-pitch
(lambda ()
;; If there is a specific tutorial for the current language
;; environment and it is not English, append its title.
(concat
- "Emacs Tutorial\tLearn how to use Emacs efficiently"
+ "Emacs Tutorial\t\tLearn how to use Emacs efficiently"
(if (string= en tut)
""
(concat " (" title ")"))
"\n")))
:face variable-pitch "\
-Emacs FAQ\tFrequently asked questions and answers
-Read the Emacs Manual\tView the Emacs manual using Info
-\(Non)Warranty\tGNU Emacs comes with "
+Emacs FAQ\t\tFrequently asked questions and answers
+View Emacs Manual\t\tView the Emacs manual using Info
+Absence of Warranty\tGNU Emacs comes with "
:face (variable-pitch :slant oblique)
"ABSOLUTELY NO WARRANTY\n"
:face variable-pitch
"\
-Copying Conditions\tConditions for redistributing and changing Emacs
+Copying Conditions\t\tConditions for redistributing and changing Emacs
+Getting New Versions\tHow to obtain the latest version of Emacs
More Manuals / Ordering Manuals Buying printed manuals from the FSF\n")
(:face variable-pitch
- "You can do basic editing with the menu bar and scroll bar \
-using the mouse.\n\n"
- :face (variable-pitch :weight bold)
- "Useful File menu items:\n"
- :face variable-pitch "\
-Exit Emacs\t(Or type Control-x followed by Control-c)
-Recover Crashed Session\tRecover files you were editing before a crash
-
-
+ "\nTo quit a partially entered command, type "
+ :face default
+ "Control-g"
+ :face variable-pitch
+ ".
+Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/
"
+ :face (variable-pitch :weight bold)
+ "Useful File menu items:\n"
+ :face variable-pitch
+ "Exit Emacs\t\t(Or type "
+ :face default
+ "Control-x"
+ :face variable-pitch
+ " followed by "
+ :face default
+ "Control-c"
+ :face variable-pitch
+ ")
+Recover Crashed Session\tRecover files you were editing before a crash\n"
))
"A list of texts to show in the middle part of splash screens.
Each element in the list should be a list of strings or pairs
(defvar fancy-splash-help-echo nil)
(defvar fancy-splash-stop-time nil)
(defvar fancy-splash-outer-buffer nil)
+(defvar fancy-splash-last-input-event nil)
(defun fancy-splash-insert (&rest args)
"Insert text into the current buffer, with faces.
Arguments from ARGS should be either strings, functions called
with no args that return a string, or pairs `:face FACE',
where FACE is a valid face specification, as it can be used with
-`put-text-properties'."
+`put-text-property'."
(let ((current-face nil))
(while args
(if (eq (car args) :face)
"GNU Emacs is one component of the GNU/Linux operating system."
"GNU Emacs is one component of the GNU operating system."))
(insert "\n")
- (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*")
- (fancy-splash-insert :face 'variable-pitch
- (substitute-command-keys
- "Type \\[recenter] to begin editing your file.\n"))))
-
+ (fancy-splash-insert
+ :face 'variable-pitch
+ "You can do basic editing with the menu bar and scroll bar \
+using the mouse.\n\n")
+ (when fancy-splash-outer-buffer
+ (fancy-splash-insert
+ :face 'variable-pitch
+ "Type "
+ :face 'default
+ "Control-l"
+ :face 'variable-pitch
+ " to begin editing"
+ (if (equal (buffer-name fancy-splash-outer-buffer)
+ "*scratch*")
+ ".\n"
+ " your file.\n"))))
(defun fancy-splash-tail ()
"Insert the tail part of the splash screen into the current buffer."
(emacs-version)
"\n"
:face '(variable-pitch :height 0.5)
- "Copyright (C) 2005 Free Software Foundation, Inc.")
+ emacs-copyright)
(and auto-save-list-file-prefix
;; Don't signal an error if the
;; directory for auto-save-list files
t)
(fancy-splash-insert :face '(variable-pitch :foreground "red")
"\n\nIf an Emacs session crashed recently, "
- "type M-x recover-session RET\nto recover"
+ "type "
+ :face '(fixed-pitch :foreground "red")
+ "Meta-x recover-session RET"
+ :face '(variable-pitch :foreground "red")
+ "\nto recover"
" the files you were editing."))))
(defun fancy-splash-screens-1 (buffer)
(set-buffer buffer)
(erase-buffer)
(if pure-space-overflow
- (insert "Warning Warning Pure space overflow Warning Warning\n"))
+ (insert "\
+Warning Warning!!! Pure space overflow !!!Warning Warning
+\(See the node Pure Storage in the Lisp manual for details.)\n"))
(fancy-splash-head)
(apply #'fancy-splash-insert text)
(fancy-splash-tail)
the user caused an input event by hitting a key or clicking with the
mouse."
(interactive)
- (push last-command-event unread-command-events)
+ (if (and (memq 'down (event-modifiers last-command-event))
+ (eq (posn-window (event-start last-command-event))
+ (selected-window)))
+ ;; This is a mouse-down event in the spash screen window.
+ ;; Ignore it and consume the corresponding mouse-up event.
+ (read-event)
+ (push last-command-event unread-command-events))
+ (throw 'exit nil))
+
+(defun fancy-splash-special-event-action ()
+ "Save the last event and stop displaying the splash screen buffer.
+This is an internal function used to turn off the splash screen after
+the user caused an input event that is bound in `special-event-map'"
+ (interactive)
+ (setq fancy-splash-last-input-event last-input-event)
(throw 'exit nil))
-(defun fancy-splash-screens ()
+(defun fancy-splash-screens (&optional hide-on-input)
"Display fancy splash screens when Emacs starts."
- (setq fancy-splash-help-echo (startup-echo-area-message))
- (let ((old-hourglass display-hourglass)
- (fancy-splash-outer-buffer (current-buffer))
- splash-buffer
- (old-minor-mode-map-alist minor-mode-map-alist)
- (frame (fancy-splash-frame))
- timer)
- (save-selected-window
- (select-frame frame)
- (switch-to-buffer "GNU Emacs")
- (setq tab-width 20)
- (setq splash-buffer (current-buffer))
- (catch 'stop-splashing
- (unwind-protect
- (let ((map (make-sparse-keymap)))
- (use-local-map map)
- (define-key map [switch-frame] 'ignore)
- (define-key map [t] 'fancy-splash-default-action)
- (define-key map [mouse-movement] 'ignore)
- (define-key map [mode-line t] 'ignore)
- (setq cursor-type nil
- display-hourglass nil
- minor-mode-map-alist nil
- buffer-undo-list t
- mode-line-format (propertize "---- %b %-"
- 'face '(:weight bold))
- fancy-splash-stop-time (+ (float-time)
- fancy-splash-max-time)
- timer (run-with-timer 0 fancy-splash-delay
- #'fancy-splash-screens-1
- splash-buffer))
- (recursive-edit))
- (cancel-timer timer)
- (setq display-hourglass old-hourglass
- minor-mode-map-alist old-minor-mode-map-alist)
- (kill-buffer splash-buffer))))))
+ (if hide-on-input
+ (let ((old-hourglass display-hourglass)
+ (fancy-splash-outer-buffer (current-buffer))
+ splash-buffer
+ (old-minor-mode-map-alist minor-mode-map-alist)
+ (old-emulation-mode-map-alists emulation-mode-map-alists)
+ (old-special-event-map special-event-map)
+ (frame (fancy-splash-frame))
+ timer)
+ (save-selected-window
+ (select-frame frame)
+ (switch-to-buffer " GNU Emacs")
+ (make-local-variable 'cursor-type)
+ (setq splash-buffer (current-buffer))
+ (catch 'stop-splashing
+ (unwind-protect
+ (let ((map (make-sparse-keymap))
+ (cursor-type nil))
+ (use-local-map map)
+ (define-key map [switch-frame] 'ignore)
+ (define-key map [t] 'fancy-splash-default-action)
+ (define-key map [mouse-movement] 'ignore)
+ (define-key map [mode-line t] 'ignore)
+ ;; Temporarily bind special events to
+ ;; fancy-splash-special-event-action so as to stop
+ ;; displaying splash screens with such events.
+ ;; Otherwise, drag-n-drop into splash screens may
+ ;; leave us in recursive editing with invisible
+ ;; cursors for a while.
+ (setq special-event-map (make-sparse-keymap))
+ (map-keymap
+ (lambda (key def)
+ (define-key special-event-map (vector key)
+ (if (eq def 'ignore)
+ 'ignore
+ 'fancy-splash-special-event-action)))
+ old-special-event-map)
+ (setq display-hourglass nil
+ minor-mode-map-alist nil
+ emulation-mode-map-alists nil
+ buffer-undo-list t
+ mode-line-format (propertize "---- %b %-"
+ 'face 'mode-line-buffer-id)
+ fancy-splash-stop-time (+ (float-time)
+ fancy-splash-max-time)
+ timer (run-with-timer 0 fancy-splash-delay
+ #'fancy-splash-screens-1
+ splash-buffer))
+ (message "%s" (startup-echo-area-message))
+ (recursive-edit))
+ (cancel-timer timer)
+ (setq display-hourglass old-hourglass
+ minor-mode-map-alist old-minor-mode-map-alist
+ emulation-mode-map-alists old-emulation-mode-map-alists
+ special-event-map old-special-event-map)
+ (kill-buffer splash-buffer)
+ (when fancy-splash-last-input-event
+ (setq last-input-event fancy-splash-last-input-event
+ fancy-splash-last-input-event nil)
+ (command-execute (lookup-key special-event-map
+ (vector last-input-event))
+ nil (vector last-input-event) t))))))
+ ;; If hide-on-input is nil, don't hide the buffer on input.
+ (if (or (window-minibuffer-p)
+ (window-dedicated-p (selected-window)))
+ (pop-to-buffer (current-buffer))
+ (switch-to-buffer "*About GNU Emacs*"))
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (if pure-space-overflow
+ (insert "\
+Warning Warning!!! Pure space overflow !!!Warning Warning
+\(See the node Pure Storage in the Lisp manual for details.)\n"))
+ (let (fancy-splash-outer-buffer)
+ (fancy-splash-head)
+ (dolist (text fancy-splash-text)
+ (apply #'fancy-splash-insert text)
+ (insert "\n"))
+ (skip-chars-backward "\n")
+ (delete-region (point) (point-max))
+ (insert "\n")
+ (fancy-splash-tail)
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (if (and view-read-only (not view-mode))
+ (view-mode-enter nil 'kill-buffer))
+ (goto-char (point-min)))))
(defun fancy-splash-frame ()
"Return the frame to use for the fancy splash screen.
(if (and (display-color-p)
(image-type-available-p 'xpm))
"splash.xpm" "splash.pbm"))))
- (image-height (and img (cdr (image-size img))))
- (window-height (1- (window-height (frame-selected-window frame)))))
- (> window-height (+ image-height 19)))))))
+ (image-height (and img (cdr (image-size img nil frame))))
+ ;; We test frame-height so that, if the frame is split
+ ;; by displaying a warning, that doesn't cause the normal
+ ;; splash screen to be used.
+ (frame-height (1- (frame-height frame))))
+ (> frame-height (+ image-height 19)))))))
-(defun normal-splash-screen ()
+(defun normal-splash-screen (&optional hide-on-input)
"Display splash screen when Emacs starts."
(let ((prev-buffer (current-buffer)))
(unwind-protect
(with-current-buffer (get-buffer-create "GNU Emacs")
- (let ((tab-width 8)
- (mode-line-format (propertize "---- %b %-"
- 'face '(:weight bold))))
-
- (if pure-space-overflow
- (insert "Warning Warning Pure space overflow Warning Warning\n"))
-
- ;; The convention for this piece of code is that
- ;; each piece of output starts with one or two newlines
- ;; and does not end with any newlines.
- (insert "Welcome to GNU Emacs")
- (insert
- (if (eq system-type 'gnu/linux)
- ", one component of the GNU/Linux operating system.\n"
- ", a part of the GNU operating system.\n"))
-
- (unless (equal (buffer-name prev-buffer) "*scratch*")
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (set (make-local-variable 'tab-width) 8)
+ (if hide-on-input
+ (set (make-local-variable 'mode-line-format)
+ (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
+
+ (if pure-space-overflow
+ (insert "\
+Warning Warning!!! Pure space overflow !!!Warning Warning
+\(See the node Pure Storage in the Lisp manual for details.)\n"))
+
+ ;; The convention for this piece of code is that
+ ;; each piece of output starts with one or two newlines
+ ;; and does not end with any newlines.
+ (insert "Welcome to GNU Emacs")
+ (insert
+ (if (eq system-type 'gnu/linux)
+ ", one component of the GNU/Linux operating system.\n"
+ ", a part of the GNU operating system.\n"))
+
+ (if hide-on-input
(insert (substitute-command-keys
- "\nType \\[recenter] to begin editing your file.\n")))
-
- (if (display-mouse-p)
- ;; The user can use the mouse to activate menus
- ;; so give help in terms of menu items.
- (progn
- (insert "\
+ (concat
+ "\nType \\[recenter] to begin editing"
+ (if (equal (buffer-name prev-buffer) "*scratch*")
+ ".\n"
+ " your file.\n")))))
+
+ (if (display-mouse-p)
+ ;; The user can use the mouse to activate menus
+ ;; so give help in terms of menu items.
+ (progn
+ (insert "\
You can do basic editing with the menu bar and scroll bar using the mouse.
+To quit a partially entered command, type Control-g.
Useful File menu items:
Exit Emacs (or type Control-x followed by Control-c)
-Recover Session recover files you were editing before a crash
+Recover Crashed Session Recover files you were editing before a crash
Important Help menu items:
-Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently.
+Emacs Tutorial Learn how to use Emacs efficiently
Emacs FAQ Frequently asked questions and answers
Read the Emacs Manual View the Emacs manual using Info
\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
-Copying Conditions Conditions for redistributing and changing Emacs.
-Getting New Versions How to obtain the latest version of Emacs.
-More Manuals / Ordering Manuals How to order printed manuals from the FSF.
+Copying Conditions Conditions for redistributing and changing Emacs
+Getting New Versions How to obtain the latest version of Emacs
+More Manuals / Ordering Manuals How to order printed manuals from the FSF
")
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 2004 Free Software Foundation, Inc."))
-
- ;; No mouse menus, so give help using kbd commands.
-
- ;; If keys have their default meanings,
- ;; use precomputed string to save lots of time.
- (if (and (eq (key-binding "\C-h") 'help-command)
- (eq (key-binding "\C-xu") 'advertised-undo)
- (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
- (eq (key-binding "\C-ht") 'help-with-tutorial)
- (eq (key-binding "\C-hi") 'info)
- (eq (key-binding "\C-hr") 'info-emacs-manual)
- (eq (key-binding "\C-h\C-n") 'view-emacs-news))
- (insert "
+ (insert "\n\n" (emacs-version)
+ "
+Copyright (C) 2007 Free Software Foundation, Inc."))
+
+ ;; No mouse menus, so give help using kbd commands.
+
+ ;; If keys have their default meanings,
+ ;; use precomputed string to save lots of time.
+ (if (and (eq (key-binding "\C-h") 'help-command)
+ (eq (key-binding "\C-xu") 'advertised-undo)
+ (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
+ (eq (key-binding "\C-ht") 'help-with-tutorial)
+ (eq (key-binding "\C-hi") 'info)
+ (eq (key-binding "\C-hr") 'info-emacs-manual)
+ (eq (key-binding "\C-h\C-n") 'view-emacs-news))
+ (insert "
Get help C-h (Hold down CTRL and press h)
Emacs manual C-h r
Emacs tutorial C-h t Undo changes C-x u
Buy manuals C-h C-m Exit Emacs C-x C-c
Browse manuals C-h i")
- (insert (substitute-command-keys
- (format "\n
+ (insert (substitute-command-keys
+ (format "\n
Get help %s
Emacs manual \\[info-emacs-manual]
Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs]
Browse manuals \\[info]"
- (let ((where (where-is-internal
- 'help-command nil t)))
- (if where
- (key-description where)
- "M-x help"))))))
-
- ;; Say how to use the menu bar with the keyboard.
- (if (and (eq (key-binding "\M-`") 'tmm-menubar)
- (eq (key-binding [f10]) 'tmm-menubar))
- (insert "
+ (let ((where (where-is-internal
+ 'help-command nil t)))
+ (if where
+ (key-description where)
+ "M-x help"))))))
+
+ ;; Say how to use the menu bar with the keyboard.
+ (if (and (eq (key-binding "\M-`") 'tmm-menubar)
+ (eq (key-binding [f10]) 'tmm-menubar))
+ (insert "
Activate menubar F10 or ESC ` or M-`")
- (insert (substitute-command-keys "
+ (insert (substitute-command-keys "
Activate menubar \\[tmm-menubar]")))
- ;; Many users seem to have problems with these.
- (insert "
+ ;; Many users seem to have problems with these.
+ (insert "
\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
If you have no Meta key, you may instead type ESC followed by the character.)")
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 2004 Free Software Foundation, Inc.")
+ (insert "\n\n" (emacs-version)
+ "
+Copyright (C) 2007 Free Software Foundation, Inc.")
- (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
- (eq (key-binding "\C-h\C-d") 'describe-distribution)
- (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
- (insert
- "\n
+ (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
+ (eq (key-binding "\C-h\C-d") 'describe-distribution)
+ (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
+ (insert
+ "\n
GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
Emacs is Free Software--Free as in Freedom--so you can redistribute copies
of Emacs and modify it; type C-h C-c to see the conditions.
Type C-h C-d for information on getting the latest version.")
- (insert (substitute-command-keys
- "\n
+ (insert (substitute-command-keys
+ "\n
GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
Emacs is Free Software--Free as in Freedom--so you can redistribute copies
of Emacs and modify it; type \\[describe-copying] to see the conditions.
Type \\[describe-distribution] for information on getting the latest version."))))
- ;; The rest of the startup screen is the same on all
- ;; kinds of terminals.
-
- ;; Give information on recovering, if there was a crash.
- (and auto-save-list-file-prefix
- ;; Don't signal an error if the
- ;; directory for auto-save-list files
- ;; does not yet exist.
- (file-directory-p (file-name-directory
- auto-save-list-file-prefix))
- (directory-files
- (file-name-directory auto-save-list-file-prefix)
- nil
- (concat "\\`"
- (regexp-quote (file-name-nondirectory
- auto-save-list-file-prefix)))
- t)
- (insert "\n\nIf an Emacs session crashed recently, "
- "type M-x recover-session RET\nto recover"
- " the files you were editing."))
-
- ;; Display the input that we set up in the buffer.
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (save-window-excursion
- (switch-to-buffer (current-buffer))
- (sit-for 120))))
+ ;; The rest of the startup screen is the same on all
+ ;; kinds of terminals.
+
+ ;; Give information on recovering, if there was a crash.
+ (and auto-save-list-file-prefix
+ ;; Don't signal an error if the
+ ;; directory for auto-save-list files
+ ;; does not yet exist.
+ (file-directory-p (file-name-directory
+ auto-save-list-file-prefix))
+ (directory-files
+ (file-name-directory auto-save-list-file-prefix)
+ nil
+ (concat "\\`"
+ (regexp-quote (file-name-nondirectory
+ auto-save-list-file-prefix)))
+ t)
+ (insert "\n\nIf an Emacs session crashed recently, "
+ "type Meta-x recover-session RET\nto recover"
+ " the files you were editing."))
+
+ ;; Display the input that we set up in the buffer.
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (if (and view-read-only (not view-mode))
+ (view-mode-enter nil 'kill-buffer))
+ (goto-char (point-min))
+ (if hide-on-input
+ (if (or (window-minibuffer-p)
+ (window-dedicated-p (selected-window)))
+ ;; If hide-on-input is nil, creating a new frame will
+ ;; generate enough events that the subsequent `sit-for'
+ ;; will immediately return anyway.
+ nil ;; (pop-to-buffer (current-buffer))
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (sit-for 120)))
+ (condition-case nil
+ (switch-to-buffer (current-buffer))
+ ;; In case the window is dedicated or something.
+ (error (pop-to-buffer (current-buffer))))))
;; Unwind ... ensure splash buffer is killed
- (kill-buffer "GNU Emacs"))))
+ (if hide-on-input
+ (kill-buffer "GNU Emacs")
+ (switch-to-buffer "GNU Emacs")
+ (rename-buffer "*About GNU Emacs*" t)))))
(defun startup-echo-area-message ()
(defun display-startup-echo-area-message ()
(let ((resize-mini-windows t))
- (message (startup-echo-area-message))))
+ (message "%s" (startup-echo-area-message))))
-(defun display-splash-screen ()
+(defun display-splash-screen (&optional hide-on-input)
"Display splash screen according to display.
Fancy splash screens are used on graphic displays,
-normal otherwise."
- (interactive)
+normal otherwise.
+With a prefix argument, any user input hides the splash screen."
+ (interactive "P")
(if (use-fancy-splash-screens-p)
- (fancy-splash-screens)
- (normal-splash-screen)))
+ (fancy-splash-screens hide-on-input)
+ (normal-splash-screen hide-on-input)))
(defun command-line-1 (command-line-args-left)
(when init-file-had-error
(sit-for 2))
+ (when (and pure-space-overflow
+ (not noninteractive))
+ (display-warning
+ 'initialization
+ "Building Emacs overflowed pure space. (See the node Pure Storage in the Lisp manual for details.)"
+ :warning))
+
(when command-line-args-left
;; We have command args; process them.
(let ((dir command-line-default-directory)
(longopts
(append '(("--funcall") ("--load") ("--insert") ("--kill")
("--directory") ("--eval") ("--execute") ("--no-splash")
- ("--find-file") ("--visit") ("--file"))
+ ("--find-file") ("--visit") ("--file") ("--no-desktop"))
(mapcar (lambda (elt)
(list (concat "-" (car elt))))
command-switch-alist)))
(setq file file-ex))
(load file nil t)))
+ ;; This is used to handle -script. It's not clear
+ ;; we need to document it.
+ ((member argi '("-scriptload"))
+ (let* ((file (command-line-normalize-file-name
+ (or argval (pop command-line-args-left))))
+ ;; Take file from default dir.
+ (file-ex (expand-file-name file)))
+ (load file-ex nil t t)))
+
((equal argi "-insert")
(setq tem (or argval (pop command-line-args-left)))
(or (stringp tem)
((equal argi "-kill")
(kill-emacs t))
+ ;; This is for when they use --no-desktop with -q, or
+ ;; don't load Desktop in their .emacs. If desktop.el
+ ;; _is_ loaded, it will handle this switch, and we
+ ;; won't see it by the time we get here.
+ ((equal argi "-no-desktop")
+ (message "\"--no-desktop\" ignored because the Desktop package is not loaded"))
+
((string-match "^\\+[0-9]+\\'" argi)
- (setq line (string-to-int argi)))
+ (setq line (string-to-number argi)))
((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
- (setq line (string-to-int (match-string 1 argi))
- column (string-to-int (match-string 2 argi))))
+ (setq line (string-to-number (match-string 1 argi))
+ column (string-to-number (match-string 2 argi))))
((setq tem (assoc argi command-line-x-option-alist))
;; Ignore X-windows options and their args if not using X.
(setq line 0)
(unless (< column 1)
(move-to-column (1- column)))
- (setq column 0))))))))
+ (setq column 0))))))
+ ;; In unusual circumstances, the execution of Lisp code due
+ ;; to command-line options can cause the last visible frame
+ ;; to be deleted. In this case, kill emacs to avoid an
+ ;; abort later.
+ (unless (frame-live-p (selected-frame)) (kill-emacs nil))))
;; If 3 or more files visited, and not all visible,
;; show user what they all are. But leave the last one current.
;; Maybe display a startup screen.
(unless (or inhibit-startup-message
noninteractive
- emacs-quick-startup
- ;; Don't display startup screen if init file
- ;; has started some sort of server.
- (and (fboundp 'process-list)
- (process-list)))
+ emacs-quick-startup)
;; Display a startup screen, after some preparations.
;; If there are no switches to process, we might as well
(with-no-warnings
(setq menubar-bindings-done t))
- ;; If *scratch* is selected and it is empty, insert an
- ;; initial message saying not to create a file there.
- (when (and initial-scratch-message
- (equal (buffer-name) "*scratch*")
- (= 0 (buffer-size)))
- (insert initial-scratch-message)
- (set-buffer-modified-p nil))
+ ;; If *scratch* exists and is empty, insert initial-scratch-message.
+ (and initial-scratch-message
+ (get-buffer "*scratch*")
+ (with-current-buffer "*scratch*"
+ (when (zerop (buffer-size))
+ (insert initial-scratch-message)
+ (set-buffer-modified-p nil))))
;; If user typed input during all that work,
;; abort the startup screen. Otherwise, display it now.
(unless (input-pending-p)
- (display-splash-screen))))
+ (display-splash-screen t))))
(defun command-line-normalize-file-name (file)