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