X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/02cbe062bee38a6705bafb1699d77e3c44cfafcf..f67b40b3d890918f1e856a5052f86c3c724f0658:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index e67c98803c..eb8898551e 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -9,10 +9,10 @@ ;; 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 @@ -20,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: @@ -56,7 +54,6 @@ directory using `find-file'. If t, open the `*scratch*' buffer." (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." @@ -174,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) @@ -193,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.") @@ -624,7 +628,8 @@ opening the first frame (e.g. open a connection to an X server).") (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) @@ -838,6 +843,9 @@ opening the first frame (e.g. open a connection to an X server).") (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) @@ -1091,6 +1099,7 @@ opening the first frame (e.g. open a connection to an X server).") (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. @@ -1144,9 +1153,7 @@ opening the first frame (e.g. open a connection to an X server).") ") "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) @@ -1169,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 " @@ -1228,7 +1235,7 @@ 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 () @@ -1254,7 +1261,7 @@ Each element in the list should be a list of strings or pairs (goto-char (point-min)))) "\tHow to contribute improvements to Emacs\n" "\n" - :link ("GNU and Freedom" (lambda (button) (describe-project))) + :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 " @@ -1488,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)) @@ -1578,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) @@ -1643,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 @@ -1858,7 +1871,7 @@ Type \\[describe-distribution] for information on ")) (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") @@ -1883,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 \ @@ -1933,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. @@ -2071,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)))) @@ -2172,6 +2185,14 @@ A fancy display is used on graphic displays, normal otherwise." ((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 @@ -2217,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)))))