;;; startup.el --- process Emacs shell arguments
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(defcustom inhibit-splash-screen nil
"Non-nil inhibits the startup screen.
-It also inhibits display of the initial message in the *scratch* buffer.
+It also inhibits display of the initial message in the `*scratch*' buffer.
-This is for use in your personal init file, once you are familiar
-with the contents of the startup screen."
+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)
("--foreground-color" 1 x-handle-switch foreground-color)
("--background-color" 1 x-handle-switch background-color)
("--mouse-color" 1 x-handle-switch mouse-color)
- ("--no-bitmap-icon" 0 x-handle-switch icon-type nil)
+ ("--no-bitmap-icon" 0 x-handle-no-bitmap-icon)
("--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 auto-save-list-file-prefix
(cond ((eq system-type 'ms-dos)
;; MS-DOS cannot have initial dot, and allows only 8.3 names
- "~/_emacs.d/auto-save.list/_s")
+ (concat user-emacs-directory "auto-save.list/_s"))
(t
- "~/.emacs.d/auto-save-list/.saves-"))
+ (concat user-emacs-directory "auto-save-list/.saves-")))
"Prefix for generating `auto-save-list-file-name'.
This is used after reading your `.emacs' file to initialize
`auto-save-list-file-name', by appending Emacs's pid and the system name,
;; 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 to absolute.
- (let ((lisp-dir
- (file-truename
- (file-name-directory
- (locate-file "simple" load-path
- (get-load-suffixes))))))
-
- (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 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)))
(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
(if (get-buffer "*scratch*")
(with-current-buffer "*scratch*"
(if (eq major-mode 'fundamental-mode)
- (funcall initial-major-mode))))
+ (funcall initial-major-mode))
+ ;; Don't lose text that users type in *scratch*.
+ (setq buffer-offer-save t)
+ (auto-save-mode 1)))
;; Load library for our terminal type.
;; User init file can set term-file-prefix to nil to prevent this.
;; 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
-View Emacs Manual\tView the Emacs manual using Info
+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 :weight bold)
+ (:face variable-pitch
+ "\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 "
"Control-c"
:face variable-pitch
")
-Recover Crashed Session\tRecover files you were editing before a crash
-
-
-
-
-
-"
+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.
:face 'variable-pitch
"Type "
:face 'default
- (substitute-command-keys
- "\\[recenter]")
+ "Control-l"
:face 'variable-pitch
" to begin editing"
(if (equal (buffer-name fancy-splash-outer-buffer)
(emacs-version)
"\n"
:face '(variable-pitch :height 0.5)
- "Copyright (C) 2006 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
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
(define-key map [mouse-movement] 'ignore)
(define-key map [mode-line t] 'ignore)
(define-key map [select-window] '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
(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)
+ emulation-mode-map-alists old-emulation-mode-map-alists
+ special-event-map old-special-event-map)
(kill-buffer splash-buffer)
(when (frame-live-p frame)
(select-frame frame)
- (switch-to-buffer fancy-splash-outer-buffer))))))
+ (switch-to-buffer fancy-splash-outer-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)))
(view-mode-enter nil 'kill-buffer))
(goto-char (point-min)))))
+(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-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 (&optional hide-on-input)
(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)
More Manuals / Ordering Manuals How to order printed manuals from the FSF
")
(insert "\n\n" (emacs-version)
- "
-Copyright (C) 2006 Free Software Foundation, Inc."))
+ "\n" emacs-copyright))
;; No mouse menus, so give help using kbd commands.
\(`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) 2006 Free Software Foundation, Inc.")
+ (insert "\n\n" (emacs-version)
+ "\n" emacs-copyright)
(if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
(eq (key-binding "\C-h\C-d") 'describe-distribution)
(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.
HCoop / bpt / emacs.git / blobdiff