X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/079fa3cb265e8ace1934981b744b3127e89bcce6..f67b40b3d890918f1e856a5052f86c3c724f0658:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index ad09ff2e83..eb8898551e 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,17 +1,18 @@ ;;; 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. -;; 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 -;; 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 @@ -19,9 +20,7 @@ ;; 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 . ;;; Commentary: @@ -40,9 +39,21 @@ "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. -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." @@ -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.") +(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 @@ -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) - ("--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) @@ -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.") +(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.") @@ -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 - "~/_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, @@ -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") +(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 @@ -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. - (not (and window-system + (not (and initial-window-system (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)) + ;; 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) - ;; 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) @@ -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) - (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 () @@ -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 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) @@ -581,7 +628,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (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) @@ -618,16 +666,22 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (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 - (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) @@ -643,13 +697,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (cdr error) ", ")))) 'external-debugging-output) (terpri 'external-debugging-output) - (setq window-system nil) + (setq initial-window-system nil) (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. @@ -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 - (and (memq window-system '(x w32)) + (and (memq initial-window-system '(x w32)) (<= (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) - (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) @@ -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 '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 - ;; 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 @@ -965,11 +1019,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (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)) @@ -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. - (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). @@ -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))) + (setq after-init-time (current-time)) (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 - 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. @@ -1123,9 +1153,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ") "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) @@ -1136,7 +1164,7 @@ regardless of the value of this variable." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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/")) @@ -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" (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 " @@ -1163,7 +1191,7 @@ regardless of the value of this variable." 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)))))) @@ -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 " - :face (variable-pitch :slant oblique) + :face (variable-pitch (:slant oblique)) "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 (variable-pitch :foreground "red") + '((:face (variable-pitch (:foreground "red")) "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" (lambda (button) (describe-project)) + '("GNU" (lambda (button) (describe-gnu-project)) "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" - :face (variable-pitch :height 0.5) + :face (variable-pitch (:height 0.5)) (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 " - :face (variable-pitch :slant oblique) + :face (variable-pitch (:slant oblique)) "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 - (expand-file-name tut data-directory) + (expand-file-name tut tutorial-directory) 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. -(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 @@ -1323,7 +1361,7 @@ a face or button specification." (funcall it) it)) 'face current-face - 'help-echo fancy-splash-help-echo)))) + 'help-echo (startup-echo-area-message))))) (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")) - (fancy-splash-insert :face `(variable-pitch :foreground ,fg) + (fancy-splash-insert :face `(variable-pitch (:foreground ,fg)) "\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 @@ -1401,12 +1439,12 @@ a face or button specification." (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" - :face '(variable-pitch :foreground "red") + :face '(variable-pitch (:foreground "red")) "\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))))) - (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 () @@ -1457,6 +1495,7 @@ splash screen in another window." (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)) @@ -1505,8 +1544,6 @@ splash screen in another window." (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)) @@ -1549,14 +1586,17 @@ we put it on this frame." (> 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 -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 default-directory command-line-default-directory) (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)) - (switch-to-buffer "*About GNU Emacs*") (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 @@ -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) - (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) @@ -1726,7 +1768,7 @@ Get help\t %s '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") @@ -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-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" - '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") @@ -1838,7 +1896,7 @@ Type \\[describe-distribution] for information on ")) (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 \ @@ -1888,7 +1946,7 @@ screen." (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. @@ -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 - ;; 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)))) @@ -2097,7 +2155,7 @@ A fancy display is used on graphic displays, normal otherwise." (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 @@ -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)))))) + (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 + initial-buffer-choice 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)) - ;; 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)))))