X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ecb21060d5c1752d41d7a742be565c59b5fcb855..5e634ec9b742cc1dedcc552b36a9f3804b5c88b9:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index 947fc0da57..c82a627e20 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: @@ -36,13 +35,6 @@ (defvar command-line-processed nil "Non-nil once command line has been processed.") -(defvar window-system initial-window-system - "Name of window system the selected frame is displaying through. -The value is a symbol--for instance, `x' for X windows. -The value is nil if the selected frame is on a text-only-terminal.") - -(make-variable-frame-local 'window-system) - (defgroup initialization nil "Emacs start-up procedure." :group 'environment) @@ -62,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." @@ -180,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) @@ -199,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.") @@ -398,10 +396,12 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (if command-line-processed (message "Back to top level.") (setq command-line-processed t) - ;; Give *Messages* the same default-directory as *scratch*, - ;; just to keep things predictable. (let ((dir default-directory)) (with-current-buffer "*Messages*" + ;; Make it easy to do like "tail -f". + (set (make-local-variable 'window-point-insertion-type) t) + ;; Give *Messages* the same default-directory as *scratch*, + ;; just to keep things predictable. (setq default-directory dir))) ;; `user-full-name' is now known; reset its standard-value here. (put 'user-full-name 'standard-value @@ -629,8 +629,13 @@ opening the first frame (e.g. open a connection to an X server).") (push argi rest))))) (nreverse rest))) +(declare-function x-get-resource "frame.c" + (attribute class &optional component subclass)) +(declare-function tool-bar-mode "tool-bar" (&optional arg)) + (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) @@ -845,6 +850,8 @@ opening the first frame (e.g. open a connection to an X server).") (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) @@ -875,6 +882,10 @@ opening the first frame (e.g. open a connection to an X server).") ;; Run the site-start library if it exists. The point of this file is ;; that it is run before .emacs. There is no point in doing this after ;; .emacs; that is useless. + ;; Note that user-init-file is nil at this point. Code that might + ;; be loaded from site-run-file and wants to test if -q was given + ;; should check init-file-user instead, since that is already set. + ;; See cus-edit.el for an example. (if site-run-file (load site-run-file t t)) @@ -989,8 +1000,7 @@ opening the first frame (e.g. open a connection to an X server).") (setq init-file-had-error nil)) (error (let ((message-log-max nil)) - (save-excursion - (set-buffer (get-buffer-create "*Messages*")) + (with-current-buffer (get-buffer-create "*Messages*") (insert "\n\n" (format "An error has occurred while loading `%s':\n\n" user-init-file) @@ -1014,11 +1024,9 @@ opening the first frame (e.g. open a connection to an X server).") (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)) @@ -1096,6 +1104,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. @@ -1149,9 +1158,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) @@ -1162,7 +1169,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/")) @@ -1174,7 +1181,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 " @@ -1208,7 +1215,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))) @@ -1221,7 +1228,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/")) @@ -1233,17 +1240,18 @@ 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 @@ -1258,11 +1266,11 @@ 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 " - :face (variable-pitch :slant oblique) + :face (variable-pitch (:slant oblique)) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch :link ("Copying Conditions" (lambda (button) (describe-copying))) @@ -1325,8 +1333,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 @@ -1360,9 +1366,10 @@ 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))))) +(declare-function image-size "image.c" (spec &optional pixels frame)) (defun fancy-splash-head () "Insert the head part of the splash screen into the current buffer." @@ -1418,11 +1425,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 @@ -1438,26 +1445,27 @@ 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.")) (when concise (fancy-splash-insert - :face 'variable-pitch "\n\n" - :link '("Dismiss" (lambda (button) - (when startup-screen-inhibit-startup-screen - (customize-set-variable 'inhibit-startup-screen t) - (customize-mark-to-save 'inhibit-startup-screen) - (custom-save-all)) - (let ((w (get-buffer-window "*GNU Emacs*"))) - (and w (not (one-window-p)) (delete-window w))) - (kill-buffer "*GNU Emacs*"))) + :face 'variable-pitch "\n" + :link '("Dismiss this startup screen" + (lambda (button) + (when startup-screen-inhibit-startup-screen + (customize-set-variable 'inhibit-startup-screen t) + (customize-mark-to-save 'inhibit-startup-screen) + (custom-save-all)) + (let ((w (get-buffer-window "*GNU Emacs*"))) + (and w (not (one-window-p)) (delete-window w))) + (kill-buffer "*GNU Emacs*"))) " ") (when (or user-init-file custom-file) (let ((checked (create-image "\300\300\141\143\067\076\034\030" @@ -1477,8 +1485,8 @@ 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) - " Don't show this message again."))))) + (fancy-splash-insert :face '(variable-pitch (:height 0.9)) + " Never show it again."))))) (defun exit-splash-screen () "Stop displaying the splash screen buffer." @@ -1489,34 +1497,41 @@ a face or button specification." "Display fancy startup screen. If CONCISE is non-nil, display a concise version of the splash screen in another window." - (with-current-buffer (get-buffer-create "*GNU Emacs*") - (let ((inhibit-read-only t)) - (erase-buffer) - (make-local-variable 'startup-screen-inhibit-startup-screen) - (if pure-space-overflow - (insert pure-space-overflow-message)) - (unless concise - (fancy-splash-head)) - (dolist (text fancy-startup-text) - (apply #'fancy-splash-insert text) - (insert "\n")) - (skip-chars-backward "\n") - (delete-region (point) (point-max)) - (insert "\n") - (fancy-startup-tail concise)) - (use-local-map splash-screen-keymap) - (setq tab-width 22) - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (if (and view-read-only (not view-mode)) - (view-mode-enter nil 'kill-buffer)) - (goto-char (point-min))) - (if (or (window-minibuffer-p) - (window-dedicated-p (selected-window))) - (pop-to-buffer (current-buffer))) - (if concise - (display-buffer (get-buffer "*GNU Emacs*")) - (switch-to-buffer "*GNU Emacs*"))) + (let ((splash-buffer (get-buffer-create "*GNU Emacs*"))) + (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)) + (unless concise + (fancy-splash-head)) + (dolist (text fancy-startup-text) + (apply #'fancy-splash-insert text) + (insert "\n")) + (skip-chars-backward "\n") + (delete-region (point) (point-max)) + (insert "\n") + (fancy-startup-tail concise)) + (use-local-map splash-screen-keymap) + (setq tab-width 22 + buffer-read-only t) + (set-buffer-modified-p nil) + (if (and view-read-only (not view-mode)) + (view-mode-enter nil 'kill-buffer)) + (goto-char (point-min)) + (forward-line (if concise 2 4))) + (if concise + (progn + (display-buffer splash-buffer) + ;; If the splash screen is in a split window, fit it. + (let ((window (get-buffer-window splash-buffer t))) + (or (null window) + (eq window (selected-window)) + (eq window (next-window window)) + (fit-window-to-buffer window)))) + (switch-to-buffer splash-buffer)))) (defun fancy-about-screen () "Display fancy About screen." @@ -1535,8 +1550,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)) @@ -1544,7 +1557,8 @@ splash screen in another window." (setq tab-width 22) (message "%s" (startup-echo-area-message)) (setq buffer-read-only t) - (goto-char (point-min))))) + (goto-char (point-min)) + (forward-line 3)))) (defun fancy-splash-frame () "Return the frame to use for the fancy splash screen. @@ -1578,14 +1592,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,15 +1660,17 @@ 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 ;; so give help in terms of menu items. (insert "\ -You can do basic editing with the menu bar and scroll bar using the mouse. +To follow a link, click Mouse-1 on it, or move to it and type RET. To quit a partially entered command, type Control-g.\n") (insert "\nImportant Help menu items:\n") @@ -1858,7 +1877,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 +1902,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 +1952,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 +2090,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)))) @@ -2149,9 +2168,11 @@ A fancy display is used on graphic displays, normal otherwise." (expand-file-name (command-line-normalize-file-name orig-argi) dir))) - (if (= file-count 1) - (setq first-file-buffer (find-file file)) - (find-file-other-window file))) + (cond ((= file-count 1) + (setq first-file-buffer (find-file file))) + (inhibit-startup-screen + (find-file-other-window file)) + (t (find-file file)))) (or (zerop line) (goto-line line)) (setq line 0) @@ -2170,6 +2191,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 @@ -2208,20 +2237,12 @@ A fancy display is used on graphic displays, normal otherwise." ;; Don't let the hook be run twice. (setq window-setup-hook nil)) - ;; Do this now to avoid an annoying delay if the user - ;; clicks the menu bar during the sit-for. - (when (display-popup-menus-p) - (precompute-menubar-bindings)) - (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)))) + ;; ;; Do this now to avoid an annoying delay if the user + ;; ;; clicks the menu bar during the sit-for. + ;; (when (display-popup-menus-p) + ;; (precompute-menubar-bindings)) + ;; (with-no-warnings + ;; (setq menubar-bindings-done t)) (if (> file-count 0) (display-startup-screen t)