;;; 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
"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)
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.
: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)
;; 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))
(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
(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))
(custom-reevaluate-setting 'blink-cursor-mode)
(custom-reevaluate-setting 'normal-erase-is-backspace)
(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.
(setq inhibit-startup-message nil)
;; Warn for invalid user name.
- (and init-file-user
- (not (file-directory-p (expand-file-name (concat "~" init-file-user))))
- (display-warning 'initialization
- (format "User %s has no home directory"
- init-file-user)
- :error))
+ (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
(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.
"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)
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) 2005 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) 2005 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-number argi)))
(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)