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