;;; 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
;; -no-site-file Do not load "site-start.el". (This is the ONLY
;; --no-site-file way to prevent loading that file.)
;; -------------------------
+;; -no-splash Don't display a splash screen on startup.
+;; --no-splash
+;; -------------------------
;; -u USER Load USER's init file instead of the init
;; -user USER file belonging to the user starting Emacs.
;; --user USER
(setq top-level '(normal-top-level))
(defvar command-line-processed nil
- "Non-nil once command line has been processed")
+ "Non-nil once command line has been processed.")
(defgroup initialization nil
"Emacs start-up procedure"
:type 'boolean
:group 'initialization)
+(defvaralias 'inhibit-splash-screen 'inhibit-startup-message)
+
(defcustom inhibit-startup-echo-area-message nil
"*Non-nil inhibits the initial startup echo area message.
Setting this variable takes effect
("-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)
:type '(choice (const nil) string)
:group 'mail)
-(defcustom user-mail-address nil
+(defcustom user-mail-address (if command-line-processed
+ (concat (user-login-name) "@"
+ (or mail-host-address
+ (system-name)))
+ ;; Empty string means "not set yet".
+ "")
"*Full mailing address of this user.
This is initialized based on `mail-host-address',
after your init file is read, in case it sets `mail-host-address'."
;; This loop does a breadth-first tree walk on DIR's subtree,
;; putting each subdir into DIRS as its contents are examined.
(while pending
- (setq dirs (cons (car pending) dirs))
- (setq pending (cdr pending))
+ (push (pop pending) dirs)
(let* ((this-dir (car dirs))
(contents (directory-files this-dir))
(default-directory this-dir)
(setq attrs (or canonicalized
(nthcdr 10 (file-attributes this-dir))))
(unless (member attrs normal-top-level-add-subdirs-inode-list)
- (setq normal-top-level-add-subdirs-inode-list
- (cons attrs normal-top-level-add-subdirs-inode-list))
- (while contents
+ (push attrs normal-top-level-add-subdirs-inode-list)
+ (dolist (file contents)
;; The lower-case variants of RCS and CVS are for DOS/Windows.
- (unless (member (car contents) '("." ".." "RCS" "CVS" "rcs" "cvs"))
- (when (and (string-match "\\`[[:alnum:]]" (car contents))
+ (unless (member file '("." ".." "RCS" "CVS" "rcs" "cvs"))
+ (when (and (string-match "\\`[[:alnum:]]" file)
;; Avoid doing a `stat' when it isn't necessary
;; because that can cause trouble when an NFS server
;; is down.
- (not (string-match "\\.elc?\\'" (car contents)))
- (file-directory-p (car contents)))
- (let ((expanded (expand-file-name (car contents))))
+ (not (string-match "\\.elc?\\'" file))
+ (file-directory-p file))
+ (let ((expanded (expand-file-name file)))
(unless (file-exists-p (expand-file-name ".nosearch"
expanded))
- (setq pending (nconc pending (list expanded)))))))
- (setq contents (cdr contents))))))
+ (setq pending (nconc pending (list expanded)))))))))))
(normal-top-level-add-to-load-path (cdr (nreverse dirs)))))
;; This function is called from a subdirs.el file.
(save-excursion
(set-buffer (get-buffer "*Messages*"))
(setq default-directory dir)))
+ ;; `user-full-name' is now known; reset its standard-value here.
+ (put 'user-full-name 'standard-value
+ (list (default-value 'user-full-name)))
;; For root, preserve owner and group when editing files.
(if (equal (user-uid) 0)
(setq backup-by-copying-when-mismatch t))
(let ((tail load-path)
new)
(while tail
- (setq new (cons (car tail) new))
+ (push (car tail) new)
(condition-case nil
(let ((default-directory (car tail)))
(load (expand-file-name "subdirs.el" (car tail)) t t t)))
(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") t)))
;; 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)))
(while (and (not done) args)
(let ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
("--debug-init") ("--iconic") ("--icon-type")))
- (argi (car args))
+ (argi (pop args))
(argval nil))
;; Handle --OPTION=VALUE format.
- (if (and (string-match "\\`--" argi)
- (string-match "=" argi))
- (setq argval (substring argi (match-end 0))
- argi (substring argi 0 (match-beginning 0))))
- (or (equal argi "--")
- (let ((completion (try-completion argi longopts)))
- (if (eq completion t)
- (setq argi (substring argi 1))
- (if (stringp completion)
- (let ((elt (assoc completion longopts)))
- (or elt
- (error "Option `%s' is ambiguous" argi))
- (setq argi (substring (car elt) 1)))
- (setq argval nil)))))
+ (when (and (string-match "\\`--" argi)
+ (string-match "=" argi))
+ (setq argval (substring argi (match-end 0))
+ argi (substring argi 0 (match-beginning 0))))
+ (unless (equal argi "--")
+ (let ((completion (try-completion argi longopts)))
+ (if (eq completion t)
+ (setq argi (substring argi 1))
+ (if (stringp completion)
+ (let ((elt (assoc completion longopts)))
+ (or elt
+ (error "Option `%s' is ambiguous" argi))
+ (setq argi (substring (car elt) 1)))
+ (setq argval nil)))))
(cond
- ((or (string-equal argi "-q")
- (string-equal argi "-no-init-file"))
- (setq init-file-user nil
- args (cdr args)))
- ((or (string-equal argi "-u")
- (string-equal argi "-user"))
+ ((member argi '("-q" "-no-init-file"))
+ (setq init-file-user nil))
+ ((member argi '("-u" "-user"))
(or argval
- (setq args (cdr args)
- argval (car args)))
+ (setq argval (pop args)))
(setq init-file-user argval
- argval nil
- args (cdr args)))
+ argval nil))
((string-equal argi "-no-site-file")
- (setq site-run-file nil
- args (cdr args)))
+ (setq site-run-file nil))
((string-equal argi "-debug-init")
- (setq init-file-debug t
- args (cdr args)))
+ (setq init-file-debug t))
((string-equal argi "-iconic")
- (setq initial-frame-alist
- (cons '(visibility . icon) initial-frame-alist))
- (setq args (cdr args)))
+ (push '(visibility . icon) initial-frame-alist))
((or (string-equal argi "-icon-type")
(string-equal argi "-i")
(string-equal argi "-itype"))
- (setq default-frame-alist
- (cons '(icon-type . t) default-frame-alist))
- (setq args (cdr args)))
- (t (setq done t)))
+ (push '(icon-type . t) default-frame-alist))
+ ;; Push the popped arg back on the list of arguments.
+ (t (push argi args) (setq done t)))
;; Was argval set but not used?
(and argval
(error "Option `%s' doesn't allow an argument" argi))))
;; If frame was created with a menu bar, set menu-bar-mode on.
(if (and (not noninteractive)
(or (not (memq window-system '(x w32)))
- (> (cdr (assq 'menu-bar-lines (frame-parameters))) 0)))
+ (> (frame-parameter nil 'menu-bar-lines) 0)))
(menu-bar-mode t))
;; If frame was created with a tool bar, switch tool-bar-mode on.
;; 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
(lambda ()
(if init-file-user
(let ((user-init-file-1
- (cond
+ (cond
((eq system-type 'ms-dos)
(concat "~" init-file-user "/_emacs"))
((eq system-type 'windows-nt)
"~/_emacs"))
((eq system-type 'vax-vms)
"sys$login:.emacs")
- (t
+ (t
(concat "~" init-file-user "/.emacs")))))
;; This tells `load' to store the file name found
;; into user-init-file.
(setq user-init-file t)
(load user-init-file-1 t t)
- ;; If we did not find the user's init file,
- ;; set user-init-file conclusively to nil;
- ;; don't let it be set from default.el.
- (if (eq user-init-file t)
- (setq user-init-file nil))
+ (when (eq user-init-file t)
+ ;; If we did not find ~/.emacs, try
+ ;; ~/.emacs.d/.emacs.
+ (let ((otherfile
+ (expand-file-name
+ (file-name-nondirectory user-init-file-1)
+ (file-name-as-directory
+ (expand-file-name
+ ".emacs.d"
+ (file-name-directory user-init-file-1))))))
+ (load otherfile t t)
+
+ ;; If we did not find the user's init file,
+ ;; set user-init-file conclusively.
+ ;; Don't let it be set from default.el.
+ (when (eq user-init-file t)
+ (setq user-init-file user-init-file-1))))
;; If we loaded a compiled file, set
;; `user-init-file' to the source version if that
(sit-for 1))
(setq user-init-file source))))
+ (when (and (stringp custom-file)
+ (not (assoc custom-file load-history)))
+ ;; If the .emacs file has set `custom-file' but hasn't
+ ;; loaded the file yet, let's load it.
+ (load custom-file t t))
+
(or inhibit-default-init
(let ((inhibit-startup-message nil))
;; Users are supposed to be told their rights.
(mapconcat 'prin1-to-string (cdr error) ", "))
(pop-to-buffer "*Messages*")
(setq init-file-had-error t)))))
+
+ ;; If the user has a file of abbrevs, read it.
+ (if (file-exists-p abbrev-file-name)
+ (quietly-read-abbrev-file abbrev-file-name))
+
+ ;; If the abbrevs came entirely from the init file or the
+ ;; abbrevs file, they do not need saving.
+ (setq abbrevs-changed nil)
+
;; If we can tell that the init file altered debug-on-error,
;; arrange to preserve the value that it set up.
(or (eq debug-on-error debug-on-error-initial)
(set-language-environment current-language-environment)))
;; Do this here in case the init file sets mail-host-address.
- (or user-mail-address
+ (if (equal user-mail-address "")
(setq user-mail-address (concat (user-login-name) "@"
(or mail-host-address
(system-name)))))
;; If *scratch* exists and init file didn't change its mode, initialize it.
(if (get-buffer "*scratch*")
- (save-excursion
- (set-buffer "*scratch*")
+ (with-current-buffer "*scratch*"
(if (eq major-mode 'fundamental-mode)
(funcall initial-major-mode))))
(setq term (substring term 0 hyphend))
(setq term nil)))))
+ ;; Update the out-of-memory error message based on user's key bindings
+ ;; for save-some-buffers.
+ (setq memory-signal-data
+ (list 'error
+ (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs")))
+
;; Process the remaining args.
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
:face variable-pitch "\
Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently
Emacs FAQ\tFrequently asked questions and answers
+Read the Emacs Manual\tView the Emacs manual using Info
\(Non)Warranty\tGNU Emacs comes with "
:face (variable-pitch :slant oblique)
"ABSOLUTELY NO WARRANTY\n"
:face variable-pitch
"\
Copying Conditions\tConditions for redistributing and changing Emacs
-Ordering Manuals\tHow to order Emacs manuals from the Free Software Foundation\n")
+More Manuals / Ordering Manuals Buying printed manuals from the FSF\n")
(:face variable-pitch
"You can do basic editing with the menu bar and scroll bar \
using the mouse.\n\n"
+
"
))
"A list of texts to show in the middle part of splash screens.
(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.
(insert-image img (propertize "xxx" 'help-echo help-echo
'keymap map)))
(insert "\n"))))
- (if (eq system-type 'gnu/linux)
- (fancy-splash-insert
- :face '(variable-pitch :foreground "red")
- "GNU Emacs is one component of a Linux-based GNU system.")
- (fancy-splash-insert
- :face '(variable-pitch :foreground "red")
+ (fancy-splash-insert
+ :face '(variable-pitch :foreground "red")
+ (if (eq system-type 'gnu/linux)
+ "GNU Emacs is one component of the GNU/Linux operating system."
"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)
+ (frame (fancy-splash-frame))
timer)
- (catch 'stop-splashing
- (unwind-protect
- (let ((map (make-sparse-keymap)))
- (use-local-map map)
- (define-key map [t] 'fancy-splash-default-action)
- (define-key map [mouse-movement] 'ignore)
- (define-key map [mode-line t] 'ignore)
- (setq cursor-type nil
- display-hourglass nil
- minor-mode-map-alist nil
- buffer-undo-list t
- mode-line-format (propertize "---- %b %-"
- 'face '(:weight bold))
- fancy-splash-stop-time (+ (float-time)
- (max 60 fancy-splash-max-time))
- timer (run-with-timer 0 fancy-splash-delay
- #'fancy-splash-screens-1
- splash-buffer))
- (recursive-edit))
+ (save-selected-window
+ (select-frame frame)
+ (switch-to-buffer "GNU Emacs")
+ (setq tab-width 20)
+ (setq splash-buffer (current-buffer))
+ (catch 'stop-splashing
+ (unwind-protect
+ (let ((map (make-sparse-keymap)))
+ (use-local-map map)
+ (define-key map [switch-frame] 'ignore)
+ (define-key map [t] 'fancy-splash-default-action)
+ (define-key map [mouse-movement] 'ignore)
+ (define-key map [mode-line t] 'ignore)
+ (setq cursor-type nil
+ display-hourglass nil
+ minor-mode-map-alist nil
+ buffer-undo-list t
+ mode-line-format (propertize "---- %b %-"
+ 'face '(:weight bold))
+ fancy-splash-stop-time (+ (float-time)
+ (max 60 fancy-splash-max-time))
+ timer (run-with-timer 0 fancy-splash-delay
+ #'fancy-splash-screens-1
+ splash-buffer))
+ (recursive-edit))
(cancel-timer timer)
(setq display-hourglass old-hourglass
minor-mode-map-alist old-minor-mode-map-alist)
- (kill-buffer splash-buffer)))))
-
+ (kill-buffer splash-buffer))))))
+
+(defun fancy-splash-frame ()
+ "Return the frame to use for the fancy splash screen.
+Returning non-nil does not mean we should necessarily
+use the fancy splash screen, but if we do use it,
+we put it on this frame."
+ (let (chosen-frame)
+ (dolist (frame (append (frame-list) (list (selected-frame))))
+ (if (and (frame-visible-p frame)
+ (not (window-minibuffer-p (frame-selected-window frame))))
+ (setq chosen-frame frame)))
+ chosen-frame))
(defun use-fancy-splash-screens-p ()
"Return t if fancy splash screens should be used."
(when (or (and (display-color-p)
(image-type-available-p 'xpm))
(image-type-available-p 'pbm))
- (let* ((img (create-image (or fancy-splash-image
- (if (and (display-color-p)
- (image-type-available-p 'xpm))
- "splash.xpm" "splash.pbm"))))
- (image-height (and img (cdr (image-size img))))
- (window-height (1- (window-height (selected-window)))))
- (> window-height (+ image-height 15)))))
+ (let ((frame (fancy-splash-frame)))
+ (when frame
+ (let* ((img (create-image (or fancy-splash-image
+ (if (and (display-color-p)
+ (image-type-available-p 'xpm))
+ "splash.xpm" "splash.pbm"))))
+ (image-height (and img (cdr (image-size img))))
+ (window-height (1- (window-height (frame-selected-window frame)))))
+ (> window-height (+ image-height 19)))))))
+
+
+(defun normal-splash-screen ()
+ "Display splash screen when Emacs starts."
+ (let ((prev-buffer (current-buffer)))
+ (unwind-protect
+ (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")
+ (insert
+ (if (eq system-type 'gnu/linux)
+ ", one component of the GNU/Linux operating system.\n"
+ ", a part of the GNU operating system.\n"))
+
+ (unless (equal (buffer-name prev-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
+Read the Emacs Manual View the Emacs manual using Info
+\(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.
+More Manuals / Ordering Manuals How to order printed 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-hr") 'info-emacs-manual)
+ (eq (key-binding "\C-h\C-n") 'view-emacs-news))
+ (insert "
+Get help C-h (Hold down CTRL and press h)
+Emacs manual C-h r
+Emacs tutorial C-h t Undo changes C-x u
+Buy manuals C-h C-m Exit Emacs C-x C-c
+Browse manuals C-h i")
+
+ (insert (substitute-command-keys
+ (format "\n
+Get help %s
+Emacs manual \\[info-emacs-manual]
+Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
+Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs]
+Browse manuals \\[info]"
+ (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))))
+ ;; Unwind ... ensure splash buffer is killed
+ (kill-buffer "GNU Emacs"))))
(defun startup-echo-area-message ()
(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.
;; and long versions of what's on command-switch-alist.
(longopts
(append '(("--funcall") ("--load") ("--insert") ("--kill")
- ("--directory") ("--eval") ("--execute")
+ ("--directory") ("--eval") ("--execute") ("--no-splash")
("--find-file") ("--visit") ("--file"))
(mapcar (lambda (elt)
(list (concat "-" (car elt))))
(column 0))
;; Add the long X options to longopts.
- (setq tem command-line-x-option-alist)
- (while tem
- (if (string-match "^--" (car (car tem)))
- (setq longopts (cons (list (car (car tem))) longopts)))
- (setq tem (cdr tem)))
+ (dolist (tem command-line-x-option-alist)
+ (if (string-match "^--" (car tem))
+ (push (list (car tem)) longopts)))
;; Loop, processing options.
(while (and command-line-args-left)
(funcall (cdr tem) argi))
(funcall (cdr tem) argi)))
- ((or (string-equal argi "-f") ;what the manual claims
- (string-equal argi "-funcall")
- (string-equal argi "-e")) ; what the source used to say
+ ((string-equal argi "-no-splash")
+ (setq inhibit-startup-message t))
+
+ ((member argi '("-f" ;what the manual claims
+ "-funcall"
+ "-e")) ; what the source used to say
(if argval
(setq tem (intern argval))
(setq tem (intern (car command-line-args-left)))
(command-execute tem)
(funcall tem)))
- ((or (string-equal argi "-eval")
- (string-equal argi "-execute"))
+ ((member argi '("-eval" "-execute"))
(if argval
(setq tem argval)
(setq tem (car command-line-args-left))
(eval (read tem)))
;; Set the default directory as specified in -L.
- ((or (string-equal argi "-L")
- (string-equal argi "-directory"))
+ ((member argi '("-L" "-directory"))
(if argval
(setq tem argval)
(setq tem (car command-line-args-left)
(setq load-path (append (nreverse extra-load-path)
initial-load-path)))
- ((or (string-equal argi "-l")
- (string-equal argi "-load"))
+ ((member argi '("-l" "-load"))
(if argval
(setq tem argval)
(setq tem (car command-line-args-left)
(setq command-line-args-left
(nthcdr (nth 1 tem) command-line-args-left)))
- ((or (string-equal argi "-find-file")
- (string-equal argi "-file")
- (string-equal argi "-visit"))
+ ((member argi '("-find-file" "-file" "-visit"))
;; An explicit option to specify visiting a file.
(if argval
(setq tem argval)
;; 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 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-temp-buffer
- (if (and (display-graphic-p)
- (use-fancy-splash-screens-p))
- (fancy-splash-screens)
- (let ((tab-width 8))
- ;; 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]")))
-
- ;; 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.)")
+ (setq window-setup-hook nil))
- (insert "\n\n" (emacs-version)
- "
-Copyright (C) 2001 Free Software Foundation, Inc.")
+ ;; 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)
- (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)))))))))
+ ;; 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)
HCoop / bpt / emacs.git / blobdiff