* lisp/startup.el (command-line): Warn if ~/emacs.d is in load-path.
[bpt/emacs.git] / lisp / startup.el
CommitLineData
06788a55 1;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
c88ab9ce 2
90582f05 3;; Copyright (C) 1985-1986, 1992, 1994-2013 Free Software Foundation, Inc.
eea8d4ef 4
630cc463 5;; Maintainer: FSF
d7b4d18f 6;; Keywords: internal
bd78fa1d 7;; Package: emacs
630cc463 8
a726e0d1
JB
9;; This file is part of GNU Emacs.
10
eb3fa2cf 11;; GNU Emacs is free software: you can redistribute it and/or modify
a726e0d1 12;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
a726e0d1
JB
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
eb3fa2cf 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
a726e0d1 23
630cc463 24;;; Commentary:
a726e0d1 25
6b61353c
KH
26;; This file parses the command line and gets Emacs running. Options
27;; on the command line are handled in precedence order. For priorities
28;; see the structure standard_args in the emacs.c file.
a726e0d1 29
630cc463
ER
30;;; Code:
31
a726e0d1
JB
32(setq top-level '(normal-top-level))
33
42a3e6fa 34(defvar command-line-processed nil
2879a13b 35 "Non-nil once command line has been processed.")
a726e0d1 36
42a3e6fa 37(defgroup initialization nil
ca3685a3 38 "Emacs start-up procedure."
26cdce23
JL
39 :group 'environment)
40
41(defcustom initial-buffer-choice nil
42 "Buffer to show after starting Emacs.
490a1ad6 43If the value is nil and `inhibit-startup-screen' is nil, show the
dc646358
CK
44startup screen. If the value is a string, switch to a buffer
45visiting the file or directory specified by that string. If the
46value is a function, switch to the buffer returned by that
47function. If t, open the `*scratch*' buffer.
48de8b12
CY
48
49A string value also causes emacsclient to open the specified file
50or directory when no target file is specified."
26cdce23 51 :type '(choice
490a1ad6 52 (const :tag "Startup screen" nil)
26cdce23 53 (directory :tag "Directory" :value "~/")
85b84319 54 (file :tag "File" :value "~/.emacs")
ef099a94
MN
55 (const :tag "Notes buffer" remember-notes)
56 (function :tag "Function")
621ef9ab 57 (const :tag "Lisp scratch buffer" t))
dc646358 58 :version "24.4"
26cdce23 59 :group 'initialization)
42a3e6fa 60
490a1ad6 61(defcustom inhibit-startup-screen nil
249d9683 62 "Non-nil inhibits the startup screen.
249d9683 63
eeaa563e
JB
64This is for use in your personal init file (but NOT site-start.el),
65once you are familiar with the contents of the startup screen."
42a3e6fa
RS
66 :type 'boolean
67 :group 'initialization)
a726e0d1 68
490a1ad6
JL
69(defvaralias 'inhibit-splash-screen 'inhibit-startup-screen)
70(defvaralias 'inhibit-startup-message 'inhibit-startup-screen)
1b207153 71
22a58255 72(defvar startup-screen-inhibit-startup-screen nil)
1b207153 73
33da7b16
GM
74;; FIXME? Why does this get such weirdly extreme treatment, when the
75;; more important inhibit-startup-screen does not.
42a3e6fa 76(defcustom inhibit-startup-echo-area-message nil
ea6c930a 77 "Non-nil inhibits the initial startup echo area message.
42a3e6fa
RS
78Setting this variable takes effect
79only if you do it with the customization buffer
865fe16f 80or if your init file contains a line of this form:
54a003f7 81 (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
865fe16f
CY
82If your init file is byte-compiled, use the following form
83instead:
e5575c06 84 (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
865fe16f
CY
85Thus, someone else using a copy of your init file will see the
86startup message unless he personally acts to inhibit it."
42a3e6fa
RS
87 :type '(choice (const :tag "Don't inhibit")
88 (string :tag "Enter your user name, to inhibit"))
89 :group 'initialization)
1d7da582 90
42a3e6fa 91(defcustom inhibit-default-init nil
ea6c930a 92 "Non-nil inhibits loading the `default' library."
42a3e6fa
RS
93 :type 'boolean
94 :group 'initialization)
a726e0d1 95
802a980a 96(defcustom inhibit-startup-buffer-menu nil
ea6c930a 97 "Non-nil inhibits display of buffer list when more than 2 files are loaded."
802a980a
GM
98 :type 'boolean
99 :group 'initialization)
100
d7fa5aa2 101(defvar command-switch-alist nil
a726e0d1
JB
102 "Alist of command-line switches.
103Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
6b61353c
KH
104HANDLER-FUNCTION receives the switch string as its sole argument;
105the remaining command-line args are in the variable `command-line-args-left'.")
a726e0d1 106
860befc8
RS
107(defvar command-line-args-left nil
108 "List of command-line args not yet processed.")
109
aa5310e4
DK
110(defvaralias 'argv 'command-line-args-left
111 "List of command-line args not yet processed.
112This is a convenience alias, so that one can write \(pop argv\)
113inside of --eval command line arguments in order to access
114following arguments.")
513749ee 115(internal-make-var-non-special 'argv)
aa5310e4 116
513749ee
SM
117(defvar argi nil
118 "Current command-line argument.")
119(internal-make-var-non-special 'argi)
62f1ca49 120
a726e0d1
JB
121(defvar command-line-functions nil ;; lrs 7/31/89
122 "List of functions to process unrecognized command-line arguments.
123Each function should access the dynamically bound variables
b4484ea8 124`argi' (the current argument) and `command-line-args-left' (the remaining
a726e0d1 125arguments). The function should return non-nil only if it recognizes and
b4484ea8
RS
126processes `argi'. If it does so, it may consume successive arguments by
127altering `command-line-args-left' to remove them.")
a726e0d1 128
09a1077c
RS
129(defvar command-line-default-directory nil
130 "Default directory to use for command line arguments.
131This is normally copied from `default-directory' when Emacs starts.")
132
36cec983
SM
133;; This is here, rather than in x-win.el, so that we can ignore these
134;; options when we are not using X.
46cfd295 135(defconst command-line-x-option-alist
b3afdeb8
RS
136 '(("-bw" 1 x-handle-numeric-switch border-width)
137 ("-d" 1 x-handle-display)
138 ("-display" 1 x-handle-display)
5676ab57 139 ("-name" 1 x-handle-name-switch)
2c3fef40
RS
140 ("-title" 1 x-handle-switch title)
141 ("-T" 1 x-handle-switch title)
b3afdeb8
RS
142 ("-r" 0 x-handle-switch reverse t)
143 ("-rv" 0 x-handle-switch reverse t)
144 ("-reverse" 0 x-handle-switch reverse t)
145 ("-reverse-video" 0 x-handle-switch reverse t)
146 ("-fn" 1 x-handle-switch font)
147 ("-font" 1 x-handle-switch font)
188b6a5e
EZ
148 ("-fs" 0 x-handle-initial-switch fullscreen fullboth)
149 ("-fw" 0 x-handle-initial-switch fullscreen fullwidth)
150 ("-fh" 0 x-handle-initial-switch fullscreen fullheight)
3f1c6666 151 ("-mm" 0 x-handle-initial-switch fullscreen maximized)
b3afdeb8 152 ("-ib" 1 x-handle-numeric-switch internal-border-width)
1f7f78f1 153 ("-g" 1 x-handle-geometry)
9ff6bda1 154 ("-lsp" 1 x-handle-numeric-switch line-spacing)
1f7f78f1 155 ("-geometry" 1 x-handle-geometry)
b3afdeb8
RS
156 ("-fg" 1 x-handle-switch foreground-color)
157 ("-foreground" 1 x-handle-switch foreground-color)
158 ("-bg" 1 x-handle-switch background-color)
159 ("-background" 1 x-handle-switch background-color)
160 ("-ms" 1 x-handle-switch mouse-color)
c755acf3 161 ("-nbi" 0 x-handle-switch icon-type nil)
b3afdeb8
RS
162 ("-iconic" 0 x-handle-iconic)
163 ("-xrm" 1 x-handle-xrm-switch)
164 ("-cr" 1 x-handle-switch cursor-color)
165 ("-vb" 0 x-handle-switch vertical-scroll-bars t)
166 ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
167 ("-bd" 1 x-handle-switch)
168 ("--border-width" 1 x-handle-numeric-switch border-width)
169 ("--display" 1 x-handle-display)
5676ab57 170 ("--name" 1 x-handle-name-switch)
7775acb8 171 ("--title" 1 x-handle-switch title)
b3afdeb8
RS
172 ("--reverse-video" 0 x-handle-switch reverse t)
173 ("--font" 1 x-handle-switch font)
188b6a5e
EZ
174 ("--fullscreen" 0 x-handle-initial-switch fullscreen fullboth)
175 ("--fullwidth" 0 x-handle-initial-switch fullscreen fullwidth)
176 ("--fullheight" 0 x-handle-initial-switch fullscreen fullheight)
3f1c6666 177 ("--maximized" 0 x-handle-initial-switch fullscreen maximized)
b3afdeb8 178 ("--internal-border" 1 x-handle-numeric-switch internal-border-width)
1f7f78f1 179 ("--geometry" 1 x-handle-geometry)
b3afdeb8
RS
180 ("--foreground-color" 1 x-handle-switch foreground-color)
181 ("--background-color" 1 x-handle-switch background-color)
182 ("--mouse-color" 1 x-handle-switch mouse-color)
bb1f0f78 183 ("--no-bitmap-icon" 0 x-handle-no-bitmap-icon)
b3afdeb8
RS
184 ("--iconic" 0 x-handle-iconic)
185 ("--xrm" 1 x-handle-xrm-switch)
186 ("--cursor-color" 1 x-handle-switch cursor-color)
187 ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
9ff6bda1 188 ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
7f944e8e 189 ("--border-color" 1 x-handle-switch border-color)
c434f203
JD
190 ("--smid" 1 x-handle-smid)
191 ("--parent-id" 1 x-handle-parent-id))
b3afdeb8
RS
192 "Alist of X Windows options.
193Each element has the form
194 (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
195where NAME is the option name string, NUMARGS is the number of arguments
196that the option accepts, HANDLER is a function to call to handle the option.
197FRAME-PARAM (optional) is the frame parameter this option specifies,
198and VALUE is the value which is given to that frame parameter
199\(most options use the argument for this, so VALUE is not present).")
200
edfda783
AR
201(defconst command-line-ns-option-alist
202 '(("-NSAutoLaunch" 1 ns-ignore-1-arg)
203 ("-NXAutoLaunch" 1 ns-ignore-1-arg)
55e8d9a5 204 ("-macosx" 0 ignore)
edfda783
AR
205 ("-NSHost" 1 ns-ignore-1-arg)
206 ("-_NSMachLaunch" 1 ns-ignore-1-arg)
207 ("-MachLaunch" 1 ns-ignore-1-arg)
208 ("-NXOpen" 1 ns-ignore-1-arg)
209 ("-NSOpen" 1 ns-handle-nxopen)
210 ("-NXOpenTemp" 1 ns-ignore-1-arg)
211 ("-NSOpenTemp" 1 ns-handle-nxopentemp)
212 ("-GSFilePath" 1 ns-handle-nxopen)
213 ;;("-bw" . x-handle-numeric-switch)
214 ;;("-d" . x-handle-display)
215 ;;("-display" . x-handle-display)
d7d8c62a
GM
216 ("-name" 1 x-handle-name-switch)
217 ("-title" 1 x-handle-switch title)
218 ("-T" 1 x-handle-switch title)
219 ("-r" 0 x-handle-switch reverse t)
220 ("-rv" 0 x-handle-switch reverse t)
221 ("-reverse" 0 x-handle-switch reverse t)
222 ("-fn" 1 x-handle-switch font)
223 ("-font" 1 x-handle-switch font)
224 ("-ib" 1 x-handle-numeric-switch internal-border-width)
e543ae91
JD
225 ("-g" 1 x-handle-geometry)
226 ("-geometry" 1 x-handle-geometry)
d7d8c62a
GM
227 ("-fg" 1 x-handle-switch foreground-color)
228 ("-foreground" 1 x-handle-switch foreground-color)
229 ("-bg" 1 x-handle-switch background-color)
230 ("-background" 1 x-handle-switch background-color)
231; ("-ms" 1 x-handle-switch mouse-color)
232 ("-itype" 0 x-handle-switch icon-type t)
233 ("-i" 0 x-handle-switch icon-type t)
234 ("-iconic" 0 x-handle-iconic icon-type t)
edfda783 235 ;;("-xrm" . x-handle-xrm-switch)
d7d8c62a
GM
236 ("-cr" 1 x-handle-switch cursor-color)
237 ("-vb" 0 x-handle-switch vertical-scroll-bars t)
238 ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
239 ("-bd" 1 x-handle-switch)
240 ;; ("--border-width" 1 x-handle-numeric-switch border-width)
edfda783 241 ;; ("--display" 1 ns-handle-display)
d7d8c62a
GM
242 ("--name" 1 x-handle-name-switch)
243 ("--title" 1 x-handle-switch title)
244 ("--reverse-video" 0 x-handle-switch reverse t)
245 ("--font" 1 x-handle-switch font)
246 ("--internal-border" 1 x-handle-numeric-switch internal-border-width)
edfda783 247 ;; ("--geometry" 1 ns-handle-geometry)
d7d8c62a
GM
248 ("--foreground-color" 1 x-handle-switch foreground-color)
249 ("--background-color" 1 x-handle-switch background-color)
250 ("--mouse-color" 1 x-handle-switch mouse-color)
251 ("--icon-type" 0 x-handle-switch icon-type t)
252 ("--iconic" 0 x-handle-iconic)
edfda783 253 ;; ("--xrm" 1 ns-handle-xrm-switch)
d7d8c62a
GM
254 ("--cursor-color" 1 x-handle-switch cursor-color)
255 ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
256 ("--border-color" 1 x-handle-switch border-width))
edfda783
AR
257 "Alist of NS options.
258Each element has the form
259 (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
260where NAME is the option name string, NUMARGS is the number of arguments
261that the option accepts, HANDLER is a function to call to handle the option.
262FRAME-PARAM (optional) is the frame parameter this option specifies,
263and VALUE is the value which is given to that frame parameter
264\(most options use the argument for this, so VALUE is not present).")
265
266
e3bd99f5 267(defvar before-init-hook nil
db3f571a 268 "Normal hook run after handling urgent options but before loading init files.")
3fc958a4 269
e3bd99f5 270(defvar after-init-hook nil
865fe16f
CY
271 "Normal hook run after initializing the Emacs session.
272It is run after Emacs loads the init file, `default' library, the
273abbrevs file, and additional Lisp packages (if any), and setting
274the value of `after-init-time'.
275
276There is no `condition-case' around the running of this hook;
277therefore, if `debug-on-error' is non-nil, an error in one of
278these functions will invoke the debugger.")
db3f571a
KH
279
280(defvar emacs-startup-hook nil
281 "Normal hook run after loading init files and handling the command line.")
e3bd99f5 282
a726e0d1 283(defvar term-setup-hook nil
db3f571a
KH
284 "Normal hook run after loading terminal-specific Lisp code.
285It also follows `emacs-startup-hook'. This hook exists for users to set,
a726e0d1
JB
286so as to override the definitions made by the terminal-specific file.
287Emacs never sets this variable itself.")
288
deebb0e9
RS
289(defvar inhibit-startup-hooks nil
290 "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'.
291This is because we already did so.")
292
a726e0d1 293(defvar keyboard-type nil
b4484ea8 294 "The brand of keyboard you are using.
9ab281f0
JB
295This variable is used to define the proper function and keypad
296keys for use under X. It is used in a fashion analogous to the
297environment variable TERM.")
a726e0d1
JB
298
299(defvar window-setup-hook nil
b4484ea8
RS
300 "Normal hook run to initialize window system display.
301Emacs runs this hook after processing the command line arguments and loading
302the user's init file.")
a726e0d1 303
42a3e6fa 304(defcustom initial-major-mode 'lisp-interaction-mode
ab863ac2 305 "Major mode command symbol to use for the initial `*scratch*' buffer."
ce2f921e 306 :type 'function
42a3e6fa 307 :group 'initialization)
a726e0d1 308
ecbff273 309(defvar init-file-user nil
865fe16f 310 "Identity of user whose init file is or was read.
d7fa5aa2
RS
311The value is nil if `-q' or `--no-init-file' was specified,
312meaning do not load any init file.
313
d3a81eee
EZ
314Otherwise, the value may be an empty string, meaning
315use the init file for the user who originally logged in,
316or it may be a string containing a user's name meaning
317use that person's init file.
a726e0d1 318
2bdfaa42 319In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
865fe16f 320evaluates to the name of the directory where the init file was
13fce4e6
RS
321looked for.
322
323Setting `init-file-user' does not prevent Emacs from loading
ecbff273 324`site-start.el'. The only way to do that is to use `--no-site-file'.")
a726e0d1 325
1e8780b1 326(defcustom site-run-file (purecopy "site-start")
b7444d31
RS
327 "File containing site-wide run-time initializations.
328This file is loaded at run-time before `~/.emacs'. It contains inits
329that need to be in place for the entire site, but which, due to their
fcaf7de9 330higher incidence of change, don't make sense to load into Emacs's
b7444d31 331dumped image. Thus, the run-time load order is: 1. file described in
13fce4e6
RS
332this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
333
334Don't use the `site-start.el' file for things some users may not like.
335Put them in `default.el' instead, so that users can more easily
336override them. Users can prevent loading `default.el' with the `-q'
337option or by setting `inhibit-default-init' in their own init files,
338but inhibiting `site-start.el' requires `--no-site-file', which
842a1eac
RS
339is less convenient.
340
341This variable is defined for customization so as to make
342it visible in the relevant context. However, actually customizing it
343is not allowed, since it would not work anyway. The only way to set
9ab281f0 344this variable usefully is to set it while building and dumping Emacs."
93812130 345 :type '(choice (const :tag "none" nil) string)
842a1eac
RS
346 :group 'initialization
347 :initialize 'custom-initialize-default
06788a55 348 :set (lambda (_variable _value)
842a1eac 349 (error "Customizing `site-run-file' does not work")))
b7444d31 350
42a3e6fa 351(defcustom mail-host-address nil
b4fa35fa
GM
352 "Name of this machine, for purposes of naming users.
353If non-nil, Emacs uses this instead of `system-name' when constructing
354email addresses."
42a3e6fa
RS
355 :type '(choice (const nil) string)
356 :group 'mail)
c13fbb62 357
680ebfa6 358(defcustom user-mail-address (if command-line-processed
cee0c996
EZ
359 (or (getenv "EMAIL")
360 (concat (user-login-name) "@"
361 (or mail-host-address
362 (system-name))))
680ebfa6
RS
363 ;; Empty string means "not set yet".
364 "")
ea6c930a 365 "Full mailing address of this user.
cee0c996 366This is initialized with environment variable `EMAIL' or, as a
eeaa563e 367fallback, using `mail-host-address'. This is done after your
cee0c996 368init file is read, in case it sets `mail-host-address'."
42a3e6fa
RS
369 :type 'string
370 :group 'mail)
c10d1f06 371
42a3e6fa 372(defcustom auto-save-list-file-prefix
73f13e5a
GM
373 (cond ((eq system-type 'ms-dos)
374 ;; MS-DOS cannot have initial dot, and allows only 8.3 names
945a0a0c 375 (concat user-emacs-directory "auto-save.list/_s"))
73f13e5a 376 (t
945a0a0c 377 (concat user-emacs-directory "auto-save-list/.saves-")))
cdee38c3 378 "Prefix for generating `auto-save-list-file-name'.
865fe16f 379This is used after reading your init file to initialize
cdee38c3
KH
380`auto-save-list-file-name', by appending Emacs's pid and the system name,
381if you have not already set `auto-save-list-file-name' yourself.
73f13e5a 382Directories in the prefix will be created if necessary.
cdee38c3 383Set this to nil if you want to prevent `auto-save-list-file-name'
42a3e6fa 384from being initialized."
3671f444
KH
385 :type '(choice (const :tag "Don't record a session's auto save list" nil)
386 string)
42a3e6fa 387 :group 'auto-save)
2e05d063 388
dc58296d
RS
389(defvar emacs-basic-display nil)
390
a726e0d1
JB
391(defvar init-file-debug nil)
392
5b309ebf
RS
393(defvar init-file-had-error nil
394 "Non-nil if there was an error loading the user's init file.")
52320897 395
95eada65
RS
396(defvar normal-top-level-add-subdirs-inode-list nil)
397
178b4542
JL
398(defvar no-blinking-cursor nil)
399
b693e375
RS
400(defvar pure-space-overflow nil
401 "Non-nil if building Emacs overflowed pure space.")
402
ca0a881a 403(defvar pure-space-overflow-message (purecopy "\
22a58255 404Warning Warning!!! Pure space overflow !!!Warning Warning
ca0a881a 405\(See the node Pure Storage in the Lisp manual for details.)\n"))
22a58255 406
45448e64
SM
407(defcustom tutorial-directory
408 (file-name-as-directory (expand-file-name "tutorials" data-directory))
409 "Directory containing the Emacs TUTORIAL files."
410 :group 'installation
411 :type 'directory
412 :initialize 'custom-initialize-delay)
5f5ba825 413
66bd25ab
SM
414(defvar package--builtin-versions
415 ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
416 (purecopy `((emacs . ,(version-to-list emacs-version))))
417 "Alist giving the version of each versioned builtin package.
418I.e. each element of the list is of the form (NAME . VERSION) where
419NAME is the package name as a symbol, and VERSION is its version
420as a list.")
4525ce3e 421
1b8dff23
SM
422(defun package--description-file (dir)
423 (concat (let ((subdir (file-name-nondirectory
424 (directory-file-name dir))))
66bd25ab 425 (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
1b8dff23
SM
426 (match-string 1 subdir) subdir))
427 "-pkg.el"))
428
859e15c1 429(defun normal-top-level-add-subdirs-to-load-path ()
04ed2e9c 430 "Add all subdirectories of `default-directory' to `load-path'.
0412d833 431More precisely, this uses only the subdirectories whose names
f734a13e
DL
432start with letters or digits; it excludes any subdirectory named `RCS'
433or `CVS', and any subdirectory that contains a file named `.nosearch'."
f1180544 434 (let (dirs
95eada65 435 attrs
859e15c1
KH
436 (pending (list default-directory)))
437 ;; This loop does a breadth-first tree walk on DIR's subtree,
438 ;; putting each subdir into DIRS as its contents are examined.
439 (while pending
4e0a3971 440 (push (pop pending) dirs)
722a451d
EZ
441 (let* ((this-dir (car dirs))
442 (contents (directory-files this-dir))
443 (default-directory this-dir)
ae4002ce
SM
444 (canonicalized (if (fboundp 'w32-untranslated-canonical-name)
445 (w32-untranslated-canonical-name this-dir))))
ad961a00
GM
446 ;; The Windows version doesn't report meaningful inode numbers, so
447 ;; use the canonicalized absolute file name of the directory instead.
722a451d
EZ
448 (setq attrs (or canonicalized
449 (nthcdr 10 (file-attributes this-dir))))
95eada65 450 (unless (member attrs normal-top-level-add-subdirs-inode-list)
4e0a3971
SM
451 (push attrs normal-top-level-add-subdirs-inode-list)
452 (dolist (file contents)
ad961a00
GM
453 (and (string-match "\\`[[:alnum:]]" file)
454 ;; The lower-case variants of RCS and CVS are for DOS/Windows.
455 (not (member file '("RCS" "CVS" "rcs" "cvs")))
456 ;; Avoid doing a `stat' when it isn't necessary because
457 ;; that can cause trouble when an NFS server is down.
458 (not (string-match "\\.elc?\\'" file))
459 (file-directory-p file)
460 (let ((expanded (expand-file-name file)))
461 (or (file-exists-p (expand-file-name ".nosearch" expanded))
462 (setq pending (nconc pending (list expanded))))))))))
bb15e81a 463 (normal-top-level-add-to-load-path (cdr (nreverse dirs)))))
859e15c1 464
e87a7309 465(defun normal-top-level-add-to-load-path (dirs)
ad961a00
GM
466 "This function is called from a subdirs.el file.
467It assumes that `default-directory' is the directory in which the
468subdirs.el file exists, and it adds to `load-path' the subdirs of
469that directory as specified in DIRS. Normally the elements of
470DIRS are relative."
cd1c10f6
RS
471 (let ((tail load-path)
472 (thisdir (directory-file-name default-directory)))
473 (while (and tail
138e541f
GM
474 ;;Don't go all the way to the nil terminator.
475 (cdr tail)
cd1c10f6
RS
476 (not (equal thisdir (car tail)))
477 (not (and (memq system-type '(ms-dos windows-nt))
478 (equal (downcase thisdir) (downcase (car tail))))))
479 (setq tail (cdr tail)))
138e541f
GM
480 ;;Splice the new section in.
481 (when tail
482 (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
e87a7309 483
a726e0d1 484(defun normal-top-level ()
33da7b16
GM
485 "Emacs calls this function when it first starts up.
486It sets `command-line-processed', processes the command-line,
487reads the initialization files, etc.
488It is the default value of the variable `top-level'."
a726e0d1
JB
489 (if command-line-processed
490 (message "Back to top level.")
491 (setq command-line-processed t)
d0065ff1 492
375761b2
EZ
493 ;; Look in each dir in load-path for a subdirs.el file. If we
494 ;; find one, load it, which will add the appropriate subdirs of
495 ;; that dir into load-path. This needs to be done before setting
496 ;; the locale environment, because the latter might need to load
497 ;; some support files.
498 ;; Look for a leim-list.el file too. Loading it will register
499 ;; available input methods.
500 (let ((tail load-path)
501 (lispdir (expand-file-name "../lisp" data-directory))
375761b2
EZ
502 dir)
503 (while tail
504 (setq dir (car tail))
505 (let ((default-directory dir))
506 (load (expand-file-name "subdirs.el") t t t))
624780f0
GM
507 ;; Do not scan standard directories that won't contain a leim-list.el.
508 ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
cb6c95a3 509 ;; (Except the preloaded one in lisp/leim.)
624780f0 510 (or (string-prefix-p lispdir dir)
624780f0
GM
511 (let ((default-directory dir))
512 (load (expand-file-name "leim-list.el") t t t)))
375761b2
EZ
513 ;; We don't use a dolist loop and we put this "setq-cdr" command at
514 ;; the end, because the subdirs.el files may add elements to the end
515 ;; of load-path and we want to take it into account.
516 (setq tail (cdr tail))))
517
d0065ff1
EZ
518 ;; Set the default strings to display in mode line for end-of-line
519 ;; formats that aren't native to this platform. This should be
520 ;; done before calling set-locale-environment, as the latter might
521 ;; use these mnemonics.
522 (cond
523 ((memq system-type '(ms-dos windows-nt))
524 (setq eol-mnemonic-unix "(Unix)"
525 eol-mnemonic-mac "(Mac)"))
526 (t ; this is for Unix/GNU/Linux systems
527 (setq eol-mnemonic-dos "(DOS)"
528 eol-mnemonic-mac "(Mac)")))
529
530 (set-locale-environment nil)
531 ;; Decode all default-directory's (probably, only *scratch* exists
532 ;; at this point). default-directory of *scratch* is the basis
533 ;; for many other file-name variables and directory lists, so it
534 ;; is important to decode it ASAP.
535 (when locale-coding-system
536 (save-excursion
537 (dolist (elt (buffer-list))
538 (set-buffer elt)
539 (if default-directory
540 (setq default-directory
541 (decode-coding-string default-directory
542 locale-coding-system t)))))
543
544 ;; Decode all the important variables and directory lists, now
545 ;; that we know the locale's encoding. This is because the
546 ;; values of these variables are until here unibyte undecoded
547 ;; strings created by build_unibyte_string. data-directory in
548 ;; particular is used to construct many other standard directory
549 ;; names, so it must be decoded ASAP.
550 ;; Note that charset-map-path cannot be decoded here, since we
551 ;; could then be trapped in infinite recursion below, when we
552 ;; load subdirs.el, because encoding a directory name might need
553 ;; to load a charset map, which will want to encode
554 ;; charset-map-path, which will want to load the same charset
555 ;; map... So decoding of charset-map-path is delayed until
556 ;; further down below.
557 (dolist (pathsym '(load-path exec-path))
558 (let ((path (symbol-value pathsym)))
559 (if (listp path)
560 (set pathsym (mapcar (lambda (dir)
561 (decode-coding-string
562 dir
563 locale-coding-system t))
564 path)))))
565 (dolist (filesym '(data-directory doc-directory exec-directory
566 installation-directory
567 invocation-directory invocation-name
568 source-directory
569 shared-game-score-directory))
570 (let ((file (symbol-value filesym)))
571 (if (stringp file)
572 (set filesym (decode-coding-string file locale-coding-system t))))))
573
8d4c2221 574 (let ((dir default-directory))
fcaf7de9 575 (with-current-buffer "*Messages*"
90582f05 576 (messages-buffer-mode)
a1562258
SM
577 ;; Make it easy to do like "tail -f".
578 (set (make-local-variable 'window-point-insertion-type) t)
579 ;; Give *Messages* the same default-directory as *scratch*,
580 ;; just to keep things predictable.
8d4c2221 581 (setq default-directory dir)))
9715399e
MR
582 ;; `user-full-name' is now known; reset its standard-value here.
583 (put 'user-full-name 'standard-value
584 (list (default-value 'user-full-name)))
7c2fb837
DN
585 ;; If the PWD environment variable isn't accurate, delete it.
586 (let ((pwd (getenv "PWD")))
587 (and (stringp pwd)
588 ;; Use FOO/., so that if FOO is a symlink, file-attributes
589 ;; describes the directory linked to, not FOO itself.
590 (or (equal (file-attributes
591 (concat (file-name-as-directory pwd) "."))
592 (file-attributes
593 (concat (file-name-as-directory default-directory)
594 ".")))
595 (setq process-environment
596 (delete (concat "PWD=" pwd)
597 process-environment)))))
d0065ff1
EZ
598 ;; Now, that other directories were searched, and any charsets we
599 ;; need for encoding them are already loaded, we are ready to
600 ;; decode charset-map-path.
601 (if (listp charset-map-path)
602 (setq charset-map-path
603 (mapcar (lambda (dir)
604 (decode-coding-string
605 dir
606 locale-coding-system t))
607 charset-map-path)))
492878e4 608 (setq default-directory (abbreviate-file-name default-directory))
50d4ba39 609 (let ((old-face-font-rescale-alist face-font-rescale-alist))
6f2c86fa
KH
610 (unwind-protect
611 (command-line)
612 ;; Do this again, in case .emacs defined more abbreviations.
613 (setq default-directory (abbreviate-file-name default-directory))
b3c7c12c
RS
614 ;; Specify the file for recording all the auto save files of this session.
615 ;; This is used by recover-session.
cdee38c3
KH
616 (or auto-save-list-file-name
617 (and auto-save-list-file-prefix
618 (setq auto-save-list-file-name
1f7f78f1
RS
619 ;; Under MS-DOS our PID is almost always reused between
620 ;; Emacs invocations. We need something more unique.
4b33deaa
EZ
621 (cond ((eq system-type 'ms-dos)
622 ;; We are going to access the auto-save
623 ;; directory, so make sure it exists.
624 (make-directory
625 (file-name-directory auto-save-list-file-prefix)
626 t)
f1180544 627 (concat
4b33deaa
EZ
628 (make-temp-name
629 (expand-file-name
630 auto-save-list-file-prefix))
631 "~"))
632 (t
633 (expand-file-name
634 (format "%s%d-%s~"
635 auto-save-list-file-prefix
636 (emacs-pid)
637 (system-name))))))))
deebb0e9
RS
638 (unless inhibit-startup-hooks
639 (run-hooks 'emacs-startup-hook)
640 (and term-setup-hook
641 (run-hooks 'term-setup-hook)))
6a1e7d67
GM
642
643 ;; Don't do this if we failed to create the initial frame,
644 ;; for instance due to a dense colormap.
538ef02a
GM
645 (when (or frame-initial-frame
646 ;; If frame-initial-frame has no meaning, do this anyway.
2246281f 647 (not (and initial-window-system
538ef02a 648 (not noninteractive)
2246281f 649 (not (eq initial-window-system 'pc)))))
4a0c0061
CY
650
651 ;; FIXME: The user's init file may change
652 ;; face-font-rescale-alist. However, the default face
653 ;; already has an assigned font object, which does not take
654 ;; face-font-rescale-alist into account. For such
655 ;; situations, we ought to have a way to find all font
656 ;; objects and regenerate them; currently we do not. As a
657 ;; workaround, we specifically reset te default face's :font
658 ;; attribute here. See bug#1785.
659 (unless (eq face-font-rescale-alist
660 old-face-font-rescale-alist)
661 (set-face-attribute 'default nil :font (font-spec)))
662
6a1e7d67
GM
663 ;; Modify the initial frame based on what .emacs puts into
664 ;; ...-frame-alist.
665 (if (fboundp 'frame-notice-user-settings)
666 (frame-notice-user-settings))
2666355c
KL
667 ;; Set the faces for the initial background mode even if
668 ;; frame-notice-user-settings didn't (such as on a tty).
669 ;; frame-set-background-mode is idempotent, so it won't
670 ;; cause any harm if it's already been done.
6a1e7d67 671 (if (fboundp 'frame-set-background-mode)
2666355c 672 (frame-set-background-mode (selected-frame))))
13ab33c4 673
6f2c86fa
KH
674 ;; Now we know the user's default font, so add it to the menu.
675 (if (fboundp 'font-menu-add-default)
676 (font-menu-add-default))
677 (and window-setup-hook
50d4ba39 678 (run-hooks 'window-setup-hook))))
fdb88463
SM
679 ;; Subprocesses of Emacs do not have direct access to the terminal, so
680 ;; unless told otherwise they should only assume a dumb terminal.
681 ;; We are careful to do it late (after term-setup-hook), although the
682 ;; new multi-tty code does not use $TERM any more there anyway.
4bbfda32
SM
683 (setenv "TERM" "dumb")
684 ;; Remove DISPLAY from the process-environment as well. This allows
685 ;; `callproc.c' to give it a useful adaptive default which is either
686 ;; the value of the `display' frame-parameter or the DISPLAY value
687 ;; from initial-environment.
688 (let ((display (frame-parameter nil 'display)))
689 ;; Be careful which DISPLAY to remove from process-environment: follow
690 ;; the logic of `callproc.c'.
691 (if (stringp display) (setq display (concat "DISPLAY=" display))
692 (dolist (varval initial-environment)
693 (if (string-match "\\`DISPLAY=" varval)
694 (setq display varval))))
695 (when display
4bbfda32 696 (delete display process-environment)))))
6f2c86fa
KH
697
698;; Precompute the keyboard equivalents in the menu bar items.
c381f482
EZ
699;; Command-line options supported by tty's:
700(defconst tty-long-option-alist
8957d2bf
EZ
701 '(("--name" . "-name")
702 ("--title" . "-T")
703 ("--reverse-video" . "-reverse")
c381f482 704 ("--foreground-color" . "-fg")
8957d2bf
EZ
705 ("--background-color" . "-bg")
706 ("--color" . "-color")))
c381f482 707
b66b6aeb 708(defconst tool-bar-images-pixel-height 24
eeaa563e 709 "Height in pixels of images in the tool-bar.")
b66b6aeb 710
3a55d3d0
JR
711(defvar tool-bar-originally-present nil
712 "Non-nil if tool-bars are present before user and site init files are read.")
713
e9cda827
KL
714(defvar handle-args-function-alist '((nil . tty-handle-args))
715 "Functions for processing window-system dependent command-line arguments.
716Window system startup files should add their own function to this
717alist, which should parse the command line arguments. Those
718pertaining to the window system should be processed and removed
719from the returned command line.")
720
721(defvar window-system-initialization-alist '((nil . ignore))
722 "Alist of window-system initialization functions.
723Window-system startup files should add their own initialization
724function to this list. The function should take no arguments,
725and initialize the window system environment to prepare for
2bb819d5 726opening the first frame (e.g. open a connection to an X server).")
e9cda827 727
c381f482 728(defun tty-handle-args (args)
ad961a00 729 "Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc."
bca8c7be 730 (let (rest)
ae8bf5ab 731 (message "%S" args)
c381f482
EZ
732 (while (and args
733 (not (equal (car args) "--")))
bca8c7be
MS
734 (let* ((argi (pop args))
735 (orig-argi argi)
736 argval completion)
c381f482
EZ
737 ;; Check for long options with attached arguments
738 ;; and separate out the attached option argument into argval.
bca8c7be
MS
739 (when (string-match "^\\(--[^=]*\\)=" argi)
740 (setq argval (substring argi (match-end 0))
741 argi (match-string 1 argi)))
742 (when (string-match "^--" argi)
743 (setq completion (try-completion argi tty-long-option-alist))
c381f482
EZ
744 (if (eq completion t)
745 ;; Exact match for long option.
bca8c7be 746 (setq argi (cdr (assoc argi tty-long-option-alist)))
c381f482
EZ
747 (if (stringp completion)
748 (let ((elt (assoc completion tty-long-option-alist)))
749 ;; Check for abbreviated long option.
750 (or elt
bca8c7be
MS
751 (error "Option `%s' is ambiguous" argi))
752 (setq argi (cdr elt)))
c381f482 753 ;; Check for a short option.
bca8c7be
MS
754 (setq argval nil
755 argi orig-argi))))
756 (cond ((member argi '("-fg" "-foreground"))
757 (push (cons 'foreground-color (or argval (pop args)))
758 default-frame-alist))
759 ((member argi '("-bg" "-background"))
760 (push (cons 'background-color (or argval (pop args)))
761 default-frame-alist))
762 ((member argi '("-T" "-name"))
763 (unless argval (setq argval (pop args)))
764 (push (cons 'title
765 (if (stringp argval)
766 argval
767 (let ((case-fold-search t)
768 i)
769 (setq argval (invocation-name))
770
771 ;; Change any . or * characters in name to
772 ;; hyphens, so as to emulate behavior on X.
773 (while
774 (setq i (string-match "[.*]" argval))
775 (aset argval i ?-))
776 argval)))
777 default-frame-alist))
778 ((member argi '("-r" "-rv" "-reverse"))
779 (push '(reverse . t)
780 default-frame-alist))
781 ((equal argi "-color")
782 (unless argval (setq argval 8)) ; default --color means 8 ANSI colors
783 (push (cons 'tty-color-mode
784 (cond
785 ((numberp argval) argval)
786 ((string-match "-?[0-9]+" argval)
787 (string-to-number argval))
788 (t (intern argval))))
789 default-frame-alist))
790 (t
791 (push argi rest)))))
8baeb37a 792 (nconc (nreverse rest) args)))
c381f482 793
aa360da1
GM
794(declare-function x-get-resource "frame.c"
795 (attribute class &optional component subclass))
796(declare-function tool-bar-mode "tool-bar" (&optional arg))
d2b2930a 797(declare-function tool-bar-setup "tool-bar")
aa360da1 798
4ff029f6 799(defvar server-name)
35f372ca 800(defvar server-process)
4ff029f6 801
a726e0d1 802(defun command-line ()
33da7b16
GM
803 "A subroutine of `normal-top-level'.
804Amongst another things, it parses the command-line arguments."
5c9fad41 805 (setq before-init-time (current-time)
981c5d1d 806 after-init-time nil
238cbdf8 807 command-line-default-directory default-directory)
09a1077c 808
2aa0e5bf
SM
809 ;; Force recomputation, in case it was computed during the dump.
810 (setq abbreviated-home-dir nil)
849eedba 811
74f2ab06 812 ;; See if we should import version-control from the environment variable.
a726e0d1
JB
813 (let ((vc (getenv "VERSION_CONTROL")))
814 (cond ((eq vc nil)) ;don't do anything if not set
bca8c7be 815 ((member vc '("t" "numbered"))
a726e0d1 816 (setq version-control t))
bca8c7be 817 ((member vc '("nil" "existing"))
a726e0d1 818 (setq version-control nil))
bca8c7be 819 ((member vc '("never" "simple"))
a726e0d1
JB
820 (setq version-control 'never))))
821
79058860
JB
822 ;;! This has been commented out; I currently find the behavior when
823 ;;! split-window-keep-point is nil disturbing, but if I can get used
824 ;;! to it, then it would be better to eliminate the option.
825 ;;! ;; Choose a good default value for split-window-keep-point.
826 ;;! (setq split-window-keep-point (> baud-rate 2400))
f35fe3c6 827
735895f1
EZ
828 ;; Convert preloaded file names in load-history to absolute.
829 (let ((simple-file-name
3b61abfe
EZ
830 ;; Look for simple.el or simple.elc and use their directory
831 ;; as the place where all Lisp files live.
735895f1
EZ
832 (locate-file "simple" load-path (get-load-suffixes)))
833 lisp-dir)
834 ;; Don't abort if simple.el cannot be found, but print a warning.
e86762ec
GM
835 ;; Although in most usage we are going to cryptically abort a moment
836 ;; later anyway, due to missing required bidi data files (eg bug#13430).
735895f1 837 (if (null simple-file-name)
e86762ec
GM
838 (let ((standard-output 'external-debugging-output)
839 (lispdir (expand-file-name "../lisp" data-directory)))
840 (princ "Warning: Could not find simple.el or simple.elc")
841 (terpri)
842 (when (getenv "EMACSLOADPATH")
843 (princ "The EMACSLOADPATH environment variable is set, \
844please check its value")
845 (terpri))
846 (unless (file-readable-p lispdir)
847 (princ (format "Lisp directory %s not readable?" lispdir))
848 (terpri)))
735895f1
EZ
849 (setq lisp-dir (file-truename (file-name-directory simple-file-name)))
850 (setq load-history
851 (mapcar (lambda (elt)
852 (if (and (stringp (car elt))
853 (not (file-name-absolute-p (car elt))))
854 (cons (concat lisp-dir
855 (car elt))
856 (cdr elt))
857 elt))
858 load-history))))
4b816985 859
c16eb7b0 860 ;; Convert the arguments to Emacs internal representation.
d0065ff1 861 (let ((args command-line-args))
c16eb7b0
RS
862 (while args
863 (setcar args
864 (decode-coding-string (car args) locale-coding-system t))
bca8c7be 865 (pop args)))
c16eb7b0 866
03e3c30a 867 (let ((done nil)
4fe22cdf
CY
868 (args (cdr command-line-args))
869 display-arg)
03e3c30a 870
a726e0d1
JB
871 ;; Figure out which user's init file to load,
872 ;; either from the environment or from the options.
873 (setq init-file-user (if noninteractive nil (user-login-name)))
874 ;; If user has not done su, use current $HOME to find .emacs.
bca8c7be
MS
875 (and init-file-user
876 (equal init-file-user (user-real-login-name))
a726e0d1 877 (setq init-file-user ""))
03e3c30a
JB
878
879 ;; Process the command-line args, and delete the arguments
880 ;; processed. This is consistent with the way main in emacs.c
881 ;; does things.
a726e0d1 882 (while (and (not done) args)
9ab281f0
JB
883 (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--debug-init")
884 ("--user") ("--iconic") ("--icon-type") ("--quick")
885 ("--no-blinking-cursor") ("--basic-display")))
bca8c7be
MS
886 (argi (pop args))
887 (orig-argi argi)
888 argval)
452e9090 889 ;; Handle --OPTION=VALUE format.
7b704afe 890 (when (string-match "\\`\\(--[^=]*\\)=" argi)
1b207153 891 (setq argval (substring argi (match-end 0))
bca8c7be 892 argi (match-string 1 argi)))
7b704afe 893 (when (string-match "\\`--." orig-argi)
1b207153 894 (let ((completion (try-completion argi longopts)))
198a7a97
CY
895 (cond ((eq completion t)
896 (setq argi (substring argi 1)))
897 ((stringp completion)
898 (let ((elt (assoc completion longopts)))
899 (unless elt
900 (error "Option `%s' is ambiguous" argi))
901 (setq argi (substring (car elt) 1))))
902 (t
903 (setq argval nil
904 argi orig-argi)))))
a726e0d1 905 (cond
4fe22cdf
CY
906 ;; The --display arg is handled partly in C, partly in Lisp.
907 ;; When it shows up here, we just put it back to be handled
908 ;; by `command-line-1'.
909 ((member argi '("-d" "-display"))
910 (setq display-arg (list argi (pop args))))
dc58296d 911 ((member argi '("-Q" "-quick"))
6b61353c
KH
912 (setq init-file-user nil
913 site-run-file nil
8686ac71 914 inhibit-x-resources t))
dc58296d
RS
915 ((member argi '("-D" "-basic-display"))
916 (setq no-blinking-cursor t
917 emacs-basic-display t)
6b61353c 918 (push '(vertical-scroll-bars . nil) initial-frame-alist))
4e0a3971
SM
919 ((member argi '("-q" "-no-init-file"))
920 (setq init-file-user nil))
921 ((member argi '("-u" "-user"))
bca8c7be 922 (setq init-file-user (or argval (pop args))
4e0a3971 923 argval nil))
bca8c7be 924 ((equal argi "-no-site-file")
4e0a3971 925 (setq site-run-file nil))
bca8c7be 926 ((equal argi "-debug-init")
4e0a3971 927 (setq init-file-debug t))
bca8c7be 928 ((equal argi "-iconic")
4e0a3971 929 (push '(visibility . icon) initial-frame-alist))
178b4542
JL
930 ((member argi '("-nbc" "-no-blinking-cursor"))
931 (setq no-blinking-cursor t))
4e0a3971 932 ;; Push the popped arg back on the list of arguments.
bca8c7be
MS
933 (t
934 (push argi args)
935 (setq done t)))
096b7031
KH
936 ;; Was argval set but not used?
937 (and argval
938 (error "Option `%s' doesn't allow an argument" argi))))
939
4fe22cdf
CY
940 ;; Re-attach the --display arg.
941 (and display-arg (setq args (append display-arg args)))
942
03e3c30a 943 ;; Re-attach the program name to the front of the arg list.
bca8c7be
MS
944 (and command-line-args
945 (setcdr command-line-args args)))
a726e0d1 946
d2fd733e
SM
947 ;; Make sure window system's init file was loaded in loadup.el if
948 ;; using a window system.
949 ;; Initialize the window-system only after processing the command-line
950 ;; args so that -Q can influence this initialization.
951 (condition-case error
952 (unless noninteractive
953 (if (and initial-window-system
954 (not (featurep
955 (intern
956 (concat (symbol-name initial-window-system) "-win")))))
957 (error "Unsupported window system `%s'" initial-window-system))
958 ;; Process window-system specific command line parameters.
959 (setq command-line-args
960 (funcall
961 (or (cdr (assq initial-window-system handle-args-function-alist))
962 (error "Unsupported window system `%s'" initial-window-system))
963 command-line-args))
964 ;; Initialize the window system. (Open connection, etc.)
965 (funcall
966 (or (cdr (assq initial-window-system window-system-initialization-alist))
efc3dd3c
DC
967 (error "Unsupported window system `%s'" initial-window-system)))
968 (put initial-window-system 'window-system-initialized t))
d2fd733e
SM
969 ;; If there was an error, print the error message and exit.
970 (error
971 (princ
972 (if (eq (car error) 'error)
973 (apply 'concat (cdr error))
974 (if (memq 'file-error (get (car error) 'error-conditions))
975 (format "%s: %s"
976 (nth 1 error)
977 (mapconcat (lambda (obj) (prin1-to-string obj t))
978 (cdr (cdr error)) ", "))
979 (format "%s: %s"
980 (get (car error) 'error-message)
981 (mapconcat (lambda (obj) (prin1-to-string obj t))
982 (cdr error) ", "))))
983 'external-debugging-output)
984 (terpri 'external-debugging-output)
985 (setq initial-window-system nil)
986 (kill-emacs)))
987
ce98f555
RS
988 (run-hooks 'before-init-hook)
989
15cd8efd 990 ;; Under X, create the X frame and delete the terminal frame.
7581ba40 991 (unless (daemonp)
15cd8efd
CY
992 (if (or noninteractive emacs-basic-display)
993 (setq menu-bar-mode nil
994 tool-bar-mode nil
995 no-blinking-cursor t))
9ba6e7d4 996 (frame-initialize))
14f16b9c 997
55702e89
AS
998 (when (fboundp 'x-create-frame)
999 ;; Set up the tool-bar (even in tty frames, since Emacs might open a
1000 ;; graphical frame later).
1001 (unless noninteractive
1002 (tool-bar-setup)))
6431f2e6 1003
ed0fb1f1 1004 ;; Turn off blinking cursor if so specified in X resources. This is here
b08cb5a6 1005 ;; only because all other settings of no-blinking-cursor are here.
ed0fb1f1
JD
1006 (unless (or noninteractive
1007 emacs-basic-display
9e2a2647 1008 (and (memq window-system '(x w32 ns))
ed0fb1f1 1009 (not (member (x-get-resource "cursorBlink" "CursorBlink")
04877ddb 1010 '("no" "off" "false" "0")))))
ed0fb1f1
JD
1011 (setq no-blinking-cursor t))
1012
790d0270
SM
1013 ;; Re-evaluate predefined variables whose initial value depends on
1014 ;; the runtime context.
1015 (mapc 'custom-reevaluate-setting
1016 ;; Initialize them in the same order they were loaded, in case there
1017 ;; are dependencies between them.
1018 (prog1 (nreverse custom-delayed-init-variables)
1019 (setq custom-delayed-init-variables nil)))
3b73087e 1020
30a2fded
KL
1021 (normal-erase-is-backspace-setup-frame)
1022
1592c1ef 1023 ;; Register default TTY colors for the case the terminal hasn't a
40ba43b4 1024 ;; terminal init file. We do this regardless of whether the terminal
79c3172f
KL
1025 ;; supports colors or not and regardless the current display type,
1026 ;; since users can connect to color-capable terminals and also
1027 ;; switch color support on or off in mid-session by setting the
1028 ;; tty-color-mode frame parameter.
a5b5acaf
EZ
1029 ;; Exception: the `pc' ``window system'' has only 16 fixed colors,
1030 ;; and they are already set at this point by a suitable function in
1031 ;; window-system-initialization-alist.
1032 (or (eq initial-window-system 'pc)
1033 (tty-register-default-colors))
1592c1ef 1034
3a55d3d0
JR
1035 ;; Record whether the tool-bar is present before the user and site
1036 ;; init files are processed. frame-notice-user-settings uses this
1037 ;; to determine if the tool-bar has been disabled by the init files,
1038 ;; and the frame needs to be resized.
1039 (when (fboundp 'frame-notice-user-settings)
1040 (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
1041 (assq 'tool-bar-lines default-frame-alist))))
1042 (setq tool-bar-originally-present
bca8c7be
MS
1043 (and tool-bar-lines
1044 (cdr tool-bar-lines)
1045 (not (eq 0 (cdr tool-bar-lines)))))))
3a55d3d0 1046
752ef254 1047 (let ((old-scalable-fonts-allowed scalable-fonts-allowed)
752ef254
GM
1048 (old-face-ignored-fonts face-ignored-fonts))
1049
752ef254
GM
1050 ;; Run the site-start library if it exists. The point of this file is
1051 ;; that it is run before .emacs. There is no point in doing this after
1052 ;; .emacs; that is useless.
5f144784
GM
1053 ;; Note that user-init-file is nil at this point. Code that might
1054 ;; be loaded from site-run-file and wants to test if -q was given
1055 ;; should check init-file-user instead, since that is already set.
1056 ;; See cus-edit.el for an example.
f1180544 1057 (if site-run-file
752ef254
GM
1058 (load site-run-file t t))
1059
1060 ;; Sites should not disable this. Only individuals should disable
1cff9ad1
JL
1061 ;; the startup screen.
1062 (setq inhibit-startup-screen nil)
752ef254 1063
f963ea40 1064 ;; Warn for invalid user name.
ce98f555
RS
1065 (when init-file-user
1066 (if (string-match "[~/:\n]" init-file-user)
1067 (display-warning 'initialization
1068 (format "Invalid user name %s"
1069 init-file-user)
1070 :error)
1df1e49e 1071 (if (file-directory-p (expand-file-name
5463218c
EZ
1072 ;; We don't support ~USER on MS-Windows
1073 ;; and MS-DOS except for the current
1074 ;; user, and always load .emacs from
1075 ;; the current user's home directory
1076 ;; (see below). So always check "~",
1077 ;; even if invoked with "-u USER", or
1078 ;; if $USER or $LOGNAME are set to
1079 ;; something different.
1080 (if (memq system-type '(windows-nt ms-dos))
1df1e49e
EZ
1081 "~"
1082 (concat "~" init-file-user))))
ce98f555
RS
1083 nil
1084 (display-warning 'initialization
1085 (format "User %s has no home directory"
ec1b09b1
EZ
1086 (if (equal init-file-user "")
1087 (user-real-login-name)
1088 init-file-user))
ce98f555 1089 :error))))
f963ea40 1090
752ef254
GM
1091 ;; Load that user's init file, or the default one, or none.
1092 (let (debug-on-error-from-init-file
1093 debug-on-error-should-be-set
1094 (debug-on-error-initial
1095 (if (eq init-file-debug t) 'startup init-file-debug))
597e2240 1096 (orig-enable-multibyte (default-value 'enable-multibyte-characters)))
752ef254
GM
1097 (let ((debug-on-error debug-on-error-initial)
1098 ;; This function actually reads the init files.
1099 (inner
1100 (function
1101 (lambda ()
1102 (if init-file-user
1103 (let ((user-init-file-1
4e0a3971 1104 (cond
8a05b668
JB
1105 ((eq system-type 'ms-dos)
1106 (concat "~" init-file-user "/_emacs"))
1107 ((not (eq system-type 'windows-nt))
1108 (concat "~" init-file-user "/.emacs"))
1109 ;; Else deal with the Windows situation
1110 ((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
1111 ;; Prefer .emacs on Windows.
1112 "~/.emacs")
1113 ((directory-files "~" nil "^_emacs\\(\\.elc?\\)?$")
1114 ;; Also support _emacs for compatibility, but warn about it.
50f84510
JB
1115 (push '(initialization
1116 "`_emacs' init file is deprecated, please use `.emacs'")
1117 delayed-warnings-list)
8a05b668
JB
1118 "~/_emacs")
1119 (t ;; But default to .emacs if _emacs does not exist.
1120 "~/.emacs"))))
752ef254
GM
1121 ;; This tells `load' to store the file name found
1122 ;; into user-init-file.
1123 (setq user-init-file t)
1124 (load user-init-file-1 t t)
f1180544 1125
a04d5983
RS
1126 (when (eq user-init-file t)
1127 ;; If we did not find ~/.emacs, try
c3ab3701 1128 ;; ~/.emacs.d/init.el.
a04d5983
RS
1129 (let ((otherfile
1130 (expand-file-name
c3ab3701 1131 "init"
a04d5983 1132 (file-name-as-directory
c3ab3701 1133 (concat "~" init-file-user "/.emacs.d")))))
a04d5983
RS
1134 (load otherfile t t)
1135
1136 ;; If we did not find the user's init file,
1137 ;; set user-init-file conclusively.
1138 ;; Don't let it be set from default.el.
1139 (when (eq user-init-file t)
1140 (setq user-init-file user-init-file-1))))
f1180544 1141
752ef254
GM
1142 ;; If we loaded a compiled file, set
1143 ;; `user-init-file' to the source version if that
1144 ;; exists.
1145 (when (and user-init-file
1146 (equal (file-name-extension user-init-file)
1147 "elc"))
1148 (let* ((source (file-name-sans-extension user-init-file))
1149 (alt (concat source ".el")))
1150 (setq source (cond ((file-exists-p alt) alt)
1151 ((file-exists-p source) source)
1152 (t nil)))
1153 (when source
1154 (when (file-newer-than-file-p source user-init-file)
1155 (message "Warning: %s is newer than %s"
1156 source user-init-file)
1157 (sit-for 1))
1158 (setq user-init-file source))))
f1180544 1159
bca8c7be 1160 (unless inhibit-default-init
1cff9ad1 1161 (let ((inhibit-startup-screen nil))
bca8c7be
MS
1162 ;; Users are supposed to be told their rights.
1163 ;; (Plus how to get help and how to undo.)
1164 ;; Don't you dare turn this off for anyone
1165 ;; except yourself.
1166 (load "default" t t)))))))))
752ef254
GM
1167 (if init-file-debug
1168 ;; Do this without a condition-case if the user wants to debug.
1169 (funcall inner)
1170 (condition-case error
1171 (progn
1172 (funcall inner)
1173 (setq init-file-had-error nil))
1174 (error
f2602864
CY
1175 (display-warning
1176 'initialization
1177 (format "An error occurred while loading `%s':\n\n%s%s%s\n\n\
1178To ensure normal operation, you should investigate and remove the
1179cause of the error in your initialization file. Start Emacs with
1180the `--debug-init' option to view a complete error backtrace."
1181 user-init-file
1182 (get (car error) 'error-message)
1183 (if (cdr error) ": " "")
9dba2c64
SM
1184 (mapconcat (lambda (s) (prin1-to-string s t))
1185 (cdr error) ", "))
f2602864
CY
1186 :warning)
1187 (setq init-file-had-error t))))
1188
1189 (if (and deactivate-mark transient-mark-mode)
9c8b2150
RS
1190 (with-current-buffer (window-buffer)
1191 (deactivate-mark)))
1192
d5bd2558
GM
1193 ;; If the user has a file of abbrevs, read it (unless -batch).
1194 (when (and (not noninteractive)
1195 (file-exists-p abbrev-file-name)
2863a9be 1196 (file-readable-p abbrev-file-name))
ac3186fd
RS
1197 (quietly-read-abbrev-file abbrev-file-name))
1198
70b199c3
RS
1199 ;; If the abbrevs came entirely from the init file or the
1200 ;; abbrevs file, they do not need saving.
1201 (setq abbrevs-changed nil)
1202
752ef254
GM
1203 ;; If we can tell that the init file altered debug-on-error,
1204 ;; arrange to preserve the value that it set up.
1205 (or (eq debug-on-error debug-on-error-initial)
1206 (setq debug-on-error-should-be-set t
1207 debug-on-error-from-init-file debug-on-error)))
1208 (if debug-on-error-should-be-set
1209 (setq debug-on-error debug-on-error-from-init-file))
597e2240
GM
1210 (unless (or (default-value 'enable-multibyte-characters)
1211 (eq orig-enable-multibyte (default-value
1212 'enable-multibyte-characters)))
752ef254 1213 ;; Init file changed to unibyte. Reset existing multibyte
09e80d9f 1214 ;; buffers (probably *scratch*, *Messages*, *Minibuf-0*).
752ef254
GM
1215 ;; Arguably this should only be done if they're free of
1216 ;; multibyte characters.
e18c18e8
JB
1217 (mapc (lambda (buffer)
1218 (with-current-buffer buffer
1219 (if enable-multibyte-characters
1220 (set-buffer-multibyte nil))))
1221 (buffer-list))
752ef254
GM
1222 ;; Also re-set the language environment in case it was
1223 ;; originally done before unibyte was set and is sensitive to
1224 ;; unibyte (display table, terminal coding system &c).
1225 (set-language-environment current-language-environment)))
f1180544 1226
752ef254 1227 ;; Do this here in case the init file sets mail-host-address.
5b88a2c5 1228 (if (equal user-mail-address "")
cee0c996
EZ
1229 (setq user-mail-address (or (getenv "EMAIL")
1230 (concat (user-login-name) "@"
1231 (or mail-host-address
1232 (system-name))))))
752ef254
GM
1233
1234 ;; If parameter have been changed in the init file which influence
1235 ;; face realization, clear the face cache so that new faces will
1236 ;; be realized.
1237 (unless (and (eq scalable-fonts-allowed old-scalable-fonts-allowed)
752ef254
GM
1238 (eq face-ignored-fonts old-face-ignored-fonts))
1239 (clear-face-cache)))
f1180544 1240
8a500a91
CY
1241 ;; If any package directory exists, initialize the package system.
1242 (and user-init-file
1243 package-enable-at-startup
1244 (catch 'package-dir-found
1245 (let (dirs)
1246 (if (boundp 'package-directory-list)
1247 (setq dirs package-directory-list)
1248 (dolist (f load-path)
1249 (and (stringp f)
1250 (equal (file-name-nondirectory f) "site-lisp")
1251 (push (expand-file-name "elpa" f) dirs))))
1252 (push (if (boundp 'package-user-dir)
1253 package-user-dir
1254 (locate-user-emacs-file "elpa"))
1255 dirs)
1256 (dolist (dir dirs)
1257 (when (file-directory-p dir)
1258 (dolist (subdir (directory-files dir))
1b8dff23
SM
1259 (when (let ((subdir (expand-file-name subdir dir)))
1260 (and (file-directory-p subdir)
1261 (file-exists-p
551e07e5
JB
1262 (expand-file-name
1263 (package--description-file subdir)
1264 subdir))))
8a500a91
CY
1265 (throw 'package-dir-found t)))))))
1266 (package-initialize))
44198b6e 1267
5ab0e67e 1268 (setq after-init-time (current-time))
e3bd99f5
RM
1269 (run-hooks 'after-init-hook)
1270
a726e0d1
JB
1271 ;; If *scratch* exists and init file didn't change its mode, initialize it.
1272 (if (get-buffer "*scratch*")
694210c4 1273 (with-current-buffer "*scratch*"
a726e0d1 1274 (if (eq major-mode 'fundamental-mode)
26cdce23 1275 (funcall initial-major-mode))))
f1180544 1276
a726e0d1
JB
1277 ;; Load library for our terminal type.
1278 ;; User init file can set term-file-prefix to nil to prevent this.
bca8c7be 1279 (unless (or noninteractive
cd85984a
KL
1280 initial-window-system)
1281 (tty-run-terminal-initialization (selected-frame)))
a726e0d1 1282
5777a167
RS
1283 ;; Update the out-of-memory error message based on user's key bindings
1284 ;; for save-some-buffers.
1285 (setq memory-signal-data
1286 (list 'error
1287 (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs")))
1288
03e3c30a 1289 ;; Process the remaining args.
a726e0d1
JB
1290 (command-line-1 (cdr command-line-args))
1291
2e6710c3
GM
1292 ;; This is a problem because, e.g. if emacs.d/gnus.el exists,
1293 ;; trying to load gnus could load the wrong file.
1294 ;; OK, it would not matter if .emacs.d were at the end of load-path.
1295 ;; but for the sake of simplicity, we discourage it full-stop.
1296 ;; Ref eg http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00056.html
1297 ;;
1298 ;; A bad element could come from user-emacs-file, the command line,
1299 ;; or EMACSLOADPATH, so we basically always have to check.
1300 (let (warned)
1301 (dolist (dir load-path)
1302 (and (not warned)
1303 (string-match-p "/[._]emacs\\.d/?\\'" dir)
1304 (string-equal (file-name-as-directory (expand-file-name dir))
1305 (expand-file-name user-emacs-directory))
1306 (setq warned t)
1307 (display-warning 'initialization
1308 (format "Your `load-path' seems to contain
1309your `.emacs.d' directory: %s\n\
1310This is likely to cause problems...\n\
1311Consider using a subdirectory instead, e.g.: %s" dir
1312(expand-file-name "lisp" user-emacs-directory))
1313 :warning))))
1314
a726e0d1 1315 ;; If -batch, terminate after processing the command options.
ca57f55d
JD
1316 (if noninteractive (kill-emacs t))
1317
7581ba40
RF
1318 ;; In daemon mode, start the server to allow clients to connect.
1319 ;; This is done after loading the user's init file and after
1320 ;; processing all command line arguments to allow e.g. `server-name'
1321 ;; to be changed before the server starts.
4ff029f6
DN
1322 (let ((dn (daemonp)))
1323 (when dn
1324 (when (stringp dn) (setq server-name dn))
1325 (server-start)
35f372ca
JB
1326 (if server-process
1327 (daemon-initialized)
fd95644b
DN
1328 (if (stringp dn)
1329 (message
1330 "Unable to start daemon: Emacs server named %S already running"
1331 server-name)
1332 (message "Unable to start the daemon.\nAnother instance of Emacs is running the server, either as daemon or interactively.\nYou can use emacsclient to connect to that Emacs process."))
35f372ca 1333 (kill-emacs 1))))
7581ba40 1334
ca57f55d
JD
1335 ;; Run emacs-session-restore (session management) if started by
1336 ;; the session manager and we have a session manager connection.
bca8c7be
MS
1337 (if (and (boundp 'x-session-previous-id)
1338 (stringp x-session-previous-id))
a99df87d
RS
1339 (with-no-warnings
1340 (emacs-session-restore x-session-previous-id))))
a726e0d1 1341
15cd8efd
CY
1342(defun x-apply-session-resources ()
1343 "Apply X resources which specify initial values for Emacs variables.
1344This is called from a window-system initialization function, such
1345as `x-initialize-window-system' for X, either at startup (prior
1346to reading the init file), or afterwards when the user first
1347opens a graphical frame.
1348
1349This can set the values of `menu-bar-mode', `tool-bar-mode', and
1350`no-blinking-cursor', as well as the `cursor' face. Changed
1351settings will be marked as \"CHANGED outside of Customize\"."
1352 (let ((no-vals '("no" "off" "false" "0"))
1353 (settings '(("menuBar" "MenuBar" menu-bar-mode nil)
1354 ("toolBar" "ToolBar" tool-bar-mode nil)
1355 ("cursorBlink" "CursorBlink" no-blinking-cursor t))))
1356 (dolist (x settings)
1357 (if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals)
1358 (set (nth 2 x) (nth 3 x)))))
1359 (let ((color (x-get-resource "cursorColor" "Foreground")))
1360 (when color
1361 (put 'cursor 'theme-face
1362 `((changed ((t :background ,color)))))
1363 (put 'cursor 'face-modified t))))
1364
46cfd295 1365(defcustom initial-scratch-message (purecopy "\
3b79c219
GM
1366;; This buffer is for notes you don't want to save, and for Lisp evaluation.
1367;; If you want to create a file, visit that file with C-x C-f,
1368;; then enter the text in that file's own buffer.
9fe3219e 1369
46cfd295 1370")
9fe3219e 1371 "Initial message displayed in *scratch* buffer at startup.
9bc6f805 1372If this is nil, no message will be displayed."
fa071a47
RS
1373 :type '(choice (text :tag "Message")
1374 (const :tag "none" nil))
1375 :group 'initialization)
9fe3219e 1376
ce9ded5d
GM
1377\f
1378;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1379;;; Fancy splash screen
1380;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1381
a7610c52 1382(defconst fancy-startup-text
fa7c3228 1383 `((:face (variable-pitch font-lock-comment-face)
22a58255 1384 "Welcome to "
6e0cfad3 1385 :link ("GNU Emacs"
9dba2c64 1386 ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
6e0cfad3 1387 "Browse http://www.gnu.org/software/emacs/")
22a58255
CY
1388 ", one component of the "
1389 :link
9dba2c64 1390 ,(lambda ()
22a58255 1391 (if (eq system-type 'gnu/linux)
9dba2c64
SM
1392 `("GNU/Linux"
1393 ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
6e0cfad3 1394 "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
9dba2c64 1395 `("GNU" ,(lambda (_button) (describe-gnu-project))
6e0cfad3 1396 "Display info on the GNU project")))
bb398779 1397 " operating system.\n\n"
ca267291 1398 :face variable-pitch
9dba2c64 1399 :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
22a58255 1400 "\tLearn basic keystroke commands"
9dba2c64 1401 ,(lambda ()
fad930b6
RS
1402 (let* ((en "TUTORIAL")
1403 (tut (or (get-language-info current-language-environment
1404 'tutorial)
1405 en))
1406 (title (with-temp-buffer
1407 (insert-file-contents
1408 (expand-file-name tut tutorial-directory)
87ab808f
EZ
1409 ;; We used to read only the first 256 bytes of
1410 ;; the tutorial, but that prevents the coding:
1411 ;; setting, if any, in file-local variables
1412 ;; section to be seen by insert-file-contents,
1413 ;; and results in gibberish when the language
1414 ;; environment's preferred encoding is
1415 ;; different from what the file-local variable
1416 ;; says. One case in point is Hebrew.
1417 nil)
fad930b6
RS
1418 (search-forward ".")
1419 (buffer-substring (point-min) (1- (point))))))
1420 ;; If there is a specific tutorial for the current language
1421 ;; environment and it is not English, append its title.
1422 (if (string= en tut)
1423 ""
1424 (concat " (" title ")"))))
1425 "\n"
fad930b6 1426 :link ("Emacs Guided Tour"
9dba2c64
SM
1427 ,(lambda (_button)
1428 (browse-url "http://www.gnu.org/software/emacs/tour/"))
6e0cfad3 1429 "Browse http://www.gnu.org/software/emacs/tour/")
bb398779 1430 "\tOverview of Emacs features at gnu.org\n"
9dba2c64 1431 :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual)))
490a1ad6 1432 "\tView the Emacs manual using Info\n"
9dba2c64 1433 :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
fad930b6 1434 "\tGNU Emacs comes with "
422abbfd 1435 :face (variable-pitch (:slant oblique))
fad930b6
RS
1436 "ABSOLUTELY NO WARRANTY\n"
1437 :face variable-pitch
9dba2c64 1438 :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
fad930b6 1439 "\tConditions for redistributing and changing Emacs\n"
9dba2c64 1440 :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
22a58255 1441 "\tPurchasing printed copies of manuals\n"
fad930b6 1442 "\n"))
ce9ded5d
GM
1443 "A list of texts to show in the middle part of splash screens.
1444Each element in the list should be a list of strings or pairs
1445`:face FACE', like `fancy-splash-insert' accepts them.")
1446
a7610c52 1447(defconst fancy-about-text
91064207 1448 `((:face (variable-pitch font-lock-comment-face)
22a58255 1449 "This is "
6e0cfad3 1450 :link ("GNU Emacs"
9dba2c64 1451 ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
6e0cfad3 1452 "Browse http://www.gnu.org/software/emacs/")
22a58255
CY
1453 ", one component of the "
1454 :link
9dba2c64 1455 ,(lambda ()
22a58255 1456 (if (eq system-type 'gnu/linux)
9dba2c64
SM
1457 `("GNU/Linux"
1458 ,(lambda (_button)
1459 (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
6e0cfad3 1460 "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
9dba2c64 1461 `("GNU" ,(lambda (_button) (describe-gnu-project))
6e0cfad3 1462 "Display info on the GNU project.")))
22a58255 1463 " operating system.\n"
fa7c3228 1464 :face (variable-pitch font-lock-builtin-face)
22a58255 1465 "\n"
9dba2c64 1466 ,(lambda () (emacs-version))
22a58255 1467 "\n"
245a7698 1468 :face (variable-pitch (:height 0.8))
9dba2c64 1469 ,(lambda () emacs-copyright)
22a58255
CY
1470 "\n\n"
1471 :face variable-pitch
490a1ad6 1472 :link ("Authors"
9dba2c64 1473 ,(lambda (_button)
490a1ad6
JL
1474 (view-file (expand-file-name "AUTHORS" data-directory))
1475 (goto-char (point-min))))
1476 "\tMany people have contributed code included in GNU Emacs\n"
1477 :link ("Contributing"
9dba2c64 1478 ,(lambda (_button)
490a1ad6
JL
1479 (view-file (expand-file-name "CONTRIBUTE" data-directory))
1480 (goto-char (point-min))))
1481 "\tHow to contribute improvements to Emacs\n"
1482 "\n"
9dba2c64 1483 :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project)))
fad930b6 1484 "\tWhy we developed GNU Emacs, and the GNU operating system\n"
9dba2c64 1485 :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
fad930b6 1486 "\tGNU Emacs comes with "
422abbfd 1487 :face (variable-pitch (:slant oblique))
fad930b6
RS
1488 "ABSOLUTELY NO WARRANTY\n"
1489 :face variable-pitch
9dba2c64 1490 :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
fad930b6 1491 "\tConditions for redistributing and changing Emacs\n"
9dba2c64 1492 :link ("Getting New Versions" ,(lambda (_button) (describe-distribution)))
fad930b6 1493 "\tHow to obtain the latest version of Emacs\n"
9dba2c64 1494 :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
1cff9ad1 1495 "\tBuying printed manuals from the FSF\n"
fad930b6 1496 "\n"
9dba2c64 1497 :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
fad930b6 1498 "\tLearn basic Emacs keystroke commands"
9dba2c64 1499 ,(lambda ()
fad930b6
RS
1500 (let* ((en "TUTORIAL")
1501 (tut (or (get-language-info current-language-environment
1502 'tutorial)
1503 en))
1504 (title (with-temp-buffer
1505 (insert-file-contents
1506 (expand-file-name tut tutorial-directory)
1507 nil 0 256)
1508 (search-forward ".")
1509 (buffer-substring (point-min) (1- (point))))))
1510 ;; If there is a specific tutorial for the current language
1511 ;; environment and it is not English, append its title.
1512 (if (string= en tut)
1513 ""
1514 (concat " (" title ")"))))
1515 "\n"
1516 :link ("Emacs Guided Tour"
9dba2c64
SM
1517 ,(lambda (_button)
1518 (browse-url "http://www.gnu.org/software/emacs/tour/"))
6e0cfad3 1519 "Browse http://www.gnu.org/software/emacs/tour/")
fa7c3228 1520 "\tSee an overview of Emacs features at gnu.org"))
1d865f15
JL
1521 "A list of texts to show in the middle part of the About screen.
1522Each element in the list should be a list of strings or pairs
1523`:face FACE', like `fancy-splash-insert' accepts them.")
1524
ce9ded5d 1525
fb275c02 1526(defgroup fancy-splash-screen ()
a01bb1db 1527 "Fancy splash screen when Emacs starts."
fb275c02 1528 :version "21.1"
a01bb1db
GM
1529 :group 'initialization)
1530
8ad8561b 1531(defcustom fancy-splash-image nil
ea6c930a 1532 "The image to show in the splash screens, or nil for defaults."
a01bb1db 1533 :group 'fancy-splash-screen
8ad8561b
GM
1534 :type '(choice (const :tag "Default" nil)
1535 (file :tag "File")))
ce9ded5d
GM
1536
1537
aeb6faec 1538(defvar splash-screen-keymap
26cdce23
JL
1539 (let ((map (make-sparse-keymap)))
1540 (suppress-keymap map)
1541 (set-keymap-parent map button-buffer-map)
ce3cefcc 1542 (define-key map "\C-?" 'scroll-down-command)
958614cf 1543 (define-key map [?\S-\ ] 'scroll-down-command)
ce3cefcc 1544 (define-key map " " 'scroll-up-command)
aeb6faec 1545 (define-key map "q" 'exit-splash-screen)
26cdce23
JL
1546 map)
1547 "Keymap for splash screen buffer.")
1548
f645586f
GM
1549;; These are temporary storage areas for the splash screen display.
1550
ce9ded5d
GM
1551(defun fancy-splash-insert (&rest args)
1552 "Insert text into the current buffer, with faces.
22a58255
CY
1553Arguments from ARGS should be either strings; functions called
1554with no args that return a string; pairs `:face FACE', where FACE
1555is a face specification usable with `put-text-property'; or pairs
1556`:link LINK' where LINK is a list of arguments to pass to
6e0cfad3
JL
1557`insert-button', of the form (LABEL ACTION [HELP-ECHO]), which
1558specifies the button's label, `action' property and help-echo string.
1559FACE and LINK can also be functions, which are evaluated to obtain
1560a face or button specification."
ce9ded5d
GM
1561 (let ((current-face nil))
1562 (while args
26cdce23 1563 (cond ((eq (car args) :face)
22a58255
CY
1564 (setq args (cdr args) current-face (car args))
1565 (if (functionp current-face)
1566 (setq current-face (funcall current-face))))
26cdce23
JL
1567 ((eq (car args) :link)
1568 (setq args (cdr args))
1569 (let ((spec (car args)))
22a58255
CY
1570 (if (functionp spec)
1571 (setq spec (funcall spec)))
26cdce23
JL
1572 (insert-button (car spec)
1573 'face (list 'link current-face)
1574 'action (cadr spec)
6e0cfad3
JL
1575 'help-echo (concat "mouse-2, RET: "
1576 (or (nth 2 spec)
1577 "Follow this link"))
26cdce23
JL
1578 'follow-link t)))
1579 (t (insert (propertize (let ((it (car args)))
1580 (if (functionp it)
1581 (funcall it)
1582 it))
1583 'face current-face
d4a629de 1584 'help-echo (startup-echo-area-message)))))
ce9ded5d
GM
1585 (setq args (cdr args)))))
1586
aa360da1 1587(declare-function image-size "image.c" (spec &optional pixels frame))
ce9ded5d
GM
1588
1589(defun fancy-splash-head ()
1590 "Insert the head part of the splash screen into the current buffer."
51e8cfdd
GM
1591 (let* ((image-file (cond ((stringp fancy-splash-image)
1592 fancy-splash-image)
68548459 1593 ((display-color-p)
555b0992
JB
1594 (cond ((<= (display-planes) 8)
1595 (if (image-type-available-p 'xpm)
1596 "splash.xpm"
1597 "splash.pbm"))
a6674402
CY
1598 ((or (image-type-available-p 'svg)
1599 (image-type-available-p 'imagemagick))
68548459
JB
1600 "splash.svg")
1601 ((image-type-available-p 'png)
1602 "splash.png")
1603 ((image-type-available-p 'xpm)
555b0992
JB
1604 "splash.xpm")
1605 (t "splash.pbm")))
68548459 1606 (t "splash.pbm")))
51e8cfdd 1607 (img (create-image image-file))
ce9ded5d 1608 (image-width (and img (car (image-size img))))
290d5b58 1609 (window-width (window-width)))
ce9ded5d
GM
1610 (when img
1611 (when (> window-width image-width)
f645586f 1612 ;; Center the image in the window.
6b61353c
KH
1613 (insert (propertize " " 'display
1614 `(space :align-to (+ center (-0.5 . ,img)))))
f645586f 1615
e7f3afa9
MB
1616 ;; Change the color of the XPM version of the splash image
1617 ;; so that it is visible with a dark frame background.
1618 (when (and (memq 'xpm img)
1619 (eq (frame-parameter nil 'background-mode) 'dark))
1620 (setq img (append img '(:color-symbols (("#000000" . "gray30"))))))
1621
aeb6faec
JL
1622 ;; Insert the image with a help-echo and a link.
1623 (make-button (prog1 (point) (insert-image img)) (point)
1624 'face 'default
6e0cfad3 1625 'help-echo "mouse-2, RET: Browse http://www.gnu.org/"
06788a55 1626 'action (lambda (_button) (browse-url "http://www.gnu.org/"))
aeb6faec 1627 'follow-link t)
22a58255
CY
1628 (insert "\n\n")))))
1629
1cff9ad1 1630(defun fancy-startup-tail (&optional concise)
ce9ded5d 1631 "Insert the tail part of the splash screen into the current buffer."
fa7c3228 1632 (unless concise
bb398779 1633 (fancy-splash-insert
fa7c3228
CY
1634 :face 'variable-pitch
1635 "\nTo start... "
1636 :link `("Open a File"
1637 ,(lambda (_button) (call-interactively 'find-file))
1638 "Specify a new file's name, to edit the file")
1639 " "
1640 :link `("Open Home Directory"
1641 ,(lambda (_button) (dired "~"))
1642 "Open your home directory, to operate on its files")
1643 " "
1644 :link `("Customize Startup"
1645 ,(lambda (_button) (customize-group 'initialization))
1646 "Change initialization settings including this screen")
1647 "\n"))
1648 (fancy-splash-insert
1649 :face 'variable-pitch "To quit a partially entered command, type "
1650 :face 'default "Control-g"
1651 :face 'variable-pitch ".\n")
1652 (fancy-splash-insert :face `(variable-pitch font-lock-builtin-face)
1653 "\nThis is "
1654 (emacs-version)
1655 "\n"
1656 :face '(variable-pitch (:height 0.8))
1657 emacs-copyright
1658 "\n")
c01bf73e
CY
1659 (when auto-save-list-file-prefix
1660 (let ((dir (file-name-directory auto-save-list-file-prefix))
1661 (name (file-name-nondirectory auto-save-list-file-prefix))
1662 files)
1663 ;; Don't warn if the directory for auto-save-list files does not
1664 ;; yet exist.
1665 (and (file-directory-p dir)
1666 (setq files (directory-files dir nil (concat "\\`" name) t))
1667 (fancy-splash-insert :face '(variable-pitch font-lock-comment-face)
1668 (if (= (length files) 1)
1669 "\nAn auto-save file list was found. "
1670 "\nAuto-save file lists were found. ")
1671 "If an Emacs session crashed recently,\ntype "
f0b6ae63
KS
1672 :link `("M-x recover-session RET"
1673 ,(lambda (_button)
1674 (call-interactively
1675 'recover-session)))
c01bf73e 1676 " to recover the files you were editing."))))
fa7c3228
CY
1677
1678 (when concise
1679 (fancy-splash-insert
1680 :face 'variable-pitch "\n"
1681 :link `("Dismiss this startup screen"
1682 ,(lambda (_button)
1683 (when startup-screen-inhibit-startup-screen
1684 (customize-set-variable 'inhibit-startup-screen t)
1685 (customize-mark-to-save 'inhibit-startup-screen)
1686 (custom-save-all))
1687 (let ((w (get-buffer-window "*GNU Emacs*")))
1688 (and w (not (one-window-p)) (delete-window w)))
1689 (kill-buffer "*GNU Emacs*")))
1690 " ")
1691 (when (or user-init-file custom-file)
1692 (let ((checked (create-image "checked.xpm"
1693 nil nil :ascent 'center))
1694 (unchecked (create-image "unchecked.xpm"
1695 nil nil :ascent 'center)))
1696 (insert-button
1697 " "
1698 :on-glyph checked
1699 :off-glyph unchecked
1700 'checked nil 'display unchecked 'follow-link t
1701 'action (lambda (button)
1702 (if (overlay-get button 'checked)
1703 (progn (overlay-put button 'checked nil)
1704 (overlay-put button 'display
1705 (overlay-get button :off-glyph))
1706 (setq startup-screen-inhibit-startup-screen
1707 nil))
1708 (overlay-put button 'checked t)
1709 (overlay-put button 'display
1710 (overlay-get button :on-glyph))
1711 (setq startup-screen-inhibit-startup-screen t)))))
1712 (fancy-splash-insert :face '(variable-pitch (:height 0.9))
1713 " Never show it again."))))
f645586f 1714
aeb6faec 1715(defun exit-splash-screen ()
26cdce23 1716 "Stop displaying the splash screen buffer."
f645586f 1717 (interactive)
1d865f15
JL
1718 (quit-window t))
1719
1cff9ad1 1720(defun fancy-startup-screen (&optional concise)
22a58255 1721 "Display fancy startup screen.
1cff9ad1
JL
1722If CONCISE is non-nil, display a concise version of the
1723splash screen in another window."
3d9d55e6 1724 (let ((splash-buffer (get-buffer-create "*GNU Emacs*")))
09723615 1725 (with-current-buffer splash-buffer
3d9d55e6
CY
1726 (let ((inhibit-read-only t))
1727 (erase-buffer)
4222d0a4 1728 (setq default-directory command-line-default-directory)
3d9d55e6
CY
1729 (make-local-variable 'startup-screen-inhibit-startup-screen)
1730 (if pure-space-overflow
1731 (insert pure-space-overflow-message))
1732 (unless concise
1733 (fancy-splash-head))
1734 (dolist (text fancy-startup-text)
1735 (apply #'fancy-splash-insert text)
1736 (insert "\n"))
1737 (skip-chars-backward "\n")
1738 (delete-region (point) (point-max))
1739 (insert "\n")
1740 (fancy-startup-tail concise))
1741 (use-local-map splash-screen-keymap)
1742 (setq tab-width 22
1743 buffer-read-only t)
1744 (set-buffer-modified-p nil)
1745 (if (and view-read-only (not view-mode))
1746 (view-mode-enter nil 'kill-buffer))
09723615
JL
1747 (goto-char (point-min))
1748 (forward-line (if concise 2 4)))
3d9d55e6
CY
1749 (if concise
1750 (progn
1751 (display-buffer splash-buffer)
1752 ;; If the splash screen is in a split window, fit it.
1753 (let ((window (get-buffer-window splash-buffer t)))
1754 (or (null window)
1755 (eq window (selected-window))
1756 (eq window (next-window window))
1757 (fit-window-to-buffer window))))
1758 (switch-to-buffer splash-buffer))))
22a58255
CY
1759
1760(defun fancy-about-screen ()
1761 "Display fancy About screen."
1762 (let ((frame (fancy-splash-frame)))
1763 (save-selected-window
1764 (select-frame frame)
1765 (switch-to-buffer "*About GNU Emacs*")
6a639b16 1766 (setq buffer-undo-list t)
22a58255
CY
1767 (let ((inhibit-read-only t))
1768 (erase-buffer)
1769 (if pure-space-overflow
1770 (insert pure-space-overflow-message))
1771 (fancy-splash-head)
1772 (dolist (text fancy-about-text)
1773 (apply #'fancy-splash-insert text)
1774 (insert "\n"))
22a58255
CY
1775 (set-buffer-modified-p nil)
1776 (goto-char (point-min))
1777 (force-mode-line-update))
aeb6faec 1778 (use-local-map splash-screen-keymap)
cb3fe757 1779 (setq tab-width 22)
08326816 1780 (setq buffer-read-only t)
09723615
JL
1781 (goto-char (point-min))
1782 (forward-line 3))))
6b20fb8e
RS
1783
1784(defun fancy-splash-frame ()
1785 "Return the frame to use for the fancy splash screen.
1786Returning non-nil does not mean we should necessarily
1787use the fancy splash screen, but if we do use it,
1788we put it on this frame."
1789 (let (chosen-frame)
0a8e1269
EZ
1790 ;; MS-Windows needs this to have a chance to make the initial
1791 ;; frame visible.
1792 (if (eq system-type 'windows-nt)
1793 (sit-for 0 t))
3a321ddb 1794 (dolist (frame (append (frame-list) (list (selected-frame))))
6b20fb8e
RS
1795 (if (and (frame-visible-p frame)
1796 (not (window-minibuffer-p (frame-selected-window frame))))
1797 (setq chosen-frame frame)))
1798 chosen-frame))
f645586f 1799
285991dc
GM
1800(defun use-fancy-splash-screens-p ()
1801 "Return t if fancy splash screens should be used."
6b61353c
KH
1802 (when (and (display-graphic-p)
1803 (or (and (display-color-p)
0a8e1269 1804 (image-type-available-p 'xpm))
6b61353c 1805 (image-type-available-p 'pbm)))
16d2fae9
JPW
1806 (let ((frame (fancy-splash-frame)))
1807 (when frame
1808 (let* ((img (create-image (or fancy-splash-image
1809 (if (and (display-color-p)
1810 (image-type-available-p 'xpm))
1811 "splash.xpm" "splash.pbm"))))
a68ccb40
RS
1812 (image-height (and img (cdr (image-size img nil frame))))
1813 ;; We test frame-height so that, if the frame is split
1814 ;; by displaying a warning, that doesn't cause the normal
1815 ;; splash screen to be used.
1816 (frame-height (1- (frame-height frame))))
1817 (> frame-height (+ image-height 19)))))))
285991dc
GM
1818
1819
79b1c79c 1820(defun normal-splash-screen (&optional startup concise)
1d865f15
JL
1821 "Display non-graphic splash screen.
1822If optional argument STARTUP is non-nil, display the startup screen
79b1c79c
JL
1823after Emacs starts. If STARTUP is nil, display the About screen.
1824If CONCISE is non-nil, display a concise version of the
1825splash screen in another window."
1826 (let ((splash-buffer (get-buffer-create "*About GNU Emacs*")))
1827 (with-current-buffer splash-buffer
1d865f15
JL
1828 (setq buffer-read-only nil)
1829 (erase-buffer)
4222d0a4 1830 (setq default-directory command-line-default-directory)
1d865f15 1831 (set (make-local-variable 'tab-width) 8)
1d865f15
JL
1832
1833 (if pure-space-overflow
22a58255 1834 (insert pure-space-overflow-message))
260a5020 1835
1d865f15
JL
1836 ;; The convention for this piece of code is that
1837 ;; each piece of output starts with one or two newlines
1838 ;; and does not end with any newlines.
22a58255 1839 (insert (if startup "Welcome to GNU Emacs" "This is GNU Emacs"))
1d865f15
JL
1840 (insert
1841 (if (eq system-type 'gnu/linux)
1842 ", one component of the GNU/Linux operating system.\n"
1843 ", a part of the GNU operating system.\n"))
1844
1845 (if startup
1846 (if (display-mouse-p)
1847 ;; The user can use the mouse to activate menus
1848 ;; so give help in terms of menu items.
fad930b6 1849 (normal-mouse-startup-screen)
c61453ea 1850
e349ae3b 1851 ;; No mouse menus, so give help using kbd commands.
fad930b6 1852 (normal-no-mouse-startup-screen))
e349ae3b 1853
fad930b6 1854 (normal-about-screen))
1d865f15
JL
1855
1856 ;; The rest of the startup screen is the same on all
1857 ;; kinds of terminals.
1858
1859 ;; Give information on recovering, if there was a crash.
1860 (and startup
1861 auto-save-list-file-prefix
1862 ;; Don't signal an error if the
1863 ;; directory for auto-save-list files
1864 ;; does not yet exist.
1865 (file-directory-p (file-name-directory
1866 auto-save-list-file-prefix))
1867 (directory-files
1868 (file-name-directory auto-save-list-file-prefix)
1869 nil
1870 (concat "\\`"
1871 (regexp-quote (file-name-nondirectory
1872 auto-save-list-file-prefix)))
1873 t)
1874 (insert "\n\nIf an Emacs session crashed recently, "
1875 "type Meta-x recover-session RET\nto recover"
1876 " the files you were editing.\n"))
26cdce23 1877
1d865f15 1878 (use-local-map splash-screen-keymap)
e349ae3b 1879
1d865f15
JL
1880 ;; Display the input that we set up in the buffer.
1881 (set-buffer-modified-p nil)
1882 (setq buffer-read-only t)
1883 (if (and view-read-only (not view-mode))
1884 (view-mode-enter nil 'kill-buffer))
1d865f15 1885 (if startup (rename-buffer "*GNU Emacs*" t))
79b1c79c
JL
1886 (goto-char (point-min)))
1887 (if concise
1888 (display-buffer splash-buffer)
1889 (switch-to-buffer splash-buffer))))
82e736c1 1890
fad930b6
RS
1891(defun normal-mouse-startup-screen ()
1892 ;; The user can use the mouse to activate menus
1893 ;; so give help in terms of menu items.
1894 (insert "\
09723615 1895To follow a link, click Mouse-1 on it, or move to it and type RET.
26cdce23
JL
1896To quit a partially entered command, type Control-g.\n")
1897
fad930b6
RS
1898 (insert "\nImportant Help menu items:\n")
1899 (insert-button "Emacs Tutorial"
06788a55 1900 'action (lambda (_button) (help-with-tutorial))
fad930b6
RS
1901 'follow-link t)
1902 (insert "\t\tLearn basic Emacs keystroke commands\n")
1903 (insert-button "Read the Emacs Manual"
06788a55 1904 'action (lambda (_button) (info-emacs-manual))
fad930b6
RS
1905 'follow-link t)
1906 (insert "\tView the Emacs manual using Info\n")
1907 (insert-button "\(Non)Warranty"
06788a55 1908 'action (lambda (_button) (describe-no-warranty))
fad930b6
RS
1909 'follow-link t)
1910 (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
1911 (insert-button "Copying Conditions"
06788a55 1912 'action (lambda (_button) (describe-copying))
fad930b6
RS
1913 'follow-link t)
1914 (insert "\tConditions for redistributing and changing Emacs\n")
1915 (insert-button "More Manuals / Ordering Manuals"
06788a55 1916 'action (lambda (_button) (view-order-manuals))
fad930b6
RS
1917 'follow-link t)
1918 (insert " How to order printed manuals from the FSF\n")
1919
1920 (insert "\nUseful tasks:\n")
1921 (insert-button "Visit New File"
06788a55 1922 'action (lambda (_button) (call-interactively 'find-file))
fad930b6
RS
1923 'follow-link t)
1924 (insert "\t\tSpecify a new file's name, to edit the file\n")
1925 (insert-button "Open Home Directory"
06788a55 1926 'action (lambda (_button) (dired "~"))
fad930b6
RS
1927 'follow-link t)
1928 (insert "\tOpen your home directory, to operate on its files\n")
1929 (insert-button "Customize Startup"
06788a55 1930 'action (lambda (_button) (customize-group 'initialization))
fad930b6
RS
1931 'follow-link t)
1932 (insert "\tChange initialization settings including this screen\n")
1933
1934 (insert "\n" (emacs-version)
1935 "\n" emacs-copyright))
1936
fad930b6 1937(defun normal-no-mouse-startup-screen ()
b46a056e 1938 "Show a splash screen suitable for displays without mouse support."
2aa0e5bf
SM
1939 (let* ((c-h-accessible
1940 ;; If normal-erase-is-backspace is used on a tty, there's
1941 ;; no way to invoke C-h and you have to use F1 instead.
1942 (or (not (char-table-p keyboard-translate-table))
1943 (eq (aref keyboard-translate-table ?\C-h) ?\C-h)))
1944 (minor-mode-overriding-map-alist
1945 (cons (cons (not c-h-accessible)
1946 ;; If C-h can't be invoked, temporarily disable its
1947 ;; binding, so where-is uses alternative bindings.
1948 (let ((map (make-sparse-keymap)))
1949 (define-key map [?\C-h] 'undefined)
1950 map))
1951 minor-mode-overriding-map-alist)))
1952
1953 (insert (format "\nGet help\t %s\n"
1954 (let ((where (where-is-internal 'help-command nil t)))
1955 (cond
1956 ((equal where [?\C-h])
1957 "C-h (Hold down CTRL and press h)")
1958 (where (key-description where))
1959 (t "M-x help")))))
1960 (insert-button "Emacs manual"
06788a55 1961 'action (lambda (_button) (info-emacs-manual))
2aa0e5bf
SM
1962 'follow-link t)
1963 (insert (substitute-command-keys"\t \\[info-emacs-manual]\t"))
1964 (insert-button "Browse manuals"
06788a55 1965 'action (lambda (_button) (Info-directory))
2aa0e5bf
SM
1966 'follow-link t)
1967 (insert (substitute-command-keys "\t \\[info]\n"))
1968 (insert-button "Emacs tutorial"
06788a55 1969 'action (lambda (_button) (help-with-tutorial))
2aa0e5bf
SM
1970 'follow-link t)
1971 (insert (substitute-command-keys
8cb95edf 1972 "\t \\[help-with-tutorial]\tUndo changes\t \\[undo]\n"))
2aa0e5bf 1973 (insert-button "Buy manuals"
06788a55 1974 'action (lambda (_button) (view-order-manuals))
2aa0e5bf
SM
1975 'follow-link t)
1976 (insert (substitute-command-keys
1977 "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-terminal]")))
fad930b6
RS
1978
1979 ;; Say how to use the menu bar with the keyboard.
1980 (insert "\n")
1981 (insert-button "Activate menubar"
06788a55 1982 'action (lambda (_button) (tmm-menubar))
fad930b6
RS
1983 'follow-link t)
1984 (if (and (eq (key-binding "\M-`") 'tmm-menubar)
1985 (eq (key-binding [f10]) 'tmm-menubar))
1986 (insert " F10 or ESC ` or M-`")
1987 (insert (substitute-command-keys " \\[tmm-menubar]")))
1988
1989 ;; Many users seem to have problems with these.
1990 (insert "
c61453ea
PJ
1991\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
1992If you have no Meta key, you may instead type ESC followed by the character.)")
1993
fad930b6
RS
1994 ;; Insert links to useful tasks
1995 (insert "\nUseful tasks:\n")
1996
1997 (insert-button "Visit New File"
06788a55 1998 'action (lambda (_button) (call-interactively 'find-file))
fad930b6
RS
1999 'follow-link t)
2000 (insert "\t\t\t")
2001 (insert-button "Open Home Directory"
06788a55 2002 'action (lambda (_button) (dired "~"))
fad930b6
RS
2003 'follow-link t)
2004 (insert "\n")
2005
2006 (insert-button "Customize Startup"
06788a55 2007 'action (lambda (_button) (customize-group 'initialization))
fad930b6
RS
2008 'follow-link t)
2009 (insert "\t\t")
2010 (insert-button "Open *scratch* buffer"
06788a55
SM
2011 'action (lambda (_button) (switch-to-buffer
2012 (get-buffer-create "*scratch*")))
fad930b6
RS
2013 'follow-link t)
2014 (insert "\n")
2015 (insert "\n" (emacs-version) "\n" emacs-copyright "\n")
b46a056e
GM
2016 (insert (substitute-command-keys
2017 "
cd6ab24f 2018GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
b46a056e
GM
2019 (insert-button "full details"
2020 'action (lambda (_button) (describe-no-warranty))
2021 'follow-link t)
2022 (insert (substitute-command-keys ".
c61453ea 2023Emacs is Free Software--Free as in Freedom--so you can redistribute copies
cd6ab24f 2024of Emacs and modify it; type \\[describe-copying] to see "))
b46a056e
GM
2025 (insert-button "the conditions"
2026 'action (lambda (_button) (describe-copying))
2027 'follow-link t)
2028 (insert (substitute-command-keys".
cd6ab24f 2029Type \\[describe-distribution] for information on "))
b46a056e
GM
2030 (insert-button "getting the latest version"
2031 'action (lambda (_button) (describe-distribution))
2032 'follow-link t)
2033 (insert "."))
fad930b6
RS
2034
2035(defun normal-about-screen ()
2036 (insert "\n" (emacs-version) "\n" emacs-copyright "\n\n")
2037
2038 (insert "To follow a link, click Mouse-1 on it, or move to it and type RET.\n\n")
2039
490a1ad6
JL
2040 (insert-button "Authors"
2041 'action
06788a55 2042 (lambda (_button)
490a1ad6
JL
2043 (view-file (expand-file-name "AUTHORS" data-directory))
2044 (goto-char (point-min)))
2045 'follow-link t)
2046 (insert "\t\tMany people have contributed code included in GNU Emacs\n")
2047
2048 (insert-button "Contributing"
2049 'action
06788a55 2050 (lambda (_button)
490a1ad6
JL
2051 (view-file (expand-file-name "CONTRIBUTE" data-directory))
2052 (goto-char (point-min)))
2053 'follow-link t)
2054 (insert "\tHow to contribute improvements to Emacs\n\n")
2055
fad930b6 2056 (insert-button "GNU and Freedom"
06788a55 2057 'action (lambda (_button) (describe-gnu-project))
fad930b6
RS
2058 'follow-link t)
2059 (insert "\t\tWhy we developed GNU Emacs and the GNU system\n")
2060
2061 (insert-button "Absence of Warranty"
06788a55 2062 'action (lambda (_button) (describe-no-warranty))
fad930b6
RS
2063 'follow-link t)
2064 (insert "\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
2065
2066 (insert-button "Copying Conditions"
06788a55 2067 'action (lambda (_button) (describe-copying))
fad930b6
RS
2068 'follow-link t)
2069 (insert "\tConditions for redistributing and changing Emacs\n")
2070
2071 (insert-button "Getting New Versions"
06788a55 2072 'action (lambda (_button) (describe-distribution))
fad930b6
RS
2073 'follow-link t)
2074 (insert "\tHow to get the latest version of GNU Emacs\n")
2075
2076 (insert-button "More Manuals / Ordering Manuals"
06788a55 2077 'action (lambda (_button) (view-order-manuals))
fad930b6
RS
2078 'follow-link t)
2079 (insert "\tBuying printed manuals from the FSF\n"))
c61453ea 2080
2230fa5b 2081(defun startup-echo-area-message ()
b46a056e
GM
2082 (if (daemonp)
2083 "Starting Emacs daemon."
2084 (substitute-command-keys
2085 "For information about GNU Emacs and the GNU system, type \
2086\\[about-emacs].")))
ce9ded5d 2087
49939379 2088(defun display-startup-echo-area-message ()
15fa6db0 2089 (let ((resize-mini-windows t))
8dabbfd6 2090 (or noninteractive ;(input-pending-p) init-file-had-error
f1be5774
KL
2091 ;; t if the init file says to inhibit the echo area startup message.
2092 (and inhibit-startup-echo-area-message
2093 user-init-file
2094 (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
2095 (equal inhibit-startup-echo-area-message
2096 (if (equal init-file-user "")
2097 (user-login-name)
2098 init-file-user)))
2099 ;; Wasn't set with custom; see if .emacs has a setq.
8dabbfd6
SM
2100 (condition-case nil
2101 (with-temp-buffer
2102 (insert-file-contents user-init-file)
2103 (re-search-forward
2104 (concat
2105 "([ \t\n]*setq[ \t\n]+"
2106 "inhibit-startup-echo-area-message[ \t\n]+"
2107 (regexp-quote
2108 (prin1-to-string
2109 (if (equal init-file-user "")
2110 (user-login-name)
2111 init-file-user)))
2112 "[ \t\n]*)")
2113 nil t))
2114 (error nil))))
1d865f15 2115 (message "%s" (startup-echo-area-message)))))
f645586f 2116
1cff9ad1 2117(defun display-startup-screen (&optional concise)
22a58255
CY
2118 "Display startup screen according to display.
2119A fancy display is used on graphic displays, normal otherwise.
49939379 2120
22a58255
CY
2121If CONCISE is non-nil, display a concise version of the startup
2122screen."
526039df 2123 ;; Prevent recursive calls from server-process-filter.
1cff9ad1 2124 (if (not (get-buffer "*GNU Emacs*"))
526039df 2125 (if (use-fancy-splash-screens-p)
22a58255 2126 (fancy-startup-screen concise)
79b1c79c 2127 (normal-splash-screen t concise))))
22a58255
CY
2128
2129(defun display-about-screen ()
2130 "Display the *About GNU Emacs* buffer.
2131A fancy display is used on graphic displays, normal otherwise."
2132 (interactive)
6b61353c 2133 (if (use-fancy-splash-screens-p)
1cff9ad1
JL
2134 (fancy-about-screen)
2135 (normal-splash-screen nil)))
c61453ea 2136
22a58255 2137(defalias 'about-emacs 'display-about-screen)
1cff9ad1 2138(defalias 'display-splash-screen 'display-startup-screen)
c61453ea 2139
06788a55 2140(defun command-line-1 (args-left)
33da7b16 2141 "A subroutine of `command-line'."
f1be5774 2142 (display-startup-echo-area-message)
cb58ea33
RS
2143 (when (and pure-space-overflow
2144 (not noninteractive))
2145 (display-warning
2146 'initialization
f2602864
CY
2147 "Building Emacs overflowed pure space.\
2148 (See the node Pure Storage in the Lisp manual for details.)"
cb58ea33
RS
2149 :warning))
2150
22a58255 2151 (let ((file-count 0)
06788a55 2152 (command-line-args-left args-left)
22a58255
CY
2153 first-file-buffer)
2154 (when command-line-args-left
2155 ;; We have command args; process them.
06788a55
SM
2156 (let ((dir command-line-default-directory)
2157 tem
22a58255
CY
2158 ;; This approach loses for "-batch -L DIR --eval "(require foo)",
2159 ;; if foo is intended to be found in DIR.
2160 ;;
5ba08a2e
GM
2161 ;; The directories listed in --directory/-L options will *appear*
2162 ;; at the front of `load-path' in the order they appear on the
2163 ;; command-line. We cannot do this by *placing* them at the front
2164 ;; in the order they appear, so we need this variable to hold them,
2165 ;; temporarily.
22a58255
CY
2166 ;;
2167 ;; To DTRT we keep track of the splice point and modify `load-path'
2168 ;; straight away upon any --directory/-L option.
2169 splice
2170 just-files ;; t if this follows the magic -- option.
2171 ;; This includes our standard options' long versions
2172 ;; and long versions of what's on command-switch-alist.
2173 (longopts
2aa0e5bf
SM
2174 (append '("--funcall" "--load" "--insert" "--kill"
2175 "--directory" "--eval" "--execute" "--no-splash"
2176 "--find-file" "--visit" "--file" "--no-desktop")
2177 (mapcar (lambda (elt) (concat "-" (car elt)))
22a58255 2178 command-switch-alist)))
06788a55
SM
2179 (line 0)
2180 (column 0))
22a58255
CY
2181
2182 ;; Add the long X options to longopts.
4f6cc6b5
GM
2183 (dolist (tem command-line-x-option-alist)
2184 (if (string-match "^--" (car tem))
2185 (push (car tem) longopts)))
22a58255 2186
122e9f8f 2187 ;; Add the long NS options to longopts.
4f6cc6b5
GM
2188 (dolist (tem command-line-ns-option-alist)
2189 (if (string-match "^--" (car tem))
2190 (push (list (car tem)) longopts)))
edfda783 2191
22a58255
CY
2192 ;; Loop, processing options.
2193 (while command-line-args-left
2194 (let* ((argi (car command-line-args-left))
2195 (orig-argi argi)
2196 argval completion)
2197 (setq command-line-args-left (cdr command-line-args-left))
2198
2199 ;; Do preliminary decoding of the option.
2200 (if just-files
2201 ;; After --, don't look for options; treat all args as files.
2202 (setq argi "")
2203 ;; Convert long options to ordinary options
2204 ;; and separate out an attached option argument into argval.
7b704afe 2205 (when (string-match "\\`\\(--[^=]*\\)=" argi)
22a58255
CY
2206 (setq argval (substring argi (match-end 0))
2207 argi (match-string 1 argi)))
ce3a988d 2208 (when (string-match "\\`--?[^-]" orig-argi)
7b704afe
AS
2209 (setq completion (try-completion argi longopts))
2210 (if (eq completion t)
2211 (setq argi (substring argi 1))
2212 (if (stringp completion)
2aa0e5bf 2213 (let ((elt (member completion longopts)))
7b704afe
AS
2214 (or elt
2215 (error "Option `%s' is ambiguous" argi))
2216 (setq argi (substring (car elt) 1)))
2217 (setq argval nil
2218 argi orig-argi)))))
22a58255
CY
2219
2220 ;; Execute the option.
06788a55 2221 (cond ((setq tem (assoc argi command-switch-alist))
22a58255
CY
2222 (if argval
2223 (let ((command-line-args-left
2224 (cons argval command-line-args-left)))
06788a55
SM
2225 (funcall (cdr tem) argi))
2226 (funcall (cdr tem) argi)))
22a58255
CY
2227
2228 ((equal argi "-no-splash")
1cff9ad1 2229 (setq inhibit-startup-screen t))
22a58255
CY
2230
2231 ((member argi '("-f" ; what the manual claims
2232 "-funcall"
2233 "-e")) ; what the source used to say
1cff9ad1 2234 (setq inhibit-startup-screen t)
06788a55
SM
2235 (setq tem (intern (or argval (pop command-line-args-left))))
2236 (if (commandp tem)
2237 (command-execute tem)
2238 (funcall tem)))
22a58255
CY
2239
2240 ((member argi '("-eval" "-execute"))
1cff9ad1 2241 (setq inhibit-startup-screen t)
22a58255
CY
2242 (eval (read (or argval (pop command-line-args-left)))))
2243
2244 ((member argi '("-L" "-directory"))
a0833f62
GM
2245 ;; -L :/foo adds /foo to the _end_ of load-path.
2246 (let (append)
2247 (if (string-match-p
2df10228 2248 (format "\\`%s" path-separator)
a0833f62
GM
2249 (setq tem (or argval (pop command-line-args-left))))
2250 (setq tem (substring tem 1)
2251 append t))
2252 (setq tem (expand-file-name
2253 (command-line-normalize-file-name tem)))
2254 (cond (append (setq load-path
2255 (append load-path (list tem)))
2256 (if splice (setq splice load-path)))
2257 (splice (setcdr splice (cons tem (cdr splice)))
2258 (setq splice (cdr splice)))
2259 (t (setq load-path (cons tem load-path)
2260 splice load-path)))))
22a58255
CY
2261
2262 ((member argi '("-l" "-load"))
2263 (let* ((file (command-line-normalize-file-name
2264 (or argval (pop command-line-args-left))))
2265 ;; Take file from default dir if it exists there;
2266 ;; otherwise let `load' search for it.
2267 (file-ex (expand-file-name file)))
2268 (when (file-exists-p file-ex)
2269 (setq file file-ex))
2270 (load file nil t)))
2271
2272 ;; This is used to handle -script. It's not clear
f71d844b 2273 ;; we need to document it (it is totally internal).
1d1100d7 2274 ((member argi '("-scriptload"))
22a58255
CY
2275 (let* ((file (command-line-normalize-file-name
2276 (or argval (pop command-line-args-left))))
2277 ;; Take file from default dir.
2278 (file-ex (expand-file-name file)))
2279 (load file-ex nil t t)))
2280
2281 ((equal argi "-insert")
1cff9ad1 2282 (setq inhibit-startup-screen t)
06788a55
SM
2283 (setq tem (or argval (pop command-line-args-left)))
2284 (or (stringp tem)
22a58255 2285 (error "File name omitted from `-insert' option"))
06788a55 2286 (insert-file-contents (command-line-normalize-file-name tem)))
22a58255
CY
2287
2288 ((equal argi "-kill")
2289 (kill-emacs t))
2290
2291 ;; This is for when they use --no-desktop with -q, or
2292 ;; don't load Desktop in their .emacs. If desktop.el
2293 ;; _is_ loaded, it will handle this switch, and we
2294 ;; won't see it by the time we get here.
2295 ((equal argi "-no-desktop")
2296 (message "\"--no-desktop\" ignored because the Desktop package is not loaded"))
2297
2298 ((string-match "^\\+[0-9]+\\'" argi)
06788a55 2299 (setq line (string-to-number argi)))
22a58255
CY
2300
2301 ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
06788a55
SM
2302 (setq line (string-to-number (match-string 1 argi))
2303 column (string-to-number (match-string 2 argi))))
22a58255 2304
06788a55 2305 ((setq tem (assoc orig-argi command-line-x-option-alist))
22a58255
CY
2306 ;; Ignore X-windows options and their args if not using X.
2307 (setq command-line-args-left
06788a55 2308 (nthcdr (nth 1 tem) command-line-args-left)))
22a58255 2309
06788a55 2310 ((setq tem (assoc orig-argi command-line-ns-option-alist))
3000e3f4
DN
2311 ;; Ignore NS-windows options and their args if not using NS.
2312 (setq command-line-args-left
06788a55 2313 (nthcdr (nth 1 tem) command-line-args-left)))
edfda783 2314
22a58255 2315 ((member argi '("-find-file" "-file" "-visit"))
1cff9ad1 2316 (setq inhibit-startup-screen t)
22a58255 2317 ;; An explicit option to specify visiting a file.
06788a55
SM
2318 (setq tem (or argval (pop command-line-args-left)))
2319 (unless (stringp tem)
22a58255
CY
2320 (error "File name omitted from `%s' option" argi))
2321 (setq file-count (1+ file-count))
2322 (let ((file (expand-file-name
06788a55
SM
2323 (command-line-normalize-file-name tem)
2324 dir)))
22a58255
CY
2325 (if (= file-count 1)
2326 (setq first-file-buffer (find-file file))
2327 (find-file-other-window file)))
06788a55 2328 (unless (zerop line)
e6ce8c42 2329 (goto-char (point-min))
06788a55
SM
2330 (forward-line (1- line)))
2331 (setq line 0)
2332 (unless (< column 1)
2333 (move-to-column (1- column)))
2334 (setq column 0))
22a58255 2335
198a7a97
CY
2336 ;; These command lines now have no effect.
2337 ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi)
2338 (display-warning 'initialization
2339 (format "Ignoring obsolete arg %s" argi)))
2340
22a58255
CY
2341 ((equal argi "--")
2342 (setq just-files t))
2343 (t
2344 ;; We have almost exhausted our options. See if the
2345 ;; user has made any other command-line options available
2346 (let ((hooks command-line-functions)
2347 (did-hook nil))
2348 (while (and hooks
2349 (not (setq did-hook (funcall (car hooks)))))
2350 (setq hooks (cdr hooks)))
2351 (if (not did-hook)
2352 ;; Presume that the argument is a file name.
2353 (progn
2354 (if (string-match "\\`-" argi)
2355 (error "Unknown option `%s'" argi))
1cff9ad1
JL
2356 (unless initial-window-system
2357 (setq inhibit-startup-screen t))
22a58255
CY
2358 (setq file-count (1+ file-count))
2359 (let ((file
2360 (expand-file-name
2361 (command-line-normalize-file-name orig-argi)
06788a55 2362 dir)))
3d9d55e6
CY
2363 (cond ((= file-count 1)
2364 (setq first-file-buffer (find-file file)))
2365 (inhibit-startup-screen
2366 (find-file-other-window file))
2367 (t (find-file file))))
06788a55 2368 (unless (zerop line)
e6ce8c42 2369 (goto-char (point-min))
06788a55
SM
2370 (forward-line (1- line)))
2371 (setq line 0)
2372 (unless (< column 1)
2373 (move-to-column (1- column)))
2374 (setq column 0))))))
22a58255
CY
2375 ;; In unusual circumstances, the execution of Lisp code due
2376 ;; to command-line options can cause the last visible frame
2377 ;; to be deleted. In this case, kill emacs to avoid an
2378 ;; abort later.
2379 (unless (frame-live-p (selected-frame)) (kill-emacs nil))))))
2380
199e4c7e
MR
2381 (when (eq initial-buffer-choice t)
2382 ;; When initial-buffer-choice equals t make sure that *scratch*
2383 ;; exists.
2384 (get-buffer-create "*scratch*"))
22a58255 2385
8d86c6da 2386 ;; If *scratch* exists and is empty, insert initial-scratch-message.
199e4c7e 2387 ;; Do this before switching to *scratch* below to handle bug#9605.
8d86c6da
JL
2388 (and initial-scratch-message
2389 (get-buffer "*scratch*")
2390 (with-current-buffer "*scratch*"
2391 (when (zerop (buffer-size))
199e4c7e 2392 (insert initial-scratch-message)
8d86c6da
JL
2393 (set-buffer-modified-p nil))))
2394
199e4c7e 2395 (when initial-buffer-choice
dc646358
CK
2396 (let ((buf
2397 (cond ((stringp initial-buffer-choice)
2398 (find-file-noselect initial-buffer-choice))
2399 ((functionp initial-buffer-choice)
2400 (funcall initial-buffer-choice)))))
2401 (switch-to-buffer
2402 (if (buffer-live-p buf) buf (get-buffer-create "*scratch*"))
2403 'norecord)))
199e4c7e 2404
1cff9ad1 2405 (if (or inhibit-startup-screen
22a58255
CY
2406 initial-buffer-choice
2407 noninteractive
ede141ac 2408 (daemonp)
8686ac71 2409 inhibit-x-resources)
22a58255
CY
2410
2411 ;; Not displaying a startup screen. If 3 or more files
2412 ;; visited, and not all visible, show user what they all are.
2413 (and (> file-count 2)
2414 (not noninteractive)
2415 (not inhibit-startup-buffer-menu)
2416 (or (get-buffer-window first-file-buffer)
2417 (list-buffers)))
2418
2419 ;; Display a startup screen, after some preparations.
2420
2421 ;; If there are no switches to process, we might as well
2422 ;; run this hook now, and there may be some need to do it
2423 ;; before doing any output.
2424 (run-hooks 'emacs-startup-hook)
2425 (and term-setup-hook
2426 (run-hooks 'term-setup-hook))
2427 (setq inhibit-startup-hooks t)
2428
2429 ;; It's important to notice the user settings before we
2430 ;; display the startup message; otherwise, the settings
2431 ;; won't take effect until the user gives the first
2432 ;; keystroke, and that's distracting.
2433 (when (fboundp 'frame-notice-user-settings)
2434 (frame-notice-user-settings))
2435
2436 ;; If there are no switches to process, we might as well
2437 ;; run this hook now, and there may be some need to do it
2438 ;; before doing any output.
2439 (when window-setup-hook
2440 (run-hooks 'window-setup-hook)
2441 ;; Don't let the hook be run twice.
2442 (setq window-setup-hook nil))
2443
04ef2618
CY
2444 ;; ;; Do this now to avoid an annoying delay if the user
2445 ;; ;; clicks the menu bar during the sit-for.
2446 ;; (when (display-popup-menus-p)
2447 ;; (precompute-menubar-bindings))
2448 ;; (with-no-warnings
2449 ;; (setq menubar-bindings-done t))
22a58255 2450
ede141ac 2451 (display-startup-screen (> file-count 0)))))
49939379 2452
47c7adae
RS
2453(defun command-line-normalize-file-name (file)
2454 "Collapse multiple slashes to one, to handle non-Emacs file names."
6b9e794f
RS
2455 (save-match-data
2456 ;; Use arg 1 so that we don't collapse // at the start of the file name.
2457 ;; That is significant on some systems.
2458 ;; However, /// at the beginning is supposed to mean just /, not //.
98e775e6
EZ
2459 (if (string-match
2460 (if (memq system-type '(ms-dos windows-nt))
2461 "^\\([\\/][\\/][\\/]\\)+"
2462 "^///+")
2463 file)
6b9e794f 2464 (setq file (replace-match "/" t t file)))
98e775e6
EZ
2465 (if (memq system-type '(ms-dos windows-nt))
2466 (while (string-match "\\([\\/][\\/]\\)+" file 1)
2467 (setq file (replace-match "/" t t file)))
2468 (while (string-match "//+" file 1)
2469 (setq file (replace-match "/" t t file))))
6b9e794f 2470 file))
47c7adae 2471
c88ab9ce 2472;;; startup.el ends here