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