;;; 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
;; 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:
(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)
(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."
("--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)
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.")
(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
(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)
(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)
(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)
(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.
")
"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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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/"))
'("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 "
"\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)))
`: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/"))
'("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
(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)))
;; 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
(funcall it)
it))
'face current-face
- 'help-echo fancy-splash-help-echo))))
+ 'help-echo (startup-echo-area-message)))))
(setq args (cdr args)))))
(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
(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."))
(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 ()
(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))
(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))
(> 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)
(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
(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")
(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 \
(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.
(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))))
((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
;; (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)))))
HCoop / bpt / emacs.git / blobdiff