]> code.delx.au - gnu-emacs/blobdiff - lisp/startup.el
(python-comment-line-p, python-blank-line-p, python-skip-out,
[gnu-emacs] / lisp / startup.el
index ad09ff2e83443e366b6e72164cb1638de90f9f41..eb8898551eb0867551ad2086d554d970460af9d2 100644 (file)
@@ -1,17 +1,18 @@
 ;;; startup.el --- process Emacs shell arguments
 
 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
 ;;; startup.el --- process Emacs shell arguments
 
 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;;   2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Maintainer: FSF
 ;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 
   "Emacs start-up procedure."
   :group 'environment)
 
   "Emacs start-up procedure."
   :group 'environment)
 
+(defcustom initial-buffer-choice nil
+  "Buffer to show after starting Emacs.
+If the value is nil and `inhibit-startup-screen' is nil, show the
+startup screen.  If the value is string, visit the specified file or
+directory using `find-file'.  If t, open the `*scratch*' buffer."
+  :type '(choice
+         (const     :tag "Startup screen" nil)
+         (directory :tag "Directory" :value "~/")
+         (file      :tag "File" :value "~/file.txt")
+         (const     :tag "Lisp scratch buffer" t))
+  :version "23.1"
+  :group 'initialization)
+
 (defcustom inhibit-startup-screen nil
   "Non-nil inhibits the startup screen.
 (defcustom inhibit-startup-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."
 
 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."
@@ -87,6 +98,12 @@ the remaining command-line args are in the variable `command-line-args-left'.")
 (defvar command-line-args-left nil
   "List of command-line args not yet processed.")
 
 (defvar command-line-args-left nil
   "List of command-line args not yet processed.")
 
+(defvaralias 'argv 'command-line-args-left
+  "List of command-line args not yet processed.
+This is a convenience alias, so that one can write \(pop argv\)
+inside of --eval command line arguments in order to access
+following arguments.")
+
 (defvar command-line-functions nil    ;; lrs 7/31/89
   "List of functions to process unrecognized command-line arguments.
 Each function should access the dynamically bound variables
 (defvar command-line-functions nil    ;; lrs 7/31/89
   "List of functions to process unrecognized command-line arguments.
 Each function should access the dynamically bound variables
@@ -154,7 +171,8 @@ This is normally copied from `default-directory' when Emacs starts.")
     ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
     ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
     ("--border-color" 1 x-handle-switch border-color)
     ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
     ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
     ("--border-color" 1 x-handle-switch border-color)
-    ("--smid" 1 x-handle-smid))
+    ("--smid" 1 x-handle-smid)
+    ("--parent-id" 1 x-handle-parent-id))
   "Alist of X Windows options.
 Each element has the form
   (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
   "Alist of X Windows options.
 Each element has the form
   (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
@@ -173,6 +191,12 @@ There is no `condition-case' around the running of these functions;
 therefore, if you set `debug-on-error' non-nil in `.emacs',
 an error in one of these functions will invoke the debugger.")
 
 therefore, if you set `debug-on-error' non-nil in `.emacs',
 an error in one of these functions will invoke the debugger.")
 
+(defvar before-init-time nil
+  "Value of `current-time' before Emacs begins initialization.")
+
+(defvar after-init-time nil
+  "Value of `current-time' after loading the init files.")
+
 (defvar emacs-startup-hook nil
   "Normal hook run after loading init files and handling the command line.")
 
 (defvar emacs-startup-hook nil
   "Normal hook run after loading init files and handling the command line.")
 
@@ -266,9 +290,9 @@ init file is read, in case it sets `mail-host-address'."
 (defcustom auto-save-list-file-prefix
   (cond ((eq system-type 'ms-dos)
         ;; MS-DOS cannot have initial dot, and allows only 8.3 names
 (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
        (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,
   "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,
@@ -302,6 +326,14 @@ from being initialized."
 Warning Warning!!!  Pure space overflow    !!!Warning Warning
 \(See the node Pure Storage in the Lisp manual for details.)\n")
 
 Warning Warning!!!  Pure space overflow    !!!Warning Warning
 \(See the node Pure Storage in the Lisp manual for details.)\n")
 
+(defvar tutorial-directory nil
+  "Directory containing the Emacs TUTORIAL files.")
+
+;; Get correct value in a dumped, installed Emacs.
+(eval-at-startup
+ (setq tutorial-directory (file-name-as-directory
+                           (expand-file-name "tutorials" data-directory))))
+
 (defun normal-top-level-add-subdirs-to-load-path ()
   "Add all subdirectories of current directory to `load-path'.
 More precisely, this uses only the subdirectories whose names
 (defun normal-top-level-add-subdirs-to-load-path ()
   "Add all subdirectories of current directory to `load-path'.
 More precisely, this uses only the subdirectories whose names
@@ -444,36 +476,19 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
        ;; for instance due to a dense colormap.
        (when (or frame-initial-frame
                  ;; If frame-initial-frame has no meaning, do this anyway.
        ;; for instance due to a dense colormap.
        (when (or frame-initial-frame
                  ;; If frame-initial-frame has no meaning, do this anyway.
-                 (not (and window-system
+                 (not (and initial-window-system
                            (not noninteractive)
                            (not noninteractive)
-                           (not (eq window-system 'pc)))))
+                           (not (eq initial-window-system 'pc)))))
          ;; Modify the initial frame based on what .emacs puts into
          ;; ...-frame-alist.
          (if (fboundp 'frame-notice-user-settings)
              (frame-notice-user-settings))
          ;; Modify the initial frame based on what .emacs puts into
          ;; ...-frame-alist.
          (if (fboundp 'frame-notice-user-settings)
              (frame-notice-user-settings))
+         ;; Set the faces for the initial background mode even if
+         ;; 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.
          (if (fboundp 'frame-set-background-mode)
          (if (fboundp 'frame-set-background-mode)
-             ;; Set the faces for the initial background mode even if
-             ;; 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 (selected-frame))
-                   term)
-               (when (and (null window-system)
-                          ;; 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"
-                                                         "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 default-frame-background-mode 'light)))
-               (frame-set-background-mode (selected-frame)))))
+             (frame-set-background-mode (selected-frame))))
 
        ;; Now we know the user's default font, so add it to the menu.
        (if (fboundp 'font-menu-add-default)
 
        ;; Now we know the user's default font, so add it to the menu.
        (if (fboundp 'font-menu-add-default)
@@ -482,7 +497,25 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
             (run-hooks 'window-setup-hook))
        (or menubar-bindings-done
            (if (display-popup-menus-p)
             (run-hooks 'window-setup-hook))
        (or menubar-bindings-done
            (if (display-popup-menus-p)
-               (precompute-menubar-bindings)))))))
+               (precompute-menubar-bindings)))))
+    ;; Subprocesses of Emacs do not have direct access to the terminal, so
+    ;; unless told otherwise they should only assume a dumb terminal.
+    ;; We are careful to do it late (after term-setup-hook), although the
+    ;; new multi-tty code does not use $TERM any more there anyway.
+    (setenv "TERM" "dumb")
+    ;; Remove DISPLAY from the process-environment as well.  This allows
+    ;; `callproc.c' to give it a useful adaptive default which is either
+    ;; the value of the `display' frame-parameter or the DISPLAY value
+    ;; from initial-environment.
+    (let ((display (frame-parameter nil 'display)))
+      ;; Be careful which DISPLAY to remove from process-environment: follow
+      ;; the logic of `callproc.c'.
+      (if (stringp display) (setq display (concat "DISPLAY=" display))
+        (dolist (varval initial-environment)
+          (if (string-match "\\`DISPLAY=" varval)
+              (setq display varval))))
+      (when display
+        (delete display process-environment)))))
 
 ;; Precompute the keyboard equivalents in the menu bar items.
 (defun precompute-menubar-bindings ()
 
 ;; Precompute the keyboard equivalents in the menu bar items.
 (defun precompute-menubar-bindings ()
@@ -514,6 +547,20 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
 (defvar tool-bar-originally-present nil
   "Non-nil if tool-bars are present before user and site init files are read.")
 
 (defvar tool-bar-originally-present nil
   "Non-nil if tool-bars are present before user and site init files are read.")
 
+(defvar handle-args-function-alist '((nil . tty-handle-args))
+  "Functions for processing window-system dependent command-line arguments.
+Window system startup files should add their own function to this
+alist, which should parse the command line arguments.  Those
+pertaining to the window system should be processed and removed
+from the returned command line.")
+
+(defvar window-system-initialization-alist '((nil . ignore))
+  "Alist of window-system initialization functions.
+Window-system startup files should add their own initialization
+function to this list.  The function should take no arguments,
+and initialize the window system environment to prepare for
+opening the first frame (e.g. open a connection to an X server).")
+
 ;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc.
 (defun tty-handle-args (args)
   (let (rest)
 ;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc.
 (defun tty-handle-args (args)
   (let (rest)
@@ -581,7 +628,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
     (nreverse rest)))
 
 (defun command-line ()
     (nreverse rest)))
 
 (defun command-line ()
-  (setq command-line-default-directory default-directory)
+  (setq before-init-time (current-time)
+        command-line-default-directory default-directory)
 
   ;; Choose a reasonable location for temporary files.
   (custom-reevaluate-setting 'temporary-file-directory)
 
   ;; Choose a reasonable location for temporary files.
   (custom-reevaluate-setting 'temporary-file-directory)
@@ -618,16 +666,22 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
     (setq eol-mnemonic-dos  "(DOS)"
           eol-mnemonic-mac  "(Mac)")))
 
     (setq eol-mnemonic-dos  "(DOS)"
           eol-mnemonic-mac  "(Mac)")))
 
-  ;; Read window system's init file if using a window system.
+  ;; Make sure window system's init file was loaded in loadup.el if using a window system.
   (condition-case error
   (condition-case error
-      (if (and window-system (not noninteractive))
-         (load (concat term-file-prefix
-                       (symbol-name window-system)
-                       "-win")
-               ;; Every window system should have a startup file;
-               ;; barf if we can't find it.
-               nil t))
-    ;; If we can't read it, print the error message and exit.
+    (unless noninteractive
+      (if (and initial-window-system
+              (not (featurep
+                    (intern (concat (symbol-name initial-window-system) "-win")))))
+         (error "Unsupported window system `%s'" initial-window-system))
+      ;; Process window-system specific command line parameters.
+      (setq command-line-args
+           (funcall (or (cdr (assq initial-window-system handle-args-function-alist))
+                        (error "Unsupported window system `%s'" initial-window-system))
+                    command-line-args))
+      ;; Initialize the window system. (Open connection, etc.)
+      (funcall (or (cdr (assq initial-window-system window-system-initialization-alist))
+                  (error "Unsupported window system `%s'" initial-window-system))))
+    ;; If there was an error, print the error message and exit.
     (error
      (princ
       (if (eq (car error) 'error)
     (error
      (princ
       (if (eq (car error) 'error)
@@ -643,13 +697,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
                              (cdr error) ", "))))
       'external-debugging-output)
      (terpri 'external-debugging-output)
                              (cdr error) ", "))))
       'external-debugging-output)
      (terpri 'external-debugging-output)
-     (setq window-system nil)
+     (setq initial-window-system nil)
      (kill-emacs)))
 
      (kill-emacs)))
 
-  ;; Windowed displays do this inside their *-win.el.
-  (unless (or (display-graphic-p) noninteractive)
-    (setq command-line-args (tty-handle-args command-line-args)))
-
   (set-locale-environment nil)
 
   ;; Convert preloaded file names in load-history to absolute.
   (set-locale-environment nil)
 
   ;; Convert preloaded file names in load-history to absolute.
@@ -772,7 +822,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
   ;; If frame was created with a menu bar, set menu-bar-mode on.
   (unless (or noninteractive
              emacs-basic-display
   ;; If frame was created with a menu bar, set menu-bar-mode on.
   (unless (or noninteractive
              emacs-basic-display
-              (and (memq window-system '(x w32))
+              (and (memq initial-window-system '(x w32))
                    (<= (frame-parameter nil 'menu-bar-lines) 0)))
     (menu-bar-mode 1))
 
                    (<= (frame-parameter nil 'menu-bar-lines) 0)))
     (menu-bar-mode 1))
 
@@ -786,7 +836,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
   ;; Can't do this init in defcustom because the relevant variables
   ;; are not set.
   (custom-reevaluate-setting 'blink-cursor-mode)
   ;; Can't do this init in defcustom because the relevant variables
   ;; are not set.
   (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 'tooltip-mode)
   (custom-reevaluate-setting 'global-font-lock-mode)
   (custom-reevaluate-setting 'mouse-wheel-down-event)
@@ -794,14 +843,19 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
   (custom-reevaluate-setting 'file-name-shadow-mode)
   (custom-reevaluate-setting 'send-mail-function)
   (custom-reevaluate-setting 'focus-follows-mouse)
   (custom-reevaluate-setting 'file-name-shadow-mode)
   (custom-reevaluate-setting 'send-mail-function)
   (custom-reevaluate-setting 'focus-follows-mouse)
+  (custom-reevaluate-setting 'global-auto-composition-mode)
+  (custom-reevaluate-setting 'transient-mark-mode)
+  (custom-reevaluate-setting 'auto-encryption-mode)
+
+  (normal-erase-is-backspace-setup-frame)
 
   ;; Register default TTY colors for the case the terminal hasn't a
 
   ;; Register default TTY colors for the case the terminal hasn't a
-  ;; terminal init file.
-  (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.
-    (tty-register-default-colors))
+  ;; terminal init file.  We do this regardles of whether the terminal
+  ;; supports colors or not and regardless the current display type,
+  ;; since users can connect to color-capable terminals and also
+  ;; switch color support on or off in mid-session by setting the
+  ;; tty-color-mode frame parameter.
+  (tty-register-default-colors)
 
   ;; Record whether the tool-bar is present before the user and site
   ;; init files are processed.  frame-notice-user-settings uses this
 
   ;; Record whether the tool-bar is present before the user and site
   ;; init files are processed.  frame-notice-user-settings uses this
@@ -965,11 +1019,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
            (with-current-buffer (window-buffer)
              (deactivate-mark)))
 
            (with-current-buffer (window-buffer)
              (deactivate-mark)))
 
-       ;; If the user has a file of abbrevs, read it.
-        ;; 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)
+       ;; If the user has a file of abbrevs, read it (unless -batch).
+       (when (and (not noninteractive)
+                  (file-exists-p abbrev-file-name)
                   (file-readable-p abbrev-file-name))
            (quietly-read-abbrev-file abbrev-file-name))
 
                   (file-readable-p abbrev-file-name))
            (quietly-read-abbrev-file abbrev-file-name))
 
@@ -990,11 +1042,11 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
        ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*).
        ;; Arguably this should only be done if they're free of
        ;; multibyte characters.
        ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*).
        ;; Arguably this should only be done if they're free of
        ;; multibyte characters.
-       (mapcar (lambda (buffer)
-                 (with-current-buffer buffer
-                   (if enable-multibyte-characters
-                       (set-buffer-multibyte nil))))
-               (buffer-list))
+       (mapc (lambda (buffer)
+               (with-current-buffer buffer
+                 (if enable-multibyte-characters
+                     (set-buffer-multibyte nil))))
+             (buffer-list))
        ;; Also re-set the language environment in case it was
        ;; originally done before unibyte was set and is sensitive to
        ;; unibyte (display table, terminal coding system &c).
        ;; Also re-set the language environment in case it was
        ;; originally done before unibyte was set and is sensitive to
        ;; unibyte (display table, terminal coding system &c).
@@ -1047,6 +1099,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
                 (eq face-ignored-fonts old-face-ignored-fonts))
       (clear-face-cache)))
 
                 (eq face-ignored-fonts old-face-ignored-fonts))
       (clear-face-cache)))
 
+  (setq after-init-time (current-time))
   (run-hooks 'after-init-hook)
 
   ;; Decode all default-directory.
   (run-hooks 'after-init-hook)
 
   ;; Decode all default-directory.
@@ -1071,31 +1124,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
   ;; Load library for our terminal type.
   ;; User init file can set term-file-prefix to nil to prevent this.
   (unless (or noninteractive
   ;; Load library for our terminal type.
   ;; User init file can set term-file-prefix to nil to prevent this.
   (unless (or noninteractive
-              window-system
-              (null term-file-prefix))
-    (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))
-                  (substring term 0 hyphend)
-                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))))))
+              initial-window-system)
+    (tty-run-terminal-initialization (selected-frame)))
 
   ;; Update the out-of-memory error message based on user's key bindings
   ;; for save-some-buffers.
 
   ;; Update the out-of-memory error message based on user's key bindings
   ;; for save-some-buffers.
@@ -1123,9 +1153,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
 
 ")
   "Initial message displayed in *scratch* buffer at startup.
 
 ")
   "Initial message displayed in *scratch* buffer at startup.
-If this is nil, no message will be displayed.
-If `inhibit-startup-screen' is non-nil, then no message is displayed,
-regardless of the value of this variable."
+If this is nil, no message will be displayed."
   :type '(choice (text :tag "Message")
                 (const :tag "none" nil))
   :group 'initialization)
   :type '(choice (text :tag "Message")
                 (const :tag "none" nil))
   :group 'initialization)
@@ -1136,7 +1164,7 @@ regardless of the value of this variable."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar fancy-startup-text
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar fancy-startup-text
-  '((:face (variable-pitch :foreground "red")
+  '((:face (variable-pitch (:foreground "red"))
      "Welcome to "
      :link ("GNU Emacs"
            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
      "Welcome to "
      :link ("GNU Emacs"
            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1148,7 +1176,7 @@ regardless of the value of this variable."
           '("GNU/Linux"
             (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
             "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
           '("GNU/Linux"
             (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
             "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
-        '("GNU" (lambda (button) (describe-project))
+        '("GNU" (lambda (button) (describe-gnu-project))
           "Display info on the GNU project")))
      " operating system.\n"
      :face variable-pitch "To quit a partially entered command, type "
           "Display info on the GNU project")))
      " operating system.\n"
      :face variable-pitch "To quit a partially entered command, type "
@@ -1163,7 +1191,7 @@ regardless of the value of this variable."
                       en))
              (title (with-temp-buffer
                       (insert-file-contents
                       en))
              (title (with-temp-buffer
                       (insert-file-contents
-                       (expand-file-name tut data-directory)
+                       (expand-file-name tut tutorial-directory)
                        nil 0 256)
                       (search-forward ".")
                       (buffer-substring (point-min) (1- (point))))))
                        nil 0 256)
                       (search-forward ".")
                       (buffer-substring (point-min) (1- (point))))))
@@ -1182,7 +1210,7 @@ regardless of the value of this variable."
      "\tView the Emacs manual using Info\n"
      :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
      "\tGNU Emacs comes with "
      "\tView the Emacs manual using Info\n"
      :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
      "\tGNU Emacs comes with "
-     :face (variable-pitch :slant oblique)
+     :face (variable-pitch (:slant oblique))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
      :link ("Copying Conditions" (lambda (button) (describe-copying)))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
      :link ("Copying Conditions" (lambda (button) (describe-copying)))
@@ -1195,7 +1223,7 @@ Each element in the list should be a list of strings or pairs
 `:face FACE', like `fancy-splash-insert' accepts them.")
 
 (defvar fancy-about-text
 `:face FACE', like `fancy-splash-insert' accepts them.")
 
 (defvar fancy-about-text
-  '((:face (variable-pitch :foreground "red")
+  '((:face (variable-pitch (:foreground "red"))
      "This is "
      :link ("GNU Emacs"
            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
      "This is "
      :link ("GNU Emacs"
            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1207,25 +1235,37 @@ Each element in the list should be a list of strings or pairs
           '("GNU/Linux"
             (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
             "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
           '("GNU/Linux"
             (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
             "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
-        '("GNU" (lambda (button) (describe-project))
+        '("GNU" (lambda (button) (describe-gnu-project))
           "Display info on the GNU project.")))
      " operating system.\n"
      :face (lambda ()
           "Display info on the GNU project.")))
      " operating system.\n"
      :face (lambda ()
-            (list 'variable-pitch :foreground
-                  (if (eq (frame-parameter nil 'background-mode) 'dark)
-                      "cyan" "darkblue")))
+            (list 'variable-pitch
+                  (list :foreground
+                        (if (eq (frame-parameter nil 'background-mode) 'dark)
+                            "cyan" "darkblue"))))
      "\n"
      (lambda () (emacs-version))
      "\n"
      "\n"
      (lambda () (emacs-version))
      "\n"
-     :face (variable-pitch :height 0.5)
+     :face (variable-pitch (:height 0.5))
      (lambda () emacs-copyright)
      "\n\n"
      :face variable-pitch
      (lambda () emacs-copyright)
      "\n\n"
      :face variable-pitch
-     :link ("GNU and Freedom" (lambda (button) (describe-project)))
+     :link ("Authors"
+           (lambda (button)
+             (view-file (expand-file-name "AUTHORS" data-directory))
+             (goto-char (point-min))))
+     "\tMany people have contributed code included in GNU Emacs\n"
+     :link ("Contributing"
+           (lambda (button)
+             (view-file (expand-file-name "CONTRIBUTE" data-directory))
+             (goto-char (point-min))))
+     "\tHow to contribute improvements to Emacs\n"
+     "\n"
+     :link ("GNU and Freedom" (lambda (button) (describe-gnu-project)))
      "\tWhy we developed GNU Emacs, and the GNU operating system\n"
      :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
      "\tGNU Emacs comes with "
      "\tWhy we developed GNU Emacs, and the GNU operating system\n"
      :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
      "\tGNU Emacs comes with "
-     :face (variable-pitch :slant oblique)
+     :face (variable-pitch (:slant oblique))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
      :link ("Copying Conditions" (lambda (button) (describe-copying)))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
      :link ("Copying Conditions" (lambda (button) (describe-copying)))
@@ -1244,7 +1284,7 @@ Each element in the list should be a list of strings or pairs
                       en))
              (title (with-temp-buffer
                       (insert-file-contents
                       en))
              (title (with-temp-buffer
                       (insert-file-contents
-                       (expand-file-name tut data-directory)
+                       (expand-file-name tut tutorial-directory)
                        nil 0 256)
                       (search-forward ".")
                       (buffer-substring (point-min) (1- (point))))))
                        nil 0 256)
                       (search-forward ".")
                       (buffer-substring (point-min) (1- (point))))))
@@ -1288,8 +1328,6 @@ Each element in the list should be a list of strings or pairs
 
 ;; These are temporary storage areas for the splash screen display.
 
 
 ;; These are temporary storage areas for the splash screen display.
 
-(defvar fancy-splash-help-echo nil)
-
 (defun fancy-splash-insert (&rest args)
   "Insert text into the current buffer, with faces.
 Arguments from ARGS should be either strings; functions called
 (defun fancy-splash-insert (&rest args)
   "Insert text into the current buffer, with faces.
 Arguments from ARGS should be either strings; functions called
@@ -1323,7 +1361,7 @@ a face or button specification."
                                         (funcall it)
                                       it))
                                   'face current-face
                                         (funcall it)
                                       it))
                                   'face current-face
-                                  'help-echo fancy-splash-help-echo))))
+                                  'help-echo (startup-echo-area-message)))))
       (setq args (cdr args)))))
 
 
       (setq args (cdr args)))))
 
 
@@ -1381,11 +1419,11 @@ a face or button specification."
               (lambda (button) (customize-group 'initialization))
               "Change initialization settings including this screen")
        "\n"))
               (lambda (button) (customize-group 'initialization))
               "Change initialization settings including this screen")
        "\n"))
-    (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
+    (fancy-splash-insert :face `(variable-pitch (:foreground ,fg))
                         "\nThis is "
                         (emacs-version)
                         "\n"
                         "\nThis is "
                         (emacs-version)
                         "\n"
-                        :face '(variable-pitch :height 0.5)
+                        :face '(variable-pitch (:height 0.5))
                         emacs-copyright
                         "\n")
     (and auto-save-list-file-prefix
                         emacs-copyright
                         "\n")
     (and auto-save-list-file-prefix
@@ -1401,12 +1439,12 @@ a face or button specification."
                  (regexp-quote (file-name-nondirectory
                                 auto-save-list-file-prefix)))
          t)
                  (regexp-quote (file-name-nondirectory
                                 auto-save-list-file-prefix)))
          t)
-        (fancy-splash-insert :face '(variable-pitch :foreground "red")
+        (fancy-splash-insert :face '(variable-pitch (:foreground "red"))
                              "\nIf an Emacs session crashed recently, "
                              "type "
                              :face '(fixed-pitch :foreground "red")
                              "Meta-x recover-session RET"
                              "\nIf an Emacs session crashed recently, "
                              "type "
                              :face '(fixed-pitch :foreground "red")
                              "Meta-x recover-session RET"
-                             :face '(variable-pitch :foreground "red")
+                             :face '(variable-pitch (:foreground "red"))
                              "\nto recover"
                              " the files you were editing."))
 
                              "\nto recover"
                              " the files you were editing."))
 
@@ -1441,7 +1479,7 @@ a face or button specification."
                       (overlay-put button 'checked t)
                       (overlay-put button 'display (overlay-get button :on-glyph))
                       (setq startup-screen-inhibit-startup-screen t)))))
                       (overlay-put button 'checked t)
                       (overlay-put button 'display (overlay-get button :on-glyph))
                       (setq startup-screen-inhibit-startup-screen t)))))
-       (fancy-splash-insert :face '(variable-pitch :height 0.9)
+       (fancy-splash-insert :face '(variable-pitch (:height 0.9))
                             " Never show it again.")))))
 
 (defun exit-splash-screen ()
                             " Never show it again.")))))
 
 (defun exit-splash-screen ()
@@ -1457,6 +1495,7 @@ splash screen in another window."
     (with-current-buffer splash-buffer
       (let ((inhibit-read-only t))
        (erase-buffer)
     (with-current-buffer splash-buffer
       (let ((inhibit-read-only t))
        (erase-buffer)
+       (setq default-directory command-line-default-directory)
        (make-local-variable 'startup-screen-inhibit-startup-screen)
        (if pure-space-overflow
            (insert pure-space-overflow-message))
        (make-local-variable 'startup-screen-inhibit-startup-screen)
        (if pure-space-overflow
            (insert pure-space-overflow-message))
@@ -1505,8 +1544,6 @@ splash screen in another window."
        (dolist (text fancy-about-text)
          (apply #'fancy-splash-insert text)
          (insert "\n"))
        (dolist (text fancy-about-text)
          (apply #'fancy-splash-insert text)
          (insert "\n"))
-       (unless (current-message)
-         (message fancy-splash-help-echo))
        (set-buffer-modified-p nil)
        (goto-char (point-min))
        (force-mode-line-update))
        (set-buffer-modified-p nil)
        (goto-char (point-min))
        (force-mode-line-update))
@@ -1549,14 +1586,17 @@ we put it on this frame."
          (> frame-height (+ image-height 19)))))))
 
 
          (> frame-height (+ image-height 19)))))))
 
 
-(defun normal-splash-screen (&optional startup)
+(defun normal-splash-screen (&optional startup concise)
   "Display non-graphic splash screen.
 If optional argument STARTUP is non-nil, display the startup screen
   "Display non-graphic splash screen.
 If optional argument STARTUP is non-nil, display the startup screen
-after Emacs starts.  If STARTUP is nil, display the About screen."
-  (let ((prev-buffer (current-buffer)))
-    (with-current-buffer (get-buffer-create "*About GNU Emacs*")
+after Emacs starts.  If STARTUP is nil, display the About screen.
+If CONCISE is non-nil, display a concise version of the
+splash screen in another window."
+  (let ((splash-buffer (get-buffer-create "*About GNU Emacs*")))
+    (with-current-buffer splash-buffer
       (setq buffer-read-only nil)
       (erase-buffer)
       (setq buffer-read-only nil)
       (erase-buffer)
+      (setq default-directory command-line-default-directory)
       (set (make-local-variable 'tab-width) 8)
       (if (not startup)
          (set (make-local-variable 'mode-line-format)
       (set (make-local-variable 'tab-width) 8)
       (if (not startup)
          (set (make-local-variable 'mode-line-format)
@@ -1614,9 +1654,11 @@ after Emacs starts.  If STARTUP is nil, display the About screen."
       (setq buffer-read-only t)
       (if (and view-read-only (not view-mode))
          (view-mode-enter nil 'kill-buffer))
       (setq buffer-read-only t)
       (if (and view-read-only (not view-mode))
          (view-mode-enter nil 'kill-buffer))
-      (switch-to-buffer "*About GNU Emacs*")
       (if startup (rename-buffer "*GNU Emacs*" t))
       (if startup (rename-buffer "*GNU Emacs*" t))
-      (goto-char (point-min)))))
+      (goto-char (point-min)))
+    (if concise
+       (display-buffer splash-buffer)
+      (switch-to-buffer splash-buffer))))
 
 (defun normal-mouse-startup-screen ()
   ;; The user can use the mouse to activate menus
 
 (defun normal-mouse-startup-screen ()
   ;; The user can use the mouse to activate menus
@@ -1671,7 +1713,7 @@ To quit a partially entered command, type Control-g.\n")
   ;; use precomputed string to save lots of time.
   (if (and (eq (key-binding "\C-h") 'help-command)
           (eq (key-binding "\C-xu") 'advertised-undo)
   ;; 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-x\C-c") 'save-buffers-kill-terminal)
           (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-ht") 'help-with-tutorial)
           (eq (key-binding "\C-hi") 'info)
           (eq (key-binding "\C-hr") 'info-emacs-manual)
@@ -1726,7 +1768,7 @@ Get help\t   %s
                   'action (lambda (button) (view-order-manuals))
                   'follow-link t)
     (insert (substitute-command-keys
                   'action (lambda (button) (view-order-manuals))
                   'follow-link t)
     (insert (substitute-command-keys
-            "\t   \\[view-order-manuals]\tExit Emacs\t   \\[save-buffers-kill-emacs]")))
+            "\t   \\[view-order-manuals]\tExit Emacs\t   \\[save-buffers-kill-terminal]")))
 
   ;; Say how to use the menu bar with the keyboard.
   (insert "\n")
 
   ;; Say how to use the menu bar with the keyboard.
   (insert "\n")
@@ -1812,8 +1854,24 @@ Type \\[describe-distribution] for information on "))
 
   (insert "To follow a link, click Mouse-1 on it, or move to it and type RET.\n\n")
 
 
   (insert "To follow a link, click Mouse-1 on it, or move to it and type RET.\n\n")
 
+  (insert-button "Authors"
+                'action
+                (lambda (button)
+                  (view-file (expand-file-name "AUTHORS" data-directory))
+                  (goto-char (point-min)))
+                'follow-link t)
+  (insert "\t\tMany people have contributed code included in GNU Emacs\n")
+
+  (insert-button "Contributing"
+                'action
+                (lambda (button)
+                  (view-file (expand-file-name "CONTRIBUTE" data-directory))
+                  (goto-char (point-min)))
+                'follow-link t)
+  (insert "\tHow to contribute improvements to Emacs\n\n")
+
   (insert-button "GNU and Freedom"
   (insert-button "GNU and Freedom"
-                'action (lambda (button) (describe-project))
+                'action (lambda (button) (describe-gnu-project))
                 'follow-link t)
   (insert "\t\tWhy we developed GNU Emacs and the GNU system\n")
 
                 'follow-link t)
   (insert "\t\tWhy we developed GNU Emacs and the GNU system\n")
 
@@ -1838,7 +1896,7 @@ Type \\[describe-distribution] for information on "))
   (insert "\tBuying printed manuals from the FSF\n"))
 
 (defun startup-echo-area-message ()
   (insert "\tBuying printed manuals from the FSF\n"))
 
 (defun startup-echo-area-message ()
-  (if (eq (key-binding "\C-h\C-p") 'describe-project)
+  (if (eq (key-binding "\C-h\C-a") 'about-emacs)
       "For information about GNU Emacs and the GNU system, type C-h C-a."
     (substitute-command-keys
      "For information about GNU Emacs and the GNU system, type \
       "For information about GNU Emacs and the GNU system, type C-h C-a."
     (substitute-command-keys
      "For information about GNU Emacs and the GNU system, type \
@@ -1888,7 +1946,7 @@ screen."
   (if (not (get-buffer "*GNU Emacs*"))
       (if (use-fancy-splash-screens-p)
          (fancy-startup-screen concise)
   (if (not (get-buffer "*GNU Emacs*"))
       (if (use-fancy-splash-screens-p)
          (fancy-startup-screen concise)
-       (normal-splash-screen t))))
+       (normal-splash-screen t concise))))
 
 (defun display-about-screen ()
   "Display the *About GNU Emacs* buffer.
 
 (defun display-about-screen ()
   "Display the *About GNU Emacs* buffer.
@@ -2026,7 +2084,7 @@ A fancy display is used on graphic displays, normal otherwise."
                     (load file nil t)))
 
                  ;; This is used to handle -script.  It's not clear
                     (load file nil t)))
 
                  ;; This is used to handle -script.  It's not clear
-                 ;; we need to document it.
+                 ;; we need to document it (it is totally internal).
                  ((member argi '("-scriptload"))
                   (let* ((file (command-line-normalize-file-name
                                 (or argval (pop command-line-args-left))))
                  ((member argi '("-scriptload"))
                   (let* ((file (command-line-normalize-file-name
                                 (or argval (pop command-line-args-left))))
@@ -2097,7 +2155,7 @@ A fancy display is used on graphic displays, normal otherwise."
                         (progn
                           (if (string-match "\\`-" argi)
                               (error "Unknown option `%s'" argi))
                         (progn
                           (if (string-match "\\`-" argi)
                               (error "Unknown option `%s'" argi))
-                          (unless window-system
+                          (unless initial-window-system
                             (setq inhibit-startup-screen t))
                           (setq file-count (1+ file-count))
                           (let ((file
                             (setq inhibit-startup-screen t))
                           (setq file-count (1+ file-count))
                           (let ((file
@@ -2121,7 +2179,22 @@ A fancy display is used on graphic displays, normal otherwise."
            ;; abort later.
            (unless (frame-live-p (selected-frame)) (kill-emacs nil))))))
 
            ;; abort later.
            (unless (frame-live-p (selected-frame)) (kill-emacs nil))))))
 
+    (when initial-buffer-choice
+      (cond ((eq initial-buffer-choice t)
+            (switch-to-buffer (get-buffer-create "*scratch*")))
+           ((stringp initial-buffer-choice)
+            (find-file initial-buffer-choice))))
+
+    ;; 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 (or inhibit-startup-screen
     (if (or inhibit-startup-screen
+           initial-buffer-choice
            noninteractive
            emacs-quick-startup)
 
            noninteractive
            emacs-quick-startup)
 
@@ -2165,14 +2238,6 @@ A fancy display is used on graphic displays, normal otherwise."
       ;; (with-no-warnings
       ;;       (setq menubar-bindings-done t))
 
       ;; (with-no-warnings
       ;;       (setq menubar-bindings-done t))
 
-      ;; 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 (> file-count 0)
          (display-startup-screen t)
        (display-startup-screen nil)))))
       (if (> file-count 0)
          (display-startup-screen t)
        (display-startup-screen nil)))))