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