;;; startup.el --- process Emacs shell arguments
-;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Maintainer: FSF
("-reverse-video" 0 x-handle-switch reverse t)
("-fn" 1 x-handle-switch font)
("-font" 1 x-handle-switch font)
+ ("-fs" 0 x-handle-initial-switch fullscreen fullboth)
+ ("-fw" 0 x-handle-initial-switch fullscreen fullwidth)
+ ("-fh" 0 x-handle-initial-switch fullscreen fullheight)
("-ib" 1 x-handle-numeric-switch internal-border-width)
("-g" 1 x-handle-geometry)
("-lsp" 1 x-handle-numeric-switch line-spacing)
("--title" 1 x-handle-switch title)
("--reverse-video" 0 x-handle-switch reverse t)
("--font" 1 x-handle-switch font)
+ ("--fullscreen" 0 x-handle-initial-switch fullscreen fullboth)
+ ("--fullwidth" 0 x-handle-initial-switch fullscreen fullwidth)
+ ("--fullheight" 0 x-handle-initial-switch fullscreen fullheight)
("--internal-border" 1 x-handle-numeric-switch internal-border-width)
("--geometry" 1 x-handle-geometry)
("--foreground-color" 1 x-handle-switch foreground-color)
("--cursor-color" 1 x-handle-switch cursor-color)
("--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-width))
+ ("--border-color" 1 x-handle-switch border-width)
+ ("--smid" 1 x-handle-smid))
"Alist of X Windows options.
Each element has the form
(NAME NUMARGS HANDLER FRAME-PARAM VALUE)
(or (null bg)
(member bg '(unspecified "unspecified-bg")))))
(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 frame-background-mode 'light)))
;; Command-line options supported by tty's:
(defconst tty-long-option-alist
- '(("--name" . "-name")
- ("--title" . "-T")
- ("--reverse-video" . "-reverse")
+ '(("--name" . "-name")
+ ("--title" . "-T")
+ ("--reverse-video" . "-reverse")
("--foreground-color" . "-fg")
- ("--background-color" . "-bg")))
+ ("--background-color" . "-bg")
+ ("--color" . "-color")))
(defconst tool-bar-images-pixel-height 24
"Height in pixels of images in the tool bar.")
(setq default-frame-alist
(cons '(reverse . t)
default-frame-alist)))
+ ((string= this "-color")
+ (if (null argval)
+ (setq argval 8)) ; default --color means 8 ANSI colors
+ (setq default-frame-alist
+ (cons (cons 'tty-color-mode
+ (cond
+ ((numberp argval) argval)
+ ((string-match "-?[0-9]+" argval)
+ (string-to-number argval))
+ (t (intern argval))))
+ default-frame-alist)))
(t (setq rest (cons this rest))))))
(nreverse rest)))
(setq small-temporary-file-directory
(if (eq system-type 'ms-dos)
(getenv "TMPDIR")))
+ (setq auto-save-file-name-transforms
+ (list (list "\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
+ ;; Don't put "\\2" inside expand-file-name, since
+ ;; it will be transformed to "/2" on DOS/Windows.
+ (concat temporary-file-directory "\\2"))))
;; See if we should import version-control from the environment variable.
(let ((vc (getenv "VERSION_CONTROL")))
((memq system-type '(ms-dos windows-nt emx))
(setq eol-mnemonic-unix "(Unix)")
(setq eol-mnemonic-mac "(Mac)"))
- ;; Mac-specific settings should come here, once there's a
- ;; system-type symbol specific to MacOS.
+ ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the
+ ;; abbreviated strings `/' and `:' set in coding.c for them.
+ ((eq system-type 'macos)
+ (setq eol-mnemonic-dos "(DOS)"))
(t ; this is for Unix/GNU/Linux systems
(setq eol-mnemonic-dos "(DOS)")
(setq eol-mnemonic-mac "(Mac)")))
(set-locale-environment nil)
+ ;; Convert the arguments to Emacs internal representation.
+ (let ((args (cdr command-line-args)))
+ (while args
+ (setcar args
+ (decode-coding-string (car args) locale-coding-system t))
+ (setq args (cdr args))))
+
(let ((done nil)
(args (cdr command-line-args)))
;; Register default TTY colors for the case the terminal hasn't a
;; terminal init file.
(or (memq window-system '(x w32))
- (not (tty-display-color-p))
- (let* ((colors (cond ((eq window-system 'pc)
- msdos-color-values)
- ((eq system-type 'windows-nt)
- w32-tty-standard-colors)
- (t tty-standard-colors)))
- (color (car colors)))
- (while colors
- (tty-color-define (car color) (cadr color) (cddr color))
- (setq colors (cdr colors) color (car colors)))
- ;; Modifying color mappings means realized faces don't
- ;; use the right colors, so clear them.
- (clear-face-cache)))
+ ;; 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))
;; Record whether the tool-bar is present before the user and site
;; init files are processed. frame-notice-user-settings uses this
(command-line-1 (cdr command-line-args))
;; If -batch, terminate after processing the command options.
- (if noninteractive (kill-emacs t)))
+ (if noninteractive (kill-emacs t))
+
+ ;; Run emacs-session-restore (session management) if started by
+ ;; the session manager and we have a session manager connection.
+ (if (and (boundp 'x-session-previous-id) (stringp x-session-previous-id))
+ (emacs-session-restore x-session-previous-id)))
(defcustom initial-scratch-message (purecopy "\
;; This buffer is for notes you don't want to save, and for Lisp evaluation.
")
"Initial message displayed in *scratch* buffer at startup.
If this is nil, no message will be displayed."
- :type 'string)
+ :type '(choice (text :tag "Message")
+ (const :tag "none" nil))
+ :group 'initialization)
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar fancy-current-text nil)
(defvar fancy-splash-help-echo nil)
(defvar fancy-splash-stop-time nil)
-
+(defvar fancy-splash-outer-buffer nil)
(defun fancy-splash-insert (&rest args)
"Insert text into the current buffer, with faces.
(fancy-splash-insert
:face '(variable-pitch :foreground "red")
"GNU Emacs is one component of the GNU operating system."))
- (insert "\n"))
+ (insert "\n")
+ (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*")
+ (fancy-splash-insert :face 'variable-pitch
+ (substitute-command-keys
+ "Type \\[recenter] to begin editing your file.\n"))))
(defun fancy-splash-tail ()
(emacs-version)
"\n"
:face '(variable-pitch :height 0.5)
- "Copyright (C) 2001 Free Software Foundation, Inc.")
+ "Copyright (C) 2002 Free Software Foundation, Inc.")
(and auto-save-list-file-prefix
;; Don't signal an error if the
;; directory for auto-save-list files
(defun fancy-splash-screens ()
"Display fancy splash screens when Emacs starts."
(setq fancy-splash-help-echo (startup-echo-area-message))
- (switch-to-buffer "GNU Emacs")
- (setq tab-width 20)
(let ((old-hourglass display-hourglass)
- (splash-buffer (current-buffer))
+ (fancy-splash-outer-buffer (current-buffer))
+ splash-buffer
(old-minor-mode-map-alist minor-mode-map-alist)
timer)
+ (switch-to-buffer "GNU Emacs")
+ (setq tab-width 20)
+ (setq splash-buffer (current-buffer))
(catch 'stop-splashing
(unwind-protect
(let ((map (make-sparse-keymap)))
"splash.xpm" "splash.pbm"))))
(image-height (and img (cdr (image-size img))))
(window-height (1- (window-height (selected-window)))))
- (> window-height (+ image-height 15)))))
+ (> window-height (+ image-height 19)))))
+
+
+(defun normal-splash-screen ()
+ "Display splash screen when Emacs starts."
+ (with-current-buffer (get-buffer-create "GNU Emacs")
+ (let ((tab-width 8)
+ (mode-line-format (propertize "---- %b %-"
+ 'face '(:weight bold))))
+
+ ;; The convention for this piece of code is that
+ ;; each piece of output starts with one or two newlines
+ ;; and does not end with any newlines.
+ (insert "Welcome to GNU Emacs")
+ (if (eq system-type 'gnu/linux)
+ (insert ", one component of a Linux-based GNU system."))
+ (insert "\n")
+
+ (unless (equal (buffer-name (current-buffer)) "*scratch*")
+ (insert (substitute-command-keys
+ "\nType \\[recenter] to begin editing your file.\n")))
+
+ (if (display-mouse-p)
+ ;; The user can use the mouse to activate menus
+ ;; so give help in terms of menu items.
+ (progn
+ (insert "\
+You can do basic editing with the menu bar and scroll bar using the mouse.
+Useful File menu items:
+Exit Emacs (or type Control-x followed by Control-c)
+Recover Session recover files you were editing before a crash
+
+Important Help menu items:
+Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently.
+Emacs FAQ Frequently asked questions and answers
+\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
+Copying Conditions Conditions for redistributing and changing Emacs.
+Getting New Versions How to obtain the latest version of Emacs.
+Ordering Manuals How to order manuals from the FSF.
+")
+ (insert "\n\n" (emacs-version)
+ "
+Copyright (C) 2002 Free Software Foundation, Inc."))
+
+ ;; No mouse menus, so give help using kbd commands.
+
+ ;; If keys have their default meanings,
+ ;; 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-ht") 'help-with-tutorial)
+ (eq (key-binding "\C-hi") 'info)
+ (eq (key-binding "\C-h\C-n") 'view-emacs-news))
+ (insert "
+Get help C-h (Hold down CTRL and press h)
+Undo changes C-x u Exit Emacs C-x C-c
+Get a tutorial C-h t Use Info to read docs C-h i
+Ordering manuals C-h RET")
+ (insert (substitute-command-keys
+ (format "\n
+Get help %s
+Undo changes \\[advertised-undo]
+Exit Emacs \\[save-buffers-kill-emacs]
+Get a tutorial \\[help-with-tutorial]
+Use Info to read docs \\[info]
+Ordering manuals \\[view-order-manuals]"
+ (let ((where (where-is-internal
+ 'help-command nil t)))
+ (if where
+ (key-description where)
+ "M-x help"))))))
+
+ ;; Say how to use the menu bar with the keyboard.
+ (if (and (eq (key-binding "\M-`") 'tmm-menubar)
+ (eq (key-binding [f10]) 'tmm-menubar))
+ (insert "
+Activate menubar F10 or ESC ` or M-`")
+ (insert (substitute-command-keys "
+Activate menubar \\[tmm-menubar]")))
+
+ ;; Many users seem to have problems with these.
+ (insert "
+\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
+If you have no Meta key, you may instead type ESC followed by the character.)")
+
+ (insert "\n\n" (emacs-version)
+ "
+Copyright (C) 2002 Free Software Foundation, Inc.")
+
+ (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
+ (eq (key-binding "\C-h\C-d") 'describe-distribution)
+ (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
+ (insert
+ "\n
+GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
+Emacs is Free Software--Free as in Freedom--so you can redistribute copies
+of Emacs and modify it; type C-h C-c to see the conditions.
+Type C-h C-d for information on getting the latest version.")
+ (insert (substitute-command-keys
+ "\n
+GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
+Emacs is Free Software--Free as in Freedom--so you can redistribute copies
+of Emacs and modify it; type \\[describe-copying] to see the conditions.
+Type \\[describe-distribution] for information on getting the latest version."))))
+
+ ;; The rest of the startup screen is the same on all
+ ;; kinds of terminals.
+
+ ;; Give information on recovering, if there was a crash.
+ (and auto-save-list-file-prefix
+ ;; Don't signal an error if the
+ ;; directory for auto-save-list files
+ ;; does not yet exist.
+ (file-directory-p (file-name-directory
+ auto-save-list-file-prefix))
+ (directory-files
+ (file-name-directory auto-save-list-file-prefix)
+ nil
+ (concat "\\`"
+ (regexp-quote (file-name-nondirectory
+ auto-save-list-file-prefix)))
+ t)
+ (insert "\n\nIf an Emacs session crashed recently, "
+ "type M-x recover-session RET\nto recover"
+ " the files you were editing."))
+
+ ;; Display the input that we set up in the buffer.
+ (set-buffer-modified-p nil)
+ (goto-char (point-min))
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (sit-for 120))))
+ (kill-buffer "GNU Emacs"))
(defun startup-echo-area-message ()
(if (eq (key-binding "\C-h\C-p") 'describe-project)
(message (startup-echo-area-message))))
+(defun display-splash-screen ()
+ "Display splash screen according to display.
+Fancy splash screens are used on graphic displays,
+normal otherwise."
+ (interactive)
+ (if (and (display-graphic-p)
+ (use-fancy-splash-screens-p))
+ (fancy-splash-screens)
+ (normal-splash-screen)))
+
+
(defun command-line-1 (command-line-args-left)
(or noninteractive (input-pending-p) init-file-had-error
;; t if the init file says to inhibit the echo area startup message.
;; show user what they all are. But leave the last one current.
(and (> file-count 2)
(not noninteractive)
- (not inhibit-startup-buffer-menu)
+ (not inhibit-startup-buffer-menu)
(or (get-buffer-window first-file-buffer)
- (list-buffers))))
-
- ;; No command args: maybe display a startup screen.
- (when (and (not inhibit-startup-message) (not noninteractive)
- ;; Don't display startup screen if init file
- ;; has selected another buffer.
- (string= (buffer-name) "*scratch*")
- ;; Don't display startup screen if init file
- ;; has started some sort of server.
- (process-list)
- ;; Don't display startup screen if init file
- ;; has inserted some text in *scratch*.
- (= 0 (buffer-size)))
- ;; Display a startup screen, after some preparations.
-
- ;; If there are no switches to process, we might as well
- ;; run this hook now, and there may be some need to do it
- ;; before doing any output.
- (and term-setup-hook
- (run-hooks 'term-setup-hook))
+ (list-buffers)))))
+
+ ;; Maybe display a startup screen.
+ (when (and (not inhibit-startup-message) (not noninteractive)
+ ;; Don't display startup screen if init file
+ ;; has started some sort of server.
+ (not (and (fboundp 'process-list)
+ (process-list))))
+ ;; Display a startup screen, after some preparations.
+
+ ;; If there are no switches to process, we might as well
+ ;; run this hook now, and there may be some need to do it
+ ;; before doing any output.
+ (and term-setup-hook
+ (run-hooks 'term-setup-hook))
+ ;; Don't let the hook be run twice.
+ (setq term-setup-hook nil)
+
+ ;; It's important to notice the user settings before we
+ ;; display the startup message; otherwise, the settings
+ ;; won't take effect until the user gives the first
+ ;; keystroke, and that's distracting.
+ (when (fboundp 'frame-notice-user-settings)
+ (frame-notice-user-settings))
+
+ ;; If there are no switches to process, we might as well
+ ;; run this hook now, and there may be some need to do it
+ ;; before doing any output.
+ (when window-setup-hook
+ (run-hooks 'window-setup-hook)
;; Don't let the hook be run twice.
- (setq term-setup-hook nil)
-
- ;; It's important to notice the user settings before we
- ;; display the startup message; otherwise, the settings
- ;; won't take effect until the user gives the first
- ;; keystroke, and that's distracting.
- (when (fboundp 'frame-notice-user-settings)
- (frame-notice-user-settings))
-
- ;; If there are no switches to process, we might as well
- ;; run this hook now, and there may be some need to do it
- ;; before doing any output.
- (when window-setup-hook
- (run-hooks 'window-setup-hook)
- ;; 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))
- (setq menubar-bindings-done t)
-
- (when initial-scratch-message
- (insert initial-scratch-message))
- (set-buffer-modified-p nil)
-
- ;; If user typed input during all that work,
- ;; abort the startup screen. Otherwise, display it now.
- (when (not (input-pending-p))
- (with-current-buffer (get-buffer-create "GNU Emacs")
- (if (and (display-graphic-p)
- (use-fancy-splash-screens-p))
- (fancy-splash-screens)
- (let ((tab-width 8)
- (mode-line-format (propertize "---- %b %-"
- 'face '(:weight bold))))
-
- ;; The convention for this piece of code is that
- ;; each piece of output starts with one or two newlines
- ;; and does not end with any newlines.
- (insert "Welcome to GNU Emacs")
- (if (eq system-type 'gnu/linux)
- (insert ", one component of a Linux-based GNU system."))
- (insert "\n")
-
- (if (display-mouse-p)
- ;; The user can use the mouse to activate menus
- ;; so give help in terms of menu items.
- (progn
- (insert "\
-You can do basic editing with the menu bar and scroll bar using the mouse.
-
-Useful File menu items:
-Exit Emacs (or type Control-x followed by Control-c)
-Recover Session recover files you were editing before a crash
-
-Important Help menu items:
-Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently.
-Emacs FAQ Frequently asked questions and answers
-\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
-Copying Conditions Conditions for redistributing and changing Emacs.
-Getting New Versions How to obtain the latest version of Emacs.
-Ordering Manuals How to order manuals from the FSF.
-")
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 2001 Free Software Foundation, Inc."))
-
- ;; No mouse menus, so give help using kbd commands.
-
- ;; If keys have their default meanings,
- ;; 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-ht") 'help-with-tutorial)
- (eq (key-binding "\C-hi") 'info)
- (eq (key-binding "\C-h\C-n") 'view-emacs-news))
- (insert "
-Get help C-h (Hold down CTRL and press h)
-Undo changes C-x u Exit Emacs C-x C-c
-Get a tutorial C-h t Use Info to read docs C-h i
-Ordering manuals C-h RET")
- (insert (substitute-command-keys
- (format "\n
-Get help %s
-Undo changes \\[advertised-undo]
-Exit Emacs \\[save-buffers-kill-emacs]
-Get a tutorial \\[help-with-tutorial]
-Use Info to read docs \\[info]
-Ordering manuals \\[view-order-manuals]"
- (let ((where (where-is-internal
- 'help-command nil t)))
- (if where
- (key-description where)
- "M-x help"))))))
-
- ;; Say how to use the menu bar with the keyboard.
- (if (and (eq (key-binding "\M-`") 'tmm-menubar)
- (eq (key-binding [f10]) 'tmm-menubar))
- (insert "
-Activate menubar F10 or ESC ` or M-`")
- (insert (substitute-command-keys "
-Activate menubar \\[tmm-menubar]")))
+ (setq window-setup-hook nil))
- ;; Many users seem to have problems with these.
- (insert "
-\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
-If you have no Meta key, you may instead type ESC followed by the character.)")
+ ;; 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))
+ (setq menubar-bindings-done t)
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 2001 Free Software Foundation, Inc.")
-
- (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
- (eq (key-binding "\C-h\C-d") 'describe-distribution)
- (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
- (insert
- "\n
-GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
-Emacs is Free Software--Free as in Freedom--so you can redistribute copies
-of Emacs and modify it; type C-h C-c to see the conditions.
-Type C-h C-d for information on getting the latest version.")
- (insert (substitute-command-keys
- "\n
-GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
-Emacs is Free Software--Free as in Freedom--so you can redistribute copies
-of Emacs and modify it; type \\[describe-copying] to see the conditions.
-Type \\[describe-distribution] for information on getting the latest version."))))
+ ;; If *scratch* is selected and it is empty, insert an
+ ;; initial message saying not to create a file there.
+ (when (and initial-scratch-message
+ (string= (buffer-name) "*scratch*")
+ (= 0 (buffer-size)))
+ (insert initial-scratch-message)
+ (set-buffer-modified-p nil))
- ;; The rest of the startup screen is the same on all
- ;; kinds of terminals.
-
- ;; Give information on recovering, if there was a crash.
- (and auto-save-list-file-prefix
- ;; Don't signal an error if the
- ;; directory for auto-save-list files
- ;; does not yet exist.
- (file-directory-p (file-name-directory
- auto-save-list-file-prefix))
- (directory-files
- (file-name-directory auto-save-list-file-prefix)
- nil
- (concat "\\`"
- (regexp-quote (file-name-nondirectory
- auto-save-list-file-prefix)))
- t)
- (insert "\n\nIf an Emacs session crashed recently, "
- "type M-x recover-session RET\nto recover"
- " the files you were editing."))
-
- ;; Display the input that we set up in the buffer.
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (save-window-excursion
- (switch-to-buffer (current-buffer))
- (sit-for 120)))))
- (kill-buffer "GNU Emacs")))))
+ ;; If user typed input during all that work,
+ ;; abort the startup screen. Otherwise, display it now.
+ (unless (input-pending-p)
+ (display-splash-screen))))
(defun command-line-normalize-file-name (file)