;;; 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:
(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)
and VALUE is the value which is given to that frame parameter
\(most options use the argument for this, so VALUE is not present).")
+(defconst command-line-ns-option-alist
+ '(("-NSAutoLaunch" 1 ns-ignore-1-arg)
+ ("-NXAutoLaunch" 1 ns-ignore-1-arg)
+ ("-macosx" 0 ns-ignore-0-arg)
+ ("-NSHost" 1 ns-ignore-1-arg)
+ ("-_NSMachLaunch" 1 ns-ignore-1-arg)
+ ("-MachLaunch" 1 ns-ignore-1-arg)
+ ("-NXOpen" 1 ns-ignore-1-arg)
+ ("-NSOpen" 1 ns-handle-nxopen)
+ ("-NXOpenTemp" 1 ns-ignore-1-arg)
+ ("-NSOpenTemp" 1 ns-handle-nxopentemp)
+ ("-GSFilePath" 1 ns-handle-nxopen)
+ ;;("-bw" . x-handle-numeric-switch)
+ ;;("-d" . x-handle-display)
+ ;;("-display" . x-handle-display)
+ ("-name" 1 ns-handle-name-switch)
+ ("-title" 1 ns-handle-switch title)
+ ("-T" 1 ns-handle-switch title)
+ ("-r" 0 ns-handle-switch reverse t)
+ ("-rv" 0 ns-handle-switch reverse t)
+ ("-reverse" 0 ns-handle-switch reverse t)
+ ("-fn" 1 ns-handle-switch font)
+ ("-font" 1 ns-handle-switch font)
+ ("-ib" 1 ns-handle-numeric-switch internal-border-width)
+ ;;("-g" . x-handle-geometry)
+ ;;("-geometry" . x-handle-geometry)
+ ("-fg" 1 ns-handle-switch foreground-color)
+ ("-foreground" 1 ns-handle-switch foreground-color)
+ ("-bg" 1 ns-handle-switch background-color)
+ ("-background" 1 ns-handle-switch background-color)
+; ("-ms" 1 ns-handle-switch mouse-color)
+ ("-itype" 0 ns-handle-switch icon-type t)
+ ("-i" 0 ns-handle-switch icon-type t)
+ ("-iconic" 0 ns-handle-iconic icon-type t)
+ ;;("-xrm" . x-handle-xrm-switch)
+ ("-cr" 1 ns-handle-switch cursor-color)
+ ("-vb" 0 ns-handle-switch vertical-scroll-bars t)
+ ("-hb" 0 ns-handle-switch horizontal-scroll-bars t)
+ ("-bd" 1 ns-handle-switch)
+ ;; ("--border-width" 1 ns-handle-numeric-switch border-width)
+ ;; ("--display" 1 ns-handle-display)
+ ("--name" 1 ns-handle-name-switch)
+ ("--title" 1 ns-handle-switch title)
+ ("--reverse-video" 0 ns-handle-switch reverse t)
+ ("--font" 1 ns-handle-switch font)
+ ("--internal-border" 1 ns-handle-numeric-switch internal-border-width)
+ ;; ("--geometry" 1 ns-handle-geometry)
+ ("--foreground-color" 1 ns-handle-switch foreground-color)
+ ("--background-color" 1 ns-handle-switch background-color)
+ ("--mouse-color" 1 ns-handle-switch mouse-color)
+ ("--icon-type" 0 ns-handle-switch icon-type t)
+ ("--iconic" 0 ns-handle-iconic)
+ ;; ("--xrm" 1 ns-handle-xrm-switch)
+ ("--cursor-color" 1 ns-handle-switch cursor-color)
+ ("--vertical-scroll-bars" 0 ns-handle-switch vertical-scroll-bars t)
+ ("--border-color" 1 ns-handle-switch border-width))
+ "Alist of NS options.
+Each element has the form
+ (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
+where NAME is the option name string, NUMARGS is the number of arguments
+that the option accepts, HANDLER is a function to call to handle the option.
+FRAME-PARAM (optional) is the frame parameter this option specifies,
+and VALUE is the value which is given to that frame parameter
+\(most options use the argument for this, so VALUE is not present).")
+
+
(defvar before-init-hook nil
"Normal hook run after handling urgent options but before loading init files.")
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
(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)
;; only because all other settings of no-blinking-cursor are here.
(unless (or noninteractive
emacs-basic-display
- (and (memq window-system '(x w32 mac))
+ (and (memq window-system '(x w32 mac ns))
(not (member (x-get-resource "cursorBlink" "CursorBlink")
'("off" "false")))))
(setq no-blinking-cursor t))
(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.8))
(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)))))
+(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."
(let* ((image-file (cond ((stringp fancy-splash-image)
fancy-splash-image)
- ((and (display-color-p)
- (image-type-available-p 'xpm))
- (if (and (fboundp 'x-display-planes)
- (= (funcall 'x-display-planes) 8))
- "splash8.xpm"
- "splash.xpm"))
- (t "splash.pbm")))
+ ((display-color-p)
+ (cond ((image-type-available-p 'svg)
+ "splash.svg")
+ ((image-type-available-p 'png)
+ "splash.png")
+ ((image-type-available-p 'xpm)
+ (if (and (fboundp 'x-display-planes)
+ (= (funcall 'x-display-planes) 8))
+ "splash8.xpm"
+ "splash.xpm"))))
+ (t "splash.pbm")))
(img (create-image image-file))
(image-width (and img (car (image-size img))))
(window-width (window-width (selected-window))))
(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.8))
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.
(if (string-match "^--" (car tem))
(push (list (car tem)) longopts)))
+ ;; Add the long NS options to longopts.
+ (setq tem command-line-ns-option-alist)
+ (while tem
+ (if (string-match "^--" (car (car tem)))
+ (setq longopts (cons (list (car (car tem))) longopts)))
+ (setq tem (cdr tem)))
+
;; Loop, processing options.
(while command-line-args-left
(let* ((argi (car command-line-args-left))
(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))))
(setq command-line-args-left
(nthcdr (nth 1 tem) command-line-args-left)))
+ ((setq tem (assoc argi command-line-ns-option-alist))
+ ;; Ignore NS-windows options and their args if not using NS.
+ (setq command-line-args-left
+ (nthcdr (nth 1 tem) command-line-args-left)))
+
((member argi '("-find-file" "-file" "-visit"))
(setq inhibit-startup-screen t)
;; An explicit option to specify visiting a file.
((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