-;;; startup.el --- process Emacs shell arguments
+;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
-;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992, 1994-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
(defcustom initial-buffer-choice nil
"Buffer to show after starting Emacs.
If the value is nil and `inhibit-startup-screen' is nil, show the
-startup screen. If the value is string, visit the specified file or
-directory using `find-file'. If t, open the `*scratch*' buffer."
+startup screen. If the value is string, visit the specified file
+or directory using `find-file'. If t, open the `*scratch*'
+buffer."
:type '(choice
(const :tag "Startup screen" nil)
(directory :tag "Directory" :value "~/")
"List of command-line args not yet processed.")
(defvaralias 'argv 'command-line-args-left
+ ;; FIXME: Bad name for a dynamically bound variable.
"List of command-line args not yet processed.
This is a convenience alias, so that one can write \(pop argv\)
inside of --eval command line arguments in order to access
following arguments.")
+(with-no-warnings
+ ;; FIXME: Bad name for a dynamically bound variable
+ (defvar argi nil
+ "Current command-line argument."))
+
(defvar command-line-functions nil ;; lrs 7/31/89
"List of functions to process unrecognized command-line arguments.
Each function should access the dynamically bound variables
;;("-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)
+ ("-name" 1 x-handle-name-switch)
+ ("-title" 1 x-handle-switch title)
+ ("-T" 1 x-handle-switch title)
+ ("-r" 0 x-handle-switch reverse t)
+ ("-rv" 0 x-handle-switch reverse t)
+ ("-reverse" 0 x-handle-switch reverse t)
+ ("-fn" 1 x-handle-switch font)
+ ("-font" 1 x-handle-switch font)
+ ("-ib" 1 x-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)
+ ("-fg" 1 x-handle-switch foreground-color)
+ ("-foreground" 1 x-handle-switch foreground-color)
+ ("-bg" 1 x-handle-switch background-color)
+ ("-background" 1 x-handle-switch background-color)
+; ("-ms" 1 x-handle-switch mouse-color)
+ ("-itype" 0 x-handle-switch icon-type t)
+ ("-i" 0 x-handle-switch icon-type t)
+ ("-iconic" 0 x-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)
+ ("-cr" 1 x-handle-switch cursor-color)
+ ("-vb" 0 x-handle-switch vertical-scroll-bars t)
+ ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
+ ("-bd" 1 x-handle-switch)
+ ;; ("--border-width" 1 x-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)
+ ("--name" 1 x-handle-name-switch)
+ ("--title" 1 x-handle-switch title)
+ ("--reverse-video" 0 x-handle-switch reverse t)
+ ("--font" 1 x-handle-switch font)
+ ("--internal-border" 1 x-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)
+ ("--foreground-color" 1 x-handle-switch foreground-color)
+ ("--background-color" 1 x-handle-switch background-color)
+ ("--mouse-color" 1 x-handle-switch mouse-color)
+ ("--icon-type" 0 x-handle-switch icon-type t)
+ ("--iconic" 0 x-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))
+ ("--cursor-color" 1 x-handle-switch cursor-color)
+ ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
+ ("--border-color" 1 x-handle-switch border-width))
"Alist of NS options.
Each element has the form
(NAME NUMARGS HANDLER FRAME-PARAM VALUE)
:type '(choice (const :tag "none" nil) string)
:group 'initialization
:initialize 'custom-initialize-default
- :set (lambda (variable value)
+ :set (lambda (_variable _value)
(error "Customizing `site-run-file' does not work")))
(defcustom mail-host-address nil
:type 'directory
:initialize 'custom-initialize-delay)
+(defconst package-subdirectory-regexp
+ "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)"
+ "Regular expression matching the name of a package subdirectory.
+The first subexpression is the package name.
+The second subexpression is the version string.
+
+The regexp should not contain a starting \"\\`\" or a trailing
+ \"\\'\"; those are added automatically by callers.")
+
(defun normal-top-level-add-subdirs-to-load-path ()
- "Add all subdirectories of current directory to `load-path'.
+ "Add all subdirectories of `default-directory' to `load-path'.
More precisely, this uses only the subdirectories whose names
start with letters or digits; it excludes any subdirectory named `RCS'
or `CVS', and any subdirectory that contains a file named `.nosearch'."
(default-directory this-dir)
(canonicalized (if (fboundp 'untranslated-canonical-name)
(untranslated-canonical-name this-dir))))
- ;; The Windows version doesn't report meaningful inode
- ;; numbers, so use the canonicalized absolute file name of the
- ;; directory instead.
+ ;; The Windows version doesn't report meaningful inode numbers, so
+ ;; use the canonicalized absolute file name of the directory instead.
(setq attrs (or canonicalized
(nthcdr 10 (file-attributes this-dir))))
(unless (member attrs normal-top-level-add-subdirs-inode-list)
(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 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?\\'" 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)))))))))))
+ (and (string-match "\\`[[:alnum:]]" file)
+ ;; The lower-case variants of RCS and CVS are for DOS/Windows.
+ (not (member file '("RCS" "CVS" "rcs" "cvs")))
+ ;; Avoid doing a `stat' when it isn't necessary because
+ ;; that can cause trouble when an NFS server is down.
+ (not (string-match "\\.elc?\\'" file))
+ (file-directory-p file)
+ (let ((expanded (expand-file-name file)))
+ (or (file-exists-p (expand-file-name ".nosearch" expanded))
+ (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.
-;; It assumes that default-directory is the directory
-;; in which the subdirs.el file exists,
-;; and it adds to load-path the subdirs of that directory
-;; as specified in DIRS. Normally the elements of DIRS are relative.
(defun normal-top-level-add-to-load-path (dirs)
+ "This function is called from a subdirs.el file.
+It assumes that `default-directory' is the directory in which the
+subdirs.el file exists, and it adds to `load-path' the subdirs of
+that directory as specified in DIRS. Normally the elements of
+DIRS are relative."
(let ((tail load-path)
(thisdir (directory-file-name default-directory)))
(while (and tail
;; `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))
;; Look in each dir in load-path for a subdirs.el file.
;; If we find one, load it, which will add the appropriate subdirs
;; of that dir into load-path,
and initialize the window system environment to prepare for
opening the first frame (e.g. open a connection to an X server).")
-;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc.
(defun tty-handle-args (args)
+ "Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc."
(let (rest)
(message "%S" args)
(while (and args
argi (match-string 1 argi)))
(when (string-match "\\`--." orig-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
- argi orig-argi)))))
+ (cond ((eq completion t)
+ (setq argi (substring argi 1)))
+ ((stringp completion)
+ (let ((elt (assoc completion longopts)))
+ (unless elt
+ (error "Option `%s' is ambiguous" argi))
+ (setq argi (substring (car elt) 1))))
+ (t
+ (setq argval nil
+ argi orig-argi)))))
(cond
;; The --display arg is handled partly in C, partly in Lisp.
;; When it shows up here, we just put it back to be handled
(run-hooks 'before-init-hook)
- ;; Under X Window, this creates the X frame and deletes the terminal frame.
+ ;; Under X, this creates the X frame and deletes the terminal frame.
(unless (daemonp)
+
+ ;; If X resources are available, use them to initialize the values
+ ;; of `tool-bar-mode' and `menu-bar-mode', as well as the value of
+ ;; `no-blinking-cursor' and the `cursor' face.
+ (cond
+ ((or noninteractive emacs-basic-display)
+ (setq menu-bar-mode nil
+ tool-bar-mode nil
+ no-blinking-cursor t))
+ ((memq initial-window-system '(x w32 ns))
+ (let ((no-vals '("no" "off" "false" "0")))
+ (if (member (x-get-resource "menuBar" "MenuBar") no-vals)
+ (setq menu-bar-mode nil))
+ (if (member (x-get-resource "toolBar" "ToolBar") no-vals)
+ (setq tool-bar-mode nil))
+ (if (member (x-get-resource "cursorBlink" "CursorBlink")
+ no-vals)
+ (setq no-blinking-cursor t)))
+ ;; If the cursorColor X resource exists, alter the `cursor' face
+ ;; spec, but mark it as changed outside of Customize.
+ (let ((color (x-get-resource "cursorColor" "Foreground")))
+ (when color
+ (put 'cursor 'theme-face
+ `((changed ((t :background ,color)))))
+ (put 'cursor 'face-modified t)))))
(frame-initialize))
+ (when (fboundp 'x-create-frame)
+ ;; Set up the tool-bar (even in tty frames, since Emacs might open a
+ ;; graphical frame later).
+ (unless noninteractive
+ (tool-bar-setup)))
+
;; Turn off blinking cursor if so specified in X resources. This is here
;; only because all other settings of no-blinking-cursor are here.
(unless (or noninteractive
emacs-basic-display
(and (memq window-system '(x w32 ns))
(not (member (x-get-resource "cursorBlink" "CursorBlink")
- '("off" "false")))))
+ '("no" "off" "false" "0")))))
(setq no-blinking-cursor t))
- ;; If frame was created with a menu bar, set menu-bar-mode on.
- (unless (or noninteractive
- emacs-basic-display
- (and (memq initial-window-system '(x w32))
- (<= (frame-parameter nil 'menu-bar-lines) 0)))
- (menu-bar-mode 1))
-
- (unless (or noninteractive (not (fboundp 'tool-bar-mode)))
- ;; Set up the tool-bar. Do this even in tty frames, so that there
- ;; is a tool-bar if Emacs later opens a graphical frame.
- (if (or emacs-basic-display
- (and (numberp (frame-parameter nil 'tool-bar-lines))
- (<= (frame-parameter nil 'tool-bar-lines) 0)))
- ;; On a graphical display with the toolbar disabled via X
- ;; resources, set up the toolbar without enabling it.
- (tool-bar-setup)
- ;; Otherwise, enable tool-bar-mode.
- (tool-bar-mode 1)))
-
;; Re-evaluate predefined variables whose initial value depends on
;; the runtime context.
(mapc 'custom-reevaluate-setting
(normal-erase-is-backspace-setup-frame)
;; Register default TTY colors for the case the terminal hasn't a
- ;; terminal init file. We do this regardles of whether the terminal
+ ;; terminal init file. We do this regardless of whether the terminal
;; supports colors or not and regardless the current display type,
;; since users can connect to color-capable terminals and also
;; switch color support on or off in mid-session by setting the
(if init-file-user
(let ((user-init-file-1
(cond
- ((eq system-type 'ms-dos)
- (concat "~" init-file-user "/_emacs"))
- ((eq system-type 'windows-nt)
- ;; Prefer .emacs on Windows.
- (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
- "~/.emacs"
- ;; Also support _emacs for compatibility.
- (if (directory-files "~" nil "^_emacs\\(\\.elc?\\)?$")
- "~/_emacs"
- ;; But default to .emacs if _emacs does not exist.
- "~/.emacs")))
- (t
- (concat "~" init-file-user "/.emacs")))))
+ ((eq system-type 'ms-dos)
+ (concat "~" init-file-user "/_emacs"))
+ ((not (eq system-type 'windows-nt))
+ (concat "~" init-file-user "/.emacs"))
+ ;; Else deal with the Windows situation
+ ((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
+ ;; Prefer .emacs on Windows.
+ "~/.emacs")
+ ((directory-files "~" nil "^_emacs\\(\\.elc?\\)?$")
+ ;; Also support _emacs for compatibility, but warn about it.
+ (push '(initialization
+ "`_emacs' init file is deprecated, please use `.emacs'")
+ delayed-warnings-list)
+ "~/_emacs")
+ (t ;; But default to .emacs if _emacs does not exist.
+ "~/.emacs"))))
;; This tells `load' to store the file name found
;; into user-init-file.
(setq user-init-file t)
user-init-file
(get (car error) 'error-message)
(if (cdr error) ": " "")
- (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", "))
+ (mapconcat (lambda (s) (prin1-to-string s t))
+ (cdr error) ", "))
:warning)
(setq init-file-had-error t))))
(eq orig-enable-multibyte (default-value
'enable-multibyte-characters)))
;; Init file changed to unibyte. Reset existing multibyte
- ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*).
+ ;; buffers (probably *scratch*, *Messages*, *Minibuf-0*).
;; Arguably this should only be done if they're free of
;; multibyte characters.
(mapc (lambda (buffer)
(eq face-ignored-fonts old-face-ignored-fonts))
(clear-face-cache)))
+ ;; If any package directory exists, initialize the package system.
+ (and user-init-file
+ package-enable-at-startup
+ (catch 'package-dir-found
+ (let (dirs)
+ (if (boundp 'package-directory-list)
+ (setq dirs package-directory-list)
+ (dolist (f load-path)
+ (and (stringp f)
+ (equal (file-name-nondirectory f) "site-lisp")
+ (push (expand-file-name "elpa" f) dirs))))
+ (push (if (boundp 'package-user-dir)
+ package-user-dir
+ (locate-user-emacs-file "elpa"))
+ dirs)
+ (dolist (dir dirs)
+ (when (file-directory-p dir)
+ (dolist (subdir (directory-files dir))
+ (when (and (file-directory-p (expand-file-name subdir dir))
+ (string-match
+ (concat "\\`" package-subdirectory-regexp "\\'")
+ subdir))
+ (throw 'package-dir-found t)))))))
+ (package-initialize))
+
(setq after-init-time (current-time))
(run-hooks 'after-init-hook)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst fancy-startup-text
- '((:face (variable-pitch (:foreground "red"))
+ `((:face (variable-pitch font-lock-comment-face)
"Welcome to "
:link ("GNU Emacs"
- (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
+ ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
"Browse http://www.gnu.org/software/emacs/")
", one component of the "
:link
- (lambda ()
+ ,(lambda ()
(if (eq system-type 'gnu/linux)
- '("GNU/Linux"
- (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
+ `("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-gnu-project))
+ `("GNU" ,(lambda (_button) (describe-gnu-project))
"Display info on the GNU project")))
" operating system.\n\n"
:face variable-pitch
- :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
+ :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
"\tLearn basic keystroke commands"
- (lambda ()
+ ,(lambda ()
(let* ((en "TUTORIAL")
(tut (or (get-language-info current-language-environment
'tutorial)
(concat " (" title ")"))))
"\n"
:link ("Emacs Guided Tour"
- (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
+ ,(lambda (_button)
+ (browse-url "http://www.gnu.org/software/emacs/tour/"))
"Browse http://www.gnu.org/software/emacs/tour/")
"\tOverview of Emacs features at gnu.org\n"
- :link ("View Emacs Manual" (lambda (button) (info-emacs-manual)))
+ :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual)))
"\tView the Emacs manual using Info\n"
- :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
+ :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
"\tGNU Emacs comes with "
:face (variable-pitch (:slant oblique))
"ABSOLUTELY NO WARRANTY\n"
:face variable-pitch
- :link ("Copying Conditions" (lambda (button) (describe-copying)))
+ :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
"\tConditions for redistributing and changing Emacs\n"
- :link ("Ordering Manuals" (lambda (button) (view-order-manuals)))
+ :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
"\tPurchasing printed copies of manuals\n"
"\n"))
"A list of texts to show in the middle part of splash screens.
`:face FACE', like `fancy-splash-insert' accepts them.")
(defconst fancy-about-text
- '((:face (variable-pitch (:foreground "red"))
+ `((:face (variable-pitch font-lock-comment-face)
"This is "
:link ("GNU Emacs"
- (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
+ ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
"Browse http://www.gnu.org/software/emacs/")
", one component of the "
:link
- (lambda ()
+ ,(lambda ()
(if (eq system-type 'gnu/linux)
- '("GNU/Linux"
- (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
+ `("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-gnu-project))
+ `("GNU" ,(lambda (_button) (describe-gnu-project))
"Display info on the GNU project.")))
" operating system.\n"
- :face (lambda ()
- (list 'variable-pitch
- (list :foreground
- (if (eq (frame-parameter nil 'background-mode) 'dark)
- "cyan" "darkblue"))))
+ :face (variable-pitch font-lock-builtin-face)
"\n"
- (lambda () (emacs-version))
+ ,(lambda () (emacs-version))
"\n"
:face (variable-pitch (:height 0.8))
- (lambda () emacs-copyright)
+ ,(lambda () emacs-copyright)
"\n\n"
:face variable-pitch
:link ("Authors"
- (lambda (button)
+ ,(lambda (_button)
(view-file (expand-file-name "AUTHORS" data-directory))
(goto-char (point-min))))
"\tMany people have contributed code included in GNU Emacs\n"
:link ("Contributing"
- (lambda (button)
+ ,(lambda (_button)
(view-file (expand-file-name "CONTRIBUTE" data-directory))
(goto-char (point-min))))
"\tHow to contribute improvements to Emacs\n"
"\n"
- :link ("GNU and Freedom" (lambda (button) (describe-gnu-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)))
+ :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
"\tGNU Emacs comes with "
:face (variable-pitch (:slant oblique))
"ABSOLUTELY NO WARRANTY\n"
:face variable-pitch
- :link ("Copying Conditions" (lambda (button) (describe-copying)))
+ :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
"\tConditions for redistributing and changing Emacs\n"
- :link ("Getting New Versions" (lambda (button) (describe-distribution)))
+ :link ("Getting New Versions" ,(lambda (_button) (describe-distribution)))
"\tHow to obtain the latest version of Emacs\n"
- :link ("Ordering Manuals" (lambda (button) (view-order-manuals)))
+ :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
"\tBuying printed manuals from the FSF\n"
"\n"
- :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
+ :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
"\tLearn basic Emacs keystroke commands"
- (lambda ()
+ ,(lambda ()
(let* ((en "TUTORIAL")
(tut (or (get-language-info current-language-environment
'tutorial)
(concat " (" title ")"))))
"\n"
:link ("Emacs Guided Tour"
- (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
+ ,(lambda (_button)
+ (browse-url "http://www.gnu.org/software/emacs/tour/"))
"Browse http://www.gnu.org/software/emacs/tour/")
- "\tSee an overview of Emacs features at gnu.org"
- ))
+ "\tSee an overview of Emacs features at gnu.org"))
"A list of texts to show in the middle part of the About screen.
Each element in the list should be a list of strings or pairs
`:face FACE', like `fancy-splash-insert' accepts them.")
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(set-keymap-parent map button-buffer-map)
- (define-key map "\C-?" 'scroll-down)
- (define-key map " " 'scroll-up)
+ (define-key map "\C-?" 'scroll-down-command)
+ (define-key map " " 'scroll-up-command)
(define-key map "q" 'exit-splash-screen)
map)
"Keymap for splash screen buffer.")
(make-button (prog1 (point) (insert-image img)) (point)
'face 'default
'help-echo "mouse-2, RET: Browse http://www.gnu.org/"
- 'action (lambda (button) (browse-url "http://www.gnu.org/"))
+ 'action (lambda (_button) (browse-url "http://www.gnu.org/"))
'follow-link t)
(insert "\n\n")))))
(defun fancy-startup-tail (&optional concise)
"Insert the tail part of the splash screen into the current buffer."
- (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
- "cyan" "darkblue")))
- (unless concise
- (fancy-splash-insert
- :face 'variable-pitch
- "\nTo start... "
- :link '("Open a File"
- (lambda (button) (call-interactively 'find-file))
- "Specify a new file's name, to edit the file")
- " "
- :link '("Open Home Directory"
- (lambda (button) (dired "~"))
- "Open your home directory, to operate on its files")
- " "
- :link '("Customize Startup"
- (lambda (button) (customize-group 'initialization))
- "Change initialization settings including this screen")
- "\n"))
+ (unless concise
+ (fancy-splash-insert
+ :face 'variable-pitch
+ "\nTo start... "
+ :link `("Open a File"
+ ,(lambda (_button) (call-interactively 'find-file))
+ "Specify a new file's name, to edit the file")
+ " "
+ :link `("Open Home Directory"
+ ,(lambda (_button) (dired "~"))
+ "Open your home directory, to operate on its files")
+ " "
+ :link `("Customize Startup"
+ ,(lambda (_button) (customize-group 'initialization))
+ "Change initialization settings including this screen")
+ "\n"))
+ (fancy-splash-insert
+ :face 'variable-pitch "To quit a partially entered command, type "
+ :face 'default "Control-g"
+ :face 'variable-pitch ".\n")
+ (fancy-splash-insert :face `(variable-pitch font-lock-builtin-face)
+ "\nThis is "
+ (emacs-version)
+ "\n"
+ :face '(variable-pitch (:height 0.8))
+ emacs-copyright
+ "\n")
+ (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)
+ (fancy-splash-insert :face '(variable-pitch font-lock-comment-face)
+ "\nIf an Emacs session crashed recently, "
+ "type "
+ :face '(fixed-pitch font-lock-comment-face)
+ "Meta-x recover-session RET"
+ :face '(variable-pitch font-lock-comment-face)
+ "\nto recover"
+ " the files you were editing."))
+
+ (when concise
(fancy-splash-insert
- :face 'variable-pitch "To quit a partially entered command, type "
- :face 'default "Control-g"
- :face 'variable-pitch ".\n")
- (fancy-splash-insert :face `(variable-pitch (:foreground ,fg))
- "\nThis is "
- (emacs-version)
- "\n"
- :face '(variable-pitch (:height 0.8))
- emacs-copyright
- "\n")
- (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)
- (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"))
- "\nto recover"
- " the files you were editing."))
-
- (when concise
- (fancy-splash-insert
- :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"
- 'xbm t :width 8 :height 8 :background "grey75"
- :foreground "black" :relief -2 :ascent 'center))
- (unchecked (create-image (make-string 8 0)
- 'xbm t :width 8 :height 8 :background "grey75"
- :foreground "black" :relief -2 :ascent 'center)))
- (insert-button
- " " :on-glyph checked :off-glyph unchecked 'checked nil
- 'display unchecked 'follow-link t
- 'action (lambda (button)
- (if (overlay-get button 'checked)
- (progn (overlay-put button 'checked nil)
- (overlay-put button 'display (overlay-get button :off-glyph))
- (setq startup-screen-inhibit-startup-screen nil))
- (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))
- " Never show it again.")))))
+ :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 "checked.xpm"
+ nil nil :ascent 'center))
+ (unchecked (create-image "unchecked.xpm"
+ nil nil :ascent 'center)))
+ (insert-button
+ " "
+ :on-glyph checked
+ :off-glyph unchecked
+ 'checked nil 'display unchecked 'follow-link t
+ 'action (lambda (button)
+ (if (overlay-get button 'checked)
+ (progn (overlay-put button 'checked nil)
+ (overlay-put button 'display
+ (overlay-get button :off-glyph))
+ (setq startup-screen-inhibit-startup-screen
+ nil))
+ (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))
+ " Never show it again."))))
(defun exit-splash-screen ()
"Stop displaying the splash screen buffer."
(save-selected-window
(select-frame frame)
(switch-to-buffer "*About GNU Emacs*")
- (setq buffer-undo-list t
- mode-line-format
- (concat "----"
- (propertize "%b" 'face 'mode-line-buffer-id)
- "%-"))
+ (setq buffer-undo-list t)
(let ((inhibit-read-only t))
(erase-buffer)
(if pure-space-overflow
(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)
- (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
(if pure-space-overflow
(insert pure-space-overflow-message))
(insert "\nImportant Help menu items:\n")
(insert-button "Emacs Tutorial"
- 'action (lambda (button) (help-with-tutorial))
+ 'action (lambda (_button) (help-with-tutorial))
'follow-link t)
(insert "\t\tLearn basic Emacs keystroke commands\n")
(insert-button "Read the Emacs Manual"
- 'action (lambda (button) (info-emacs-manual))
+ 'action (lambda (_button) (info-emacs-manual))
'follow-link t)
(insert "\tView the Emacs manual using Info\n")
(insert-button "\(Non)Warranty"
- 'action (lambda (button) (describe-no-warranty))
+ 'action (lambda (_button) (describe-no-warranty))
'follow-link t)
(insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
(insert-button "Copying Conditions"
- 'action (lambda (button) (describe-copying))
+ 'action (lambda (_button) (describe-copying))
'follow-link t)
(insert "\tConditions for redistributing and changing Emacs\n")
(insert-button "More Manuals / Ordering Manuals"
- 'action (lambda (button) (view-order-manuals))
+ 'action (lambda (_button) (view-order-manuals))
'follow-link t)
(insert " How to order printed manuals from the FSF\n")
(insert "\nUseful tasks:\n")
(insert-button "Visit New File"
- 'action (lambda (button) (call-interactively 'find-file))
+ 'action (lambda (_button) (call-interactively 'find-file))
'follow-link t)
(insert "\t\tSpecify a new file's name, to edit the file\n")
(insert-button "Open Home Directory"
- 'action (lambda (button) (dired "~"))
+ 'action (lambda (_button) (dired "~"))
'follow-link t)
(insert "\tOpen your home directory, to operate on its files\n")
(insert-button "Customize Startup"
- 'action (lambda (button) (customize-group 'initialization))
+ 'action (lambda (_button) (customize-group 'initialization))
'follow-link t)
(insert "\tChange initialization settings including this screen\n")
(where (key-description where))
(t "M-x help")))))
(insert-button "Emacs manual"
- 'action (lambda (button) (info-emacs-manual))
+ 'action (lambda (_button) (info-emacs-manual))
'follow-link t)
(insert (substitute-command-keys"\t \\[info-emacs-manual]\t"))
(insert-button "Browse manuals"
- 'action (lambda (button) (Info-directory))
+ 'action (lambda (_button) (Info-directory))
'follow-link t)
(insert (substitute-command-keys "\t \\[info]\n"))
(insert-button "Emacs tutorial"
- 'action (lambda (button) (help-with-tutorial))
+ 'action (lambda (_button) (help-with-tutorial))
'follow-link t)
(insert (substitute-command-keys
"\t \\[help-with-tutorial]\tUndo changes\t \\[undo]\n"))
(insert-button "Buy manuals"
- 'action (lambda (button) (view-order-manuals))
+ 'action (lambda (_button) (view-order-manuals))
'follow-link t)
(insert (substitute-command-keys
"\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-terminal]")))
;; Say how to use the menu bar with the keyboard.
(insert "\n")
(insert-button "Activate menubar"
- 'action (lambda (button) (tmm-menubar))
+ 'action (lambda (_button) (tmm-menubar))
'follow-link t)
(if (and (eq (key-binding "\M-`") 'tmm-menubar)
(eq (key-binding [f10]) 'tmm-menubar))
(insert "\nUseful tasks:\n")
(insert-button "Visit New File"
- 'action (lambda (button) (call-interactively 'find-file))
+ 'action (lambda (_button) (call-interactively 'find-file))
'follow-link t)
(insert "\t\t\t")
(insert-button "Open Home Directory"
- 'action (lambda (button) (dired "~"))
+ 'action (lambda (_button) (dired "~"))
'follow-link t)
(insert "\n")
(insert-button "Customize Startup"
- 'action (lambda (button) (customize-group 'initialization))
+ 'action (lambda (_button) (customize-group 'initialization))
'follow-link t)
(insert "\t\t")
(insert-button "Open *scratch* buffer"
- 'action (lambda (button) (switch-to-buffer
- (get-buffer-create "*scratch*")))
+ 'action (lambda (_button) (switch-to-buffer
+ (get-buffer-create "*scratch*")))
'follow-link t)
(insert "\n")
(insert "\n" (emacs-version) "\n" emacs-copyright "\n")
"
GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ")
(insert-button "full details"
- 'action (lambda (button) (describe-no-warranty))
+ 'action (lambda (_button) (describe-no-warranty))
'follow-link t)
(insert ".
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 ")
(insert-button "the conditions"
- 'action (lambda (button) (describe-copying))
+ 'action (lambda (_button) (describe-copying))
'follow-link t)
(insert ".
Type C-h C-d for information on ")
(insert-button "getting the latest version"
- 'action (lambda (button) (describe-distribution))
+ 'action (lambda (_button) (describe-distribution))
'follow-link t)
(insert "."))
(insert (substitute-command-keys
"
GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
(insert-button "full details"
- 'action (lambda (button) (describe-no-warranty))
+ 'action (lambda (_button) (describe-no-warranty))
'follow-link t)
(insert (substitute-command-keys ".
Emacs is Free Software--Free as in Freedom--so you can redistribute copies
of Emacs and modify it; type \\[describe-copying] to see "))
(insert-button "the conditions"
- 'action (lambda (button) (describe-copying))
+ 'action (lambda (_button) (describe-copying))
'follow-link t)
(insert (substitute-command-keys".
Type \\[describe-distribution] for information on "))
(insert-button "getting the latest version"
- 'action (lambda (button) (describe-distribution))
+ 'action (lambda (_button) (describe-distribution))
'follow-link t)
(insert ".")))
(insert-button "Authors"
'action
- (lambda (button)
+ (lambda (_button)
(view-file (expand-file-name "AUTHORS" data-directory))
(goto-char (point-min)))
'follow-link t)
(insert-button "Contributing"
'action
- (lambda (button)
+ (lambda (_button)
(view-file (expand-file-name "CONTRIBUTE" data-directory))
(goto-char (point-min)))
'follow-link t)
(insert "\tHow to contribute improvements to Emacs\n\n")
(insert-button "GNU and Freedom"
- 'action (lambda (button) (describe-gnu-project))
+ 'action (lambda (_button) (describe-gnu-project))
'follow-link t)
(insert "\t\tWhy we developed GNU Emacs and the GNU system\n")
(insert-button "Absence of Warranty"
- 'action (lambda (button) (describe-no-warranty))
+ 'action (lambda (_button) (describe-no-warranty))
'follow-link t)
(insert "\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
(insert-button "Copying Conditions"
- 'action (lambda (button) (describe-copying))
+ 'action (lambda (_button) (describe-copying))
'follow-link t)
(insert "\tConditions for redistributing and changing Emacs\n")
(insert-button "Getting New Versions"
- 'action (lambda (button) (describe-distribution))
+ 'action (lambda (_button) (describe-distribution))
'follow-link t)
(insert "\tHow to get the latest version of GNU Emacs\n")
(insert-button "More Manuals / Ordering Manuals"
- 'action (lambda (button) (view-order-manuals))
+ 'action (lambda (_button) (view-order-manuals))
'follow-link t)
(insert "\tBuying printed manuals from the FSF\n"))
(defun display-startup-echo-area-message ()
(let ((resize-mini-windows t))
- (or noninteractive ;(input-pending-p) init-file-had-error
+ (or noninteractive ;(input-pending-p) init-file-had-error
;; t if the init file says to inhibit the echo area startup message.
(and inhibit-startup-echo-area-message
user-init-file
(user-login-name)
init-file-user)))
;; Wasn't set with custom; see if .emacs has a setq.
- (let ((buffer (get-buffer-create " *temp*")))
- (prog1
- (condition-case nil
- (with-current-buffer buffer
- (insert-file-contents user-init-file)
- (re-search-forward
- (concat
- "([ \t\n]*setq[ \t\n]+"
- "inhibit-startup-echo-area-message[ \t\n]+"
- (regexp-quote
- (prin1-to-string
- (if (equal init-file-user "")
- (user-login-name)
- init-file-user)))
- "[ \t\n]*)")
- nil t))
- (error nil))
- (kill-buffer buffer)))))
+ (condition-case nil
+ (with-temp-buffer
+ (insert-file-contents user-init-file)
+ (re-search-forward
+ (concat
+ "([ \t\n]*setq[ \t\n]+"
+ "inhibit-startup-echo-area-message[ \t\n]+"
+ (regexp-quote
+ (prin1-to-string
+ (if (equal init-file-user "")
+ (user-login-name)
+ init-file-user)))
+ "[ \t\n]*)")
+ nil t))
+ (error nil))))
(message "%s" (startup-echo-area-message)))))
(defun display-startup-screen (&optional concise)
(defalias 'about-emacs 'display-about-screen)
(defalias 'display-splash-screen 'display-startup-screen)
-(defun command-line-1 (command-line-args-left)
+(defun command-line-1 (args-left)
(display-startup-echo-area-message)
(when (and pure-space-overflow
(not noninteractive))
:warning))
(let ((file-count 0)
+ (command-line-args-left args-left)
first-file-buffer)
(when command-line-args-left
;; We have command args; process them.
- ;; Note that any local variables in this function affect the
- ;; ability of -f batch-byte-compile to detect free variables.
- ;; So we give some of them with common names a cl1- prefix.
- (let ((cl1-dir command-line-default-directory)
- cl1-tem
+ (let ((dir command-line-default-directory)
+ tem
;; This approach loses for "-batch -L DIR --eval "(require foo)",
;; if foo is intended to be found in DIR.
;;
"--find-file" "--visit" "--file" "--no-desktop")
(mapcar (lambda (elt) (concat "-" (car elt)))
command-switch-alist)))
- (cl1-line 0)
- (cl1-column 0))
+ (line 0)
+ (column 0))
;; Add the long X options to longopts.
(dolist (tem command-line-x-option-alist)
argi orig-argi)))))
;; Execute the option.
- (cond ((setq cl1-tem (assoc argi command-switch-alist))
+ (cond ((setq tem (assoc argi command-switch-alist))
(if argval
(let ((command-line-args-left
(cons argval command-line-args-left)))
- (funcall (cdr cl1-tem) argi))
- (funcall (cdr cl1-tem) argi)))
+ (funcall (cdr tem) argi))
+ (funcall (cdr tem) argi)))
((equal argi "-no-splash")
(setq inhibit-startup-screen t))
"-funcall"
"-e")) ; what the source used to say
(setq inhibit-startup-screen t)
- (setq cl1-tem (intern (or argval (pop command-line-args-left))))
- (if (commandp cl1-tem)
- (command-execute cl1-tem)
- (funcall cl1-tem)))
+ (setq tem (intern (or argval (pop command-line-args-left))))
+ (if (commandp tem)
+ (command-execute tem)
+ (funcall tem)))
((member argi '("-eval" "-execute"))
(setq inhibit-startup-screen t)
(eval (read (or argval (pop command-line-args-left)))))
((member argi '("-L" "-directory"))
- (setq cl1-tem (expand-file-name
+ (setq tem (expand-file-name
(command-line-normalize-file-name
(or argval (pop command-line-args-left)))))
- (cond (splice (setcdr splice (cons cl1-tem (cdr splice)))
+ (cond (splice (setcdr splice (cons tem (cdr splice)))
(setq splice (cdr splice)))
- (t (setq load-path (cons cl1-tem load-path)
+ (t (setq load-path (cons tem load-path)
splice load-path))))
((member argi '("-l" "-load"))
((equal argi "-insert")
(setq inhibit-startup-screen t)
- (setq cl1-tem (or argval (pop command-line-args-left)))
- (or (stringp cl1-tem)
+ (setq tem (or argval (pop command-line-args-left)))
+ (or (stringp tem)
(error "File name omitted from `-insert' option"))
- (insert-file-contents (command-line-normalize-file-name cl1-tem)))
+ (insert-file-contents (command-line-normalize-file-name tem)))
((equal argi "-kill")
(kill-emacs t))
(message "\"--no-desktop\" ignored because the Desktop package is not loaded"))
((string-match "^\\+[0-9]+\\'" argi)
- (setq cl1-line (string-to-number argi)))
+ (setq line (string-to-number argi)))
((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
- (setq cl1-line (string-to-number (match-string 1 argi))
- cl1-column (string-to-number (match-string 2 argi))))
+ (setq line (string-to-number (match-string 1 argi))
+ column (string-to-number (match-string 2 argi))))
- ((setq cl1-tem (assoc orig-argi command-line-x-option-alist))
+ ((setq tem (assoc orig-argi command-line-x-option-alist))
;; Ignore X-windows options and their args if not using X.
(setq command-line-args-left
- (nthcdr (nth 1 cl1-tem) command-line-args-left)))
+ (nthcdr (nth 1 tem) command-line-args-left)))
- ((setq cl1-tem (assoc orig-argi command-line-ns-option-alist))
+ ((setq tem (assoc orig-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 cl1-tem) 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.
- (setq cl1-tem (or argval (pop command-line-args-left)))
- (unless (stringp cl1-tem)
+ (setq tem (or argval (pop command-line-args-left)))
+ (unless (stringp tem)
(error "File name omitted from `%s' option" argi))
(setq file-count (1+ file-count))
(let ((file (expand-file-name
- (command-line-normalize-file-name cl1-tem)
- cl1-dir)))
+ (command-line-normalize-file-name tem)
+ dir)))
(if (= file-count 1)
(setq first-file-buffer (find-file file))
(find-file-other-window file)))
- (unless (zerop cl1-line)
+ (unless (zerop line)
(goto-char (point-min))
- (forward-line (1- cl1-line)))
- (setq cl1-line 0)
- (unless (< cl1-column 1)
- (move-to-column (1- cl1-column)))
- (setq cl1-column 0))
+ (forward-line (1- line)))
+ (setq line 0)
+ (unless (< column 1)
+ (move-to-column (1- column)))
+ (setq column 0))
+
+ ;; These command lines now have no effect.
+ ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi)
+ (display-warning 'initialization
+ (format "Ignoring obsolete arg %s" argi)))
((equal argi "--")
(setq just-files t))
(let ((file
(expand-file-name
(command-line-normalize-file-name orig-argi)
- cl1-dir)))
+ dir)))
(cond ((= file-count 1)
(setq first-file-buffer (find-file file)))
(inhibit-startup-screen
(find-file-other-window file))
(t (find-file file))))
- (unless (zerop cl1-line)
+ (unless (zerop line)
(goto-char (point-min))
- (forward-line (1- cl1-line)))
- (setq cl1-line 0)
- (unless (< cl1-column 1)
- (move-to-column (1- cl1-column)))
- (setq cl1-column 0))))))
+ (forward-line (1- line)))
+ (setq line 0)
+ (unless (< column 1)
+ (move-to-column (1- column)))
+ (setq column 0))))))
;; In unusual circumstances, the execution of Lisp code due
;; to command-line options can cause the last visible frame
;; to be deleted. In this case, kill emacs to avoid an
;; abort later.
(unless (frame-live-p (selected-frame)) (kill-emacs nil))))))
- (when initial-buffer-choice
- (cond ((eq initial-buffer-choice t)
- (switch-to-buffer (get-buffer-create "*scratch*")))
- ((stringp initial-buffer-choice)
- (find-file initial-buffer-choice))))
+ (when (eq initial-buffer-choice t)
+ ;; When initial-buffer-choice equals t make sure that *scratch*
+ ;; exists.
+ (get-buffer-create "*scratch*"))
;; If *scratch* exists and is empty, insert initial-scratch-message.
+ ;; Do this before switching to *scratch* below to handle bug#9605.
(and initial-scratch-message
(get-buffer "*scratch*")
(with-current-buffer "*scratch*"
(insert initial-scratch-message)
(set-buffer-modified-p nil))))
+ (when initial-buffer-choice
+ (cond ((eq initial-buffer-choice t)
+ (switch-to-buffer (get-buffer-create "*scratch*")))
+ ((stringp initial-buffer-choice)
+ (find-file initial-buffer-choice))))
+
(if (or inhibit-startup-screen
initial-buffer-choice
noninteractive
(setq file (replace-match "/" t t file)))
file))
-;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db
;;; startup.el ends here
HCoop / bpt / emacs.git / blobdiff