(antlr-indent-at-bol-alist): Fix typo in docstring.
[bpt/emacs.git] / lisp / startup.el
CommitLineData
c88ab9ce
ER
1;;; startup.el --- process Emacs shell arguments
2
a3194d03 3;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
1ca41b97 4;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
eea8d4ef 5
630cc463 6;; Maintainer: FSF
d7b4d18f 7;; Keywords: internal
630cc463 8
a726e0d1
JB
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
4746118a 13;; the Free Software Foundation; either version 2, or (at your option)
a726e0d1
JB
14;; any later version.
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
b578f267 22;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
a726e0d1 25
630cc463 26;;; Commentary:
a726e0d1 27
32e51983
EZ
28;; This file parses the command line and gets Emacs running. Options
29;; on the command line are handled in precedence order. For priorities
30;; see the structure standard_args in the emacs.c file.
a726e0d1 31
630cc463
ER
32;;; Code:
33
a726e0d1
JB
34(setq top-level '(normal-top-level))
35
42a3e6fa 36(defvar command-line-processed nil
2879a13b 37 "Non-nil once command line has been processed.")
a726e0d1 38
42a3e6fa 39(defgroup initialization nil
ca3685a3 40 "Emacs start-up procedure."
42a3e6fa
RS
41 :group 'internal)
42
9c8b2150 43(defcustom inhibit-splash-screen nil
249d9683
LT
44 "Non-nil inhibits the startup screen.
45It also inhibits display of the initial message in the *scratch* buffer.
46
a726e0d1 47This is for use in your personal init file, once you are familiar
9c8b2150 48with the contents of the startup screen."
42a3e6fa
RS
49 :type 'boolean
50 :group 'initialization)
a726e0d1 51
9c8b2150 52(defvaralias 'inhibit-startup-message 'inhibit-splash-screen)
1b207153 53
42a3e6fa 54(defcustom inhibit-startup-echo-area-message nil
1d7da582 55 "*Non-nil inhibits the initial startup echo area message.
42a3e6fa
RS
56Setting this variable takes effect
57only if you do it with the customization buffer
94487c4e 58or if your `.emacs' file contains a line of this form:
54a003f7 59 (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
e5575c06
RS
60If your `.emacs' file is byte-compiled, use the following form instead:
61 (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
1d7da582 62Thus, someone else using a copy of your `.emacs' file will see
42a3e6fa
RS
63the startup message unless he personally acts to inhibit it."
64 :type '(choice (const :tag "Don't inhibit")
65 (string :tag "Enter your user name, to inhibit"))
66 :group 'initialization)
1d7da582 67
42a3e6fa
RS
68(defcustom inhibit-default-init nil
69 "*Non-nil inhibits loading the `default' library."
70 :type 'boolean
71 :group 'initialization)
a726e0d1 72
802a980a
GM
73(defcustom inhibit-startup-buffer-menu nil
74 "*Non-nil inhibits display of buffer list when more than 2 files are loaded."
75 :type 'boolean
76 :group 'initialization)
77
d7fa5aa2 78(defvar command-switch-alist nil
a726e0d1
JB
79 "Alist of command-line switches.
80Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
5bb54c61
RS
81HANDLER-FUNCTION receives the switch string as its sole argument;
82the remaining command-line args are in the variable `command-line-args-left'.")
a726e0d1 83
860befc8
RS
84(defvar command-line-args-left nil
85 "List of command-line args not yet processed.")
86
a726e0d1
JB
87(defvar command-line-functions nil ;; lrs 7/31/89
88 "List of functions to process unrecognized command-line arguments.
89Each function should access the dynamically bound variables
b4484ea8 90`argi' (the current argument) and `command-line-args-left' (the remaining
a726e0d1 91arguments). The function should return non-nil only if it recognizes and
b4484ea8
RS
92processes `argi'. If it does so, it may consume successive arguments by
93altering `command-line-args-left' to remove them.")
a726e0d1 94
09a1077c
RS
95(defvar command-line-default-directory nil
96 "Default directory to use for command line arguments.
97This is normally copied from `default-directory' when Emacs starts.")
98
b3afdeb8
RS
99;;; This is here, rather than in x-win.el, so that we can ignore these
100;;; options when we are not using X.
46cfd295 101(defconst command-line-x-option-alist
b3afdeb8
RS
102 '(("-bw" 1 x-handle-numeric-switch border-width)
103 ("-d" 1 x-handle-display)
104 ("-display" 1 x-handle-display)
5676ab57 105 ("-name" 1 x-handle-name-switch)
2c3fef40
RS
106 ("-title" 1 x-handle-switch title)
107 ("-T" 1 x-handle-switch title)
b3afdeb8
RS
108 ("-r" 0 x-handle-switch reverse t)
109 ("-rv" 0 x-handle-switch reverse t)
110 ("-reverse" 0 x-handle-switch reverse t)
111 ("-reverse-video" 0 x-handle-switch reverse t)
112 ("-fn" 1 x-handle-switch font)
113 ("-font" 1 x-handle-switch font)
188b6a5e
EZ
114 ("-fs" 0 x-handle-initial-switch fullscreen fullboth)
115 ("-fw" 0 x-handle-initial-switch fullscreen fullwidth)
116 ("-fh" 0 x-handle-initial-switch fullscreen fullheight)
b3afdeb8 117 ("-ib" 1 x-handle-numeric-switch internal-border-width)
1f7f78f1 118 ("-g" 1 x-handle-geometry)
9ff6bda1 119 ("-lsp" 1 x-handle-numeric-switch line-spacing)
1f7f78f1 120 ("-geometry" 1 x-handle-geometry)
b3afdeb8
RS
121 ("-fg" 1 x-handle-switch foreground-color)
122 ("-foreground" 1 x-handle-switch foreground-color)
123 ("-bg" 1 x-handle-switch background-color)
124 ("-background" 1 x-handle-switch background-color)
125 ("-ms" 1 x-handle-switch mouse-color)
c755acf3 126 ("-nbi" 0 x-handle-switch icon-type nil)
b3afdeb8
RS
127 ("-iconic" 0 x-handle-iconic)
128 ("-xrm" 1 x-handle-xrm-switch)
129 ("-cr" 1 x-handle-switch cursor-color)
130 ("-vb" 0 x-handle-switch vertical-scroll-bars t)
131 ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
132 ("-bd" 1 x-handle-switch)
133 ("--border-width" 1 x-handle-numeric-switch border-width)
134 ("--display" 1 x-handle-display)
5676ab57 135 ("--name" 1 x-handle-name-switch)
7775acb8 136 ("--title" 1 x-handle-switch title)
b3afdeb8
RS
137 ("--reverse-video" 0 x-handle-switch reverse t)
138 ("--font" 1 x-handle-switch font)
188b6a5e
EZ
139 ("--fullscreen" 0 x-handle-initial-switch fullscreen fullboth)
140 ("--fullwidth" 0 x-handle-initial-switch fullscreen fullwidth)
141 ("--fullheight" 0 x-handle-initial-switch fullscreen fullheight)
b3afdeb8 142 ("--internal-border" 1 x-handle-numeric-switch internal-border-width)
1f7f78f1 143 ("--geometry" 1 x-handle-geometry)
b3afdeb8
RS
144 ("--foreground-color" 1 x-handle-switch foreground-color)
145 ("--background-color" 1 x-handle-switch background-color)
146 ("--mouse-color" 1 x-handle-switch mouse-color)
1c1db08a 147 ("--no-bitmap-icon" 0 x-handle-switch icon-type nil)
b3afdeb8
RS
148 ("--iconic" 0 x-handle-iconic)
149 ("--xrm" 1 x-handle-xrm-switch)
150 ("--cursor-color" 1 x-handle-switch cursor-color)
151 ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
9ff6bda1 152 ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
7f944e8e 153 ("--border-color" 1 x-handle-switch border-color)
ca57f55d 154 ("--smid" 1 x-handle-smid))
b3afdeb8
RS
155 "Alist of X Windows options.
156Each element has the form
157 (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
158where NAME is the option name string, NUMARGS is the number of arguments
159that the option accepts, HANDLER is a function to call to handle the option.
160FRAME-PARAM (optional) is the frame parameter this option specifies,
161and VALUE is the value which is given to that frame parameter
162\(most options use the argument for this, so VALUE is not present).")
163
e3bd99f5 164(defvar before-init-hook nil
db3f571a 165 "Normal hook run after handling urgent options but before loading init files.")
3fc958a4 166
e3bd99f5 167(defvar after-init-hook nil
db3f571a
KH
168 "Normal hook run after loading the init files, `~/.emacs' and `default.el'.
169There is no `condition-case' around the running of these functions;
170therefore, if you set `debug-on-error' non-nil in `.emacs',
171an error in one of these functions will invoke the debugger.")
172
173(defvar emacs-startup-hook nil
174 "Normal hook run after loading init files and handling the command line.")
e3bd99f5 175
a726e0d1 176(defvar term-setup-hook nil
db3f571a
KH
177 "Normal hook run after loading terminal-specific Lisp code.
178It also follows `emacs-startup-hook'. This hook exists for users to set,
a726e0d1
JB
179so as to override the definitions made by the terminal-specific file.
180Emacs never sets this variable itself.")
181
deebb0e9
RS
182(defvar inhibit-startup-hooks nil
183 "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'.
184This is because we already did so.")
185
a726e0d1 186(defvar keyboard-type nil
b4484ea8 187 "The brand of keyboard you are using.
9ab281f0
JB
188This variable is used to define the proper function and keypad
189keys for use under X. It is used in a fashion analogous to the
190environment variable TERM.")
a726e0d1
JB
191
192(defvar window-setup-hook nil
b4484ea8
RS
193 "Normal hook run to initialize window system display.
194Emacs runs this hook after processing the command line arguments and loading
195the user's init file.")
a726e0d1 196
42a3e6fa
RS
197(defcustom initial-major-mode 'lisp-interaction-mode
198 "Major mode command symbol to use for the initial *scratch* buffer."
ce2f921e 199 :type 'function
42a3e6fa 200 :group 'initialization)
a726e0d1 201
ecbff273 202(defvar init-file-user nil
a726e0d1 203 "Identity of user whose `.emacs' file is or was read.
d7fa5aa2
RS
204The value is nil if `-q' or `--no-init-file' was specified,
205meaning do not load any init file.
206
d3a81eee
EZ
207Otherwise, the value may be an empty string, meaning
208use the init file for the user who originally logged in,
209or it may be a string containing a user's name meaning
210use that person's init file.
a726e0d1 211
2bdfaa42
KH
212In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
213evaluates to the name of the directory where the `.emacs' file was
13fce4e6
RS
214looked for.
215
216Setting `init-file-user' does not prevent Emacs from loading
ecbff273 217`site-start.el'. The only way to do that is to use `--no-site-file'.")
a726e0d1 218
42a3e6fa 219(defcustom site-run-file "site-start"
b7444d31
RS
220 "File containing site-wide run-time initializations.
221This file is loaded at run-time before `~/.emacs'. It contains inits
222that need to be in place for the entire site, but which, due to their
fcaf7de9 223higher incidence of change, don't make sense to load into Emacs's
b7444d31 224dumped image. Thus, the run-time load order is: 1. file described in
13fce4e6
RS
225this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
226
227Don't use the `site-start.el' file for things some users may not like.
228Put them in `default.el' instead, so that users can more easily
229override them. Users can prevent loading `default.el' with the `-q'
230option or by setting `inhibit-default-init' in their own init files,
231but inhibiting `site-start.el' requires `--no-site-file', which
842a1eac
RS
232is less convenient.
233
234This variable is defined for customization so as to make
235it visible in the relevant context. However, actually customizing it
236is not allowed, since it would not work anyway. The only way to set
9ab281f0 237this variable usefully is to set it while building and dumping Emacs."
93812130 238 :type '(choice (const :tag "none" nil) string)
842a1eac
RS
239 :group 'initialization
240 :initialize 'custom-initialize-default
241 :set '(lambda (variable value)
242 (error "Customizing `site-run-file' does not work")))
b7444d31 243
42a3e6fa
RS
244(defcustom mail-host-address nil
245 "*Name of this machine, for purposes of naming users."
246 :type '(choice (const nil) string)
247 :group 'mail)
c13fbb62 248
680ebfa6 249(defcustom user-mail-address (if command-line-processed
cee0c996
EZ
250 (or (getenv "EMAIL")
251 (concat (user-login-name) "@"
252 (or mail-host-address
253 (system-name))))
680ebfa6
RS
254 ;; Empty string means "not set yet".
255 "")
452e9090 256 "*Full mailing address of this user.
cee0c996
EZ
257This is initialized with environment variable `EMAIL' or, as a
258fallback, using `mail-host-address'. This is done after your
259init file is read, in case it sets `mail-host-address'."
42a3e6fa
RS
260 :type 'string
261 :group 'mail)
c10d1f06 262
42a3e6fa 263(defcustom auto-save-list-file-prefix
73f13e5a
GM
264 (cond ((eq system-type 'ms-dos)
265 ;; MS-DOS cannot have initial dot, and allows only 8.3 names
4b33deaa 266 "~/_emacs.d/auto-save.list/_s")
73f13e5a
GM
267 (t
268 "~/.emacs.d/auto-save-list/.saves-"))
cdee38c3
KH
269 "Prefix for generating `auto-save-list-file-name'.
270This is used after reading your `.emacs' file to initialize
271`auto-save-list-file-name', by appending Emacs's pid and the system name,
272if you have not already set `auto-save-list-file-name' yourself.
73f13e5a 273Directories in the prefix will be created if necessary.
cdee38c3 274Set this to nil if you want to prevent `auto-save-list-file-name'
42a3e6fa 275from being initialized."
3671f444
KH
276 :type '(choice (const :tag "Don't record a session's auto save list" nil)
277 string)
42a3e6fa 278 :group 'auto-save)
2e05d063 279
e2c60824
KS
280(defvar emacs-quick-startup nil)
281
dc58296d
RS
282(defvar emacs-basic-display nil)
283
a726e0d1
JB
284(defvar init-file-debug nil)
285
5b309ebf
RS
286(defvar init-file-had-error nil
287 "Non-nil if there was an error loading the user's init file.")
52320897 288
95eada65
RS
289(defvar normal-top-level-add-subdirs-inode-list nil)
290
178b4542
JL
291(defvar no-blinking-cursor nil)
292
0a480f3d
RS
293(defvar default-frame-background-mode)
294
b693e375
RS
295(defvar pure-space-overflow nil
296 "Non-nil if building Emacs overflowed pure space.")
297
859e15c1 298(defun normal-top-level-add-subdirs-to-load-path ()
0412d833
RS
299 "Add all subdirectories of current directory to `load-path'.
300More precisely, this uses only the subdirectories whose names
f734a13e
DL
301start with letters or digits; it excludes any subdirectory named `RCS'
302or `CVS', and any subdirectory that contains a file named `.nosearch'."
f1180544 303 (let (dirs
95eada65 304 attrs
859e15c1
KH
305 (pending (list default-directory)))
306 ;; This loop does a breadth-first tree walk on DIR's subtree,
307 ;; putting each subdir into DIRS as its contents are examined.
308 (while pending
4e0a3971 309 (push (pop pending) dirs)
722a451d
EZ
310 (let* ((this-dir (car dirs))
311 (contents (directory-files this-dir))
312 (default-directory this-dir)
fcaf7de9
SM
313 (canonicalized (if (fboundp 'untranslated-canonical-name)
314 (untranslated-canonical-name this-dir))))
722a451d
EZ
315 ;; The Windows version doesn't report meaningful inode
316 ;; numbers, so use the canonicalized absolute file name of the
317 ;; directory instead.
318 (setq attrs (or canonicalized
319 (nthcdr 10 (file-attributes this-dir))))
95eada65 320 (unless (member attrs normal-top-level-add-subdirs-inode-list)
4e0a3971
SM
321 (push attrs normal-top-level-add-subdirs-inode-list)
322 (dolist (file contents)
c4a40544 323 ;; The lower-case variants of RCS and CVS are for DOS/Windows.
4e0a3971
SM
324 (unless (member file '("." ".." "RCS" "CVS" "rcs" "cvs"))
325 (when (and (string-match "\\`[[:alnum:]]" file)
9d1fb179
RS
326 ;; Avoid doing a `stat' when it isn't necessary
327 ;; because that can cause trouble when an NFS server
328 ;; is down.
4e0a3971
SM
329 (not (string-match "\\.elc?\\'" file))
330 (file-directory-p file))
331 (let ((expanded (expand-file-name file)))
95eada65
RS
332 (unless (file-exists-p (expand-file-name ".nosearch"
333 expanded))
4e0a3971 334 (setq pending (nconc pending (list expanded)))))))))))
bb15e81a 335 (normal-top-level-add-to-load-path (cdr (nreverse dirs)))))
859e15c1 336
537b6e4e
RS
337;; This function is called from a subdirs.el file.
338;; It assumes that default-directory is the directory
339;; in which the subdirs.el file exists,
340;; and it adds to load-path the subdirs of that directory
341;; as specified in DIRS. Normally the elements of DIRS are relative.
e87a7309 342(defun normal-top-level-add-to-load-path (dirs)
cd1c10f6
RS
343 (let ((tail load-path)
344 (thisdir (directory-file-name default-directory)))
345 (while (and tail
138e541f
GM
346 ;;Don't go all the way to the nil terminator.
347 (cdr tail)
cd1c10f6
RS
348 (not (equal thisdir (car tail)))
349 (not (and (memq system-type '(ms-dos windows-nt))
350 (equal (downcase thisdir) (downcase (car tail))))))
351 (setq tail (cdr tail)))
138e541f
GM
352 ;;Splice the new section in.
353 (when tail
354 (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
e87a7309 355
a726e0d1
JB
356(defun normal-top-level ()
357 (if command-line-processed
358 (message "Back to top level.")
359 (setq command-line-processed t)
8d4c2221
RS
360 ;; Give *Messages* the same default-directory as *scratch*,
361 ;; just to keep things predictable.
362 (let ((dir default-directory))
fcaf7de9 363 (with-current-buffer "*Messages*"
8d4c2221 364 (setq default-directory dir)))
9715399e
MR
365 ;; `user-full-name' is now known; reset its standard-value here.
366 (put 'user-full-name 'standard-value
367 (list (default-value 'user-full-name)))
80d71556
KH
368 ;; For root, preserve owner and group when editing files.
369 (if (equal (user-uid) 0)
370 (setq backup-by-copying-when-mismatch t))
e87a7309
RS
371 ;; Look in each dir in load-path for a subdirs.el file.
372 ;; If we find one, load it, which will add the appropriate subdirs
373 ;; of that dir into load-path,
357438eb
KH
374 ;; Look for a leim-list.el file too. Loading it will register
375 ;; available input methods.
b6666b5f
SM
376 (let ((tail load-path) dir)
377 (while tail
378 (setq dir (car tail))
379 (let ((default-directory dir))
380 (load (expand-file-name "subdirs.el") t t t))
381 (let ((default-directory dir))
382 (load (expand-file-name "leim-list.el") t t t))
383 ;; We don't use a dolist loop and we put this "setq-cdr" command at
384 ;; the end, because the subdirs.el files may add elements to the end
385 ;; of load-path and we want to take it into account.
386 (setq tail (cdr tail))))
fcaf7de9
SM
387 (unless (eq system-type 'vax-vms)
388 ;; If the PWD environment variable isn't accurate, delete it.
389 (let ((pwd (getenv "PWD")))
390 (and (stringp pwd)
391 ;; Use FOO/., so that if FOO is a symlink, file-attributes
392 ;; describes the directory linked to, not FOO itself.
393 (or (equal (file-attributes
394 (concat (file-name-as-directory pwd) "."))
395 (file-attributes
396 (concat (file-name-as-directory default-directory)
397 ".")))
398 (setq process-environment
399 (delete (concat "PWD=" pwd)
400 process-environment))))))
492878e4 401 (setq default-directory (abbreviate-file-name default-directory))
6f2c86fa
KH
402 (let ((menubar-bindings-done nil))
403 (unwind-protect
404 (command-line)
405 ;; Do this again, in case .emacs defined more abbreviations.
406 (setq default-directory (abbreviate-file-name default-directory))
b3c7c12c
RS
407 ;; Specify the file for recording all the auto save files of this session.
408 ;; This is used by recover-session.
cdee38c3
KH
409 (or auto-save-list-file-name
410 (and auto-save-list-file-prefix
411 (setq auto-save-list-file-name
1f7f78f1
RS
412 ;; Under MS-DOS our PID is almost always reused between
413 ;; Emacs invocations. We need something more unique.
4b33deaa
EZ
414 (cond ((eq system-type 'ms-dos)
415 ;; We are going to access the auto-save
416 ;; directory, so make sure it exists.
417 (make-directory
418 (file-name-directory auto-save-list-file-prefix)
419 t)
f1180544 420 (concat
4b33deaa
EZ
421 (make-temp-name
422 (expand-file-name
423 auto-save-list-file-prefix))
424 "~"))
425 (t
426 (expand-file-name
427 (format "%s%d-%s~"
428 auto-save-list-file-prefix
429 (emacs-pid)
430 (system-name))))))))
deebb0e9
RS
431 (unless inhibit-startup-hooks
432 (run-hooks 'emacs-startup-hook)
433 (and term-setup-hook
434 (run-hooks 'term-setup-hook)))
6a1e7d67
GM
435
436 ;; Don't do this if we failed to create the initial frame,
437 ;; for instance due to a dense colormap.
538ef02a
GM
438 (when (or frame-initial-frame
439 ;; If frame-initial-frame has no meaning, do this anyway.
440 (not (and window-system
441 (not noninteractive)
442 (not (eq window-system 'pc)))))
6a1e7d67
GM
443 ;; Modify the initial frame based on what .emacs puts into
444 ;; ...-frame-alist.
445 (if (fboundp 'frame-notice-user-settings)
446 (frame-notice-user-settings))
447 (if (fboundp 'frame-set-background-mode)
448 ;; Set the faces for the initial background mode even if
449 ;; frame-notice-user-settings didn't (such as on a tty).
450 ;; frame-set-background-mode is idempotent, so it won't
451 ;; cause any harm if it's already been done.
61b91ad1 452 (let ((frame (selected-frame))
6a1e7d67
GM
453 term)
454 (when (and (null window-system)
61b91ad1
JL
455 ;; Don't override default set by files in lisp/term.
456 (null default-frame-background-mode)
6a1e7d67
GM
457 (let ((bg (frame-parameter frame 'background-color)))
458 (or (null bg)
61b91ad1
JL
459 (member bg '(unspecified "unspecified-bg"
460 "unspecified-fg")))))
461
6a1e7d67 462 (setq term (getenv "TERM"))
818cd248
EZ
463 ;; Some files in lisp/term do a better job with the
464 ;; background mode, but we leave this here anyway, in
465 ;; case they remove those files.
6a1e7d67
GM
466 (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
467 term)
61b91ad1 468 (setq default-frame-background-mode 'light)))
6a1e7d67 469 (frame-set-background-mode (selected-frame)))))
13ab33c4 470
6f2c86fa
KH
471 ;; Now we know the user's default font, so add it to the menu.
472 (if (fboundp 'font-menu-add-default)
473 (font-menu-add-default))
474 (and window-setup-hook
475 (run-hooks 'window-setup-hook))
476 (or menubar-bindings-done
66c24e1e
EZ
477 (if (display-popup-menus-p)
478 (precompute-menubar-bindings)))))))
6f2c86fa
KH
479
480;; Precompute the keyboard equivalents in the menu bar items.
481(defun precompute-menubar-bindings ()
365636dc
RS
482 (let ((submap (lookup-key global-map [menu-bar])))
483 (while submap
484 (and (consp (car submap))
485 (symbolp (car (car submap)))
486 (stringp (car-safe (cdr (car submap))))
487 (keymapp (cdr (cdr (car submap))))
a18042d7
RS
488 (progn
489 (x-popup-menu nil (cdr (cdr (car submap))))
490 (if purify-flag
491 (garbage-collect))))
365636dc 492 (setq submap (cdr submap))))
5b61c6a7 493 (setq define-key-rebound-commands t))
a726e0d1 494
c381f482
EZ
495;; Command-line options supported by tty's:
496(defconst tty-long-option-alist
8957d2bf
EZ
497 '(("--name" . "-name")
498 ("--title" . "-T")
499 ("--reverse-video" . "-reverse")
c381f482 500 ("--foreground-color" . "-fg")
8957d2bf
EZ
501 ("--background-color" . "-bg")
502 ("--color" . "-color")))
c381f482 503
b66b6aeb
GM
504(defconst tool-bar-images-pixel-height 24
505 "Height in pixels of images in the tool bar.")
506
3a55d3d0
JR
507(defvar tool-bar-originally-present nil
508 "Non-nil if tool-bars are present before user and site init files are read.")
509
bca8c7be 510;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc.
c381f482 511(defun tty-handle-args (args)
bca8c7be 512 (let (rest)
c381f482
EZ
513 (message "%s" args)
514 (while (and args
515 (not (equal (car args) "--")))
bca8c7be
MS
516 (let* ((argi (pop args))
517 (orig-argi argi)
518 argval completion)
c381f482
EZ
519 ;; Check for long options with attached arguments
520 ;; and separate out the attached option argument into argval.
bca8c7be
MS
521 (when (string-match "^\\(--[^=]*\\)=" argi)
522 (setq argval (substring argi (match-end 0))
523 argi (match-string 1 argi)))
524 (when (string-match "^--" argi)
525 (setq completion (try-completion argi tty-long-option-alist))
c381f482
EZ
526 (if (eq completion t)
527 ;; Exact match for long option.
bca8c7be 528 (setq argi (cdr (assoc argi tty-long-option-alist)))
c381f482
EZ
529 (if (stringp completion)
530 (let ((elt (assoc completion tty-long-option-alist)))
531 ;; Check for abbreviated long option.
532 (or elt
bca8c7be
MS
533 (error "Option `%s' is ambiguous" argi))
534 (setq argi (cdr elt)))
c381f482 535 ;; Check for a short option.
bca8c7be
MS
536 (setq argval nil
537 argi orig-argi))))
538 (cond ((member argi '("-fg" "-foreground"))
539 (push (cons 'foreground-color (or argval (pop args)))
540 default-frame-alist))
541 ((member argi '("-bg" "-background"))
542 (push (cons 'background-color (or argval (pop args)))
543 default-frame-alist))
544 ((member argi '("-T" "-name"))
545 (unless argval (setq argval (pop args)))
546 (push (cons 'title
547 (if (stringp argval)
548 argval
549 (let ((case-fold-search t)
550 i)
551 (setq argval (invocation-name))
552
553 ;; Change any . or * characters in name to
554 ;; hyphens, so as to emulate behavior on X.
555 (while
556 (setq i (string-match "[.*]" argval))
557 (aset argval i ?-))
558 argval)))
559 default-frame-alist))
560 ((member argi '("-r" "-rv" "-reverse"))
561 (push '(reverse . t)
562 default-frame-alist))
563 ((equal argi "-color")
564 (unless argval (setq argval 8)) ; default --color means 8 ANSI colors
565 (push (cons 'tty-color-mode
566 (cond
567 ((numberp argval) argval)
568 ((string-match "-?[0-9]+" argval)
569 (string-to-number argval))
570 (t (intern argval))))
571 default-frame-alist))
572 (t
573 (push argi rest)))))
574 (nreverse rest)))
c381f482 575
a726e0d1 576(defun command-line ()
09a1077c
RS
577 (setq command-line-default-directory default-directory)
578
849eedba 579 ;; Choose a reasonable location for temporary files.
a3194d03 580 (custom-reevaluate-setting 'temporary-file-directory)
51db08eb 581 (custom-reevaluate-setting 'small-temporary-file-directory)
a3194d03 582 (custom-reevaluate-setting 'auto-save-file-name-transforms)
849eedba 583
74f2ab06 584 ;; See if we should import version-control from the environment variable.
a726e0d1
JB
585 (let ((vc (getenv "VERSION_CONTROL")))
586 (cond ((eq vc nil)) ;don't do anything if not set
bca8c7be 587 ((member vc '("t" "numbered"))
a726e0d1 588 (setq version-control t))
bca8c7be 589 ((member vc '("nil" "existing"))
a726e0d1 590 (setq version-control nil))
bca8c7be 591 ((member vc '("never" "simple"))
a726e0d1
JB
592 (setq version-control 'never))))
593
79058860
JB
594 ;;! This has been commented out; I currently find the behavior when
595 ;;! split-window-keep-point is nil disturbing, but if I can get used
596 ;;! to it, then it would be better to eliminate the option.
597 ;;! ;; Choose a good default value for split-window-keep-point.
598 ;;! (setq split-window-keep-point (> baud-rate 2400))
f35fe3c6 599
d4308a4d
EZ
600 ;; Set the default strings to display in mode line for
601 ;; end-of-line formats that aren't native to this platform.
602 (cond
603 ((memq system-type '(ms-dos windows-nt emx))
bca8c7be
MS
604 (setq eol-mnemonic-unix "(Unix)"
605 eol-mnemonic-mac "(Mac)"))
bde61f8b
EZ
606 ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the
607 ;; abbreviated strings `/' and `:' set in coding.c for them.
608 ((eq system-type 'macos)
609 (setq eol-mnemonic-dos "(DOS)"))
bca8c7be
MS
610 (t ; this is for Unix/GNU/Linux systems
611 (setq eol-mnemonic-dos "(DOS)"
612 eol-mnemonic-mac "(Mac)")))
d4308a4d 613
a726e0d1 614 ;; Read window system's init file if using a window system.
1ed14cfd
RS
615 (condition-case error
616 (if (and window-system (not noninteractive))
617 (load (concat term-file-prefix
618 (symbol-name window-system)
619 "-win")
620 ;; Every window system should have a startup file;
621 ;; barf if we can't find it.
622 nil t))
623 ;; If we can't read it, print the error message and exit.
624 (error
2677ad61
RS
625 (princ
626 (if (eq (car error) 'error)
627 (apply 'concat (cdr error))
628 (if (memq 'file-error (get (car error) 'error-conditions))
629 (format "%s: %s"
bca8c7be
MS
630 (nth 1 error)
631 (mapconcat (lambda (obj) (prin1-to-string obj t))
632 (cdr (cdr error)) ", "))
2677ad61 633 (format "%s: %s"
bca8c7be
MS
634 (get (car error) 'error-message)
635 (mapconcat (lambda (obj) (prin1-to-string obj t))
636 (cdr error) ", "))))
2677ad61 637 'external-debugging-output)
27f5188c 638 (terpri 'external-debugging-output)
2677ad61 639 (setq window-system nil)
1ed14cfd 640 (kill-emacs)))
a726e0d1 641
c381f482 642 ;; Windowed displays do this inside their *-win.el.
bca8c7be 643 (unless (or (display-graphic-p) noninteractive)
c381f482
EZ
644 (setq command-line-args (tty-handle-args command-line-args)))
645
640a9cdd
JR
646 (set-locale-environment nil)
647
4b816985 648 ;; Convert preloaded file names to absolute.
9c8b2150 649 (let ((lisp-dir
33d74677
AM
650 (file-truename
651 (file-name-directory
652 (locate-file "simple" load-path
653 (get-load-suffixes))))))
9c8b2150
RS
654
655 (setq load-history
656 (mapcar (lambda (elt)
657 (if (and (stringp (car elt))
658 (not (file-name-absolute-p (car elt))))
659 (cons (concat lisp-dir
33d74677 660 (car elt))
9c8b2150
RS
661 (cdr elt))
662 elt))
663 load-history)))
4b816985 664
c16eb7b0
RS
665 ;; Convert the arguments to Emacs internal representation.
666 (let ((args (cdr command-line-args)))
667 (while args
668 (setcar args
669 (decode-coding-string (car args) locale-coding-system t))
bca8c7be 670 (pop args)))
c16eb7b0 671
03e3c30a
JB
672 (let ((done nil)
673 (args (cdr command-line-args)))
674
a726e0d1
JB
675 ;; Figure out which user's init file to load,
676 ;; either from the environment or from the options.
677 (setq init-file-user (if noninteractive nil (user-login-name)))
678 ;; If user has not done su, use current $HOME to find .emacs.
bca8c7be
MS
679 (and init-file-user
680 (equal init-file-user (user-real-login-name))
a726e0d1 681 (setq init-file-user ""))
03e3c30a
JB
682
683 ;; Process the command-line args, and delete the arguments
684 ;; processed. This is consistent with the way main in emacs.c
685 ;; does things.
a726e0d1 686 (while (and (not done) args)
9ab281f0
JB
687 (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--debug-init")
688 ("--user") ("--iconic") ("--icon-type") ("--quick")
689 ("--no-blinking-cursor") ("--basic-display")))
bca8c7be
MS
690 (argi (pop args))
691 (orig-argi argi)
692 argval)
452e9090 693 ;; Handle --OPTION=VALUE format.
bca8c7be 694 (when (string-match "^\\(--[^=]*\\)=" argi)
1b207153 695 (setq argval (substring argi (match-end 0))
bca8c7be 696 argi (match-string 1 argi)))
1b207153
CW
697 (unless (equal argi "--")
698 (let ((completion (try-completion argi longopts)))
699 (if (eq completion t)
700 (setq argi (substring argi 1))
701 (if (stringp completion)
702 (let ((elt (assoc completion longopts)))
703 (or elt
704 (error "Option `%s' is ambiguous" argi))
705 (setq argi (substring (car elt) 1)))
bca8c7be
MS
706 (setq argval nil
707 argi orig-argi)))))
a726e0d1 708 (cond
dc58296d 709 ((member argi '("-Q" "-quick"))
e2c60824
KS
710 (setq init-file-user nil
711 site-run-file nil
dc58296d
RS
712 emacs-quick-startup t))
713 ((member argi '("-D" "-basic-display"))
714 (setq no-blinking-cursor t
715 emacs-basic-display t)
e2c60824 716 (push '(vertical-scroll-bars . nil) initial-frame-alist))
4e0a3971
SM
717 ((member argi '("-q" "-no-init-file"))
718 (setq init-file-user nil))
719 ((member argi '("-u" "-user"))
bca8c7be 720 (setq init-file-user (or argval (pop args))
4e0a3971 721 argval nil))
bca8c7be 722 ((equal argi "-no-site-file")
4e0a3971 723 (setq site-run-file nil))
bca8c7be 724 ((equal argi "-debug-init")
4e0a3971 725 (setq init-file-debug t))
bca8c7be 726 ((equal argi "-iconic")
4e0a3971 727 (push '(visibility . icon) initial-frame-alist))
bca8c7be 728 ((member argi '("-icon-type" "-i" "-itype"))
4e0a3971 729 (push '(icon-type . t) default-frame-alist))
178b4542
JL
730 ((member argi '("-nbc" "-no-blinking-cursor"))
731 (setq no-blinking-cursor t))
4e0a3971 732 ;; Push the popped arg back on the list of arguments.
bca8c7be
MS
733 (t
734 (push argi args)
735 (setq done t)))
096b7031
KH
736 ;; Was argval set but not used?
737 (and argval
738 (error "Option `%s' doesn't allow an argument" argi))))
739
03e3c30a 740 ;; Re-attach the program name to the front of the arg list.
bca8c7be
MS
741 (and command-line-args
742 (setcdr command-line-args args)))
a726e0d1 743
ce98f555
RS
744 (run-hooks 'before-init-hook)
745
ed0fb1f1 746 ;; Under X Window, this creates the X frame and deletes the terminal frame.
14f16b9c
GM
747 (when (fboundp 'frame-initialize)
748 (frame-initialize))
749
ed0fb1f1 750 ;; Turn off blinking cursor if so specified in X resources. This is here
b08cb5a6 751 ;; only because all other settings of no-blinking-cursor are here.
ed0fb1f1
JD
752 (unless (or noninteractive
753 emacs-basic-display
754 (and (memq window-system '(x w32 mac))
755 (not (member (x-get-resource "cursorBlink" "CursorBlink")
756 '("off" "false")))))
757 (setq no-blinking-cursor t))
758
1fe0333f 759 ;; If frame was created with a menu bar, set menu-bar-mode on.
bca8c7be 760 (unless (or noninteractive
dc58296d 761 emacs-basic-display
bca8c7be
MS
762 (and (memq window-system '(x w32))
763 (<= (frame-parameter nil 'menu-bar-lines) 0)))
8ab9589d 764 (menu-bar-mode 1))
c722566c 765
7d1eb6a4 766 ;; If frame was created with a tool bar, switch tool-bar-mode on.
bca8c7be 767 (unless (or noninteractive
dc58296d 768 emacs-basic-display
bca8c7be
MS
769 (not (display-graphic-p))
770 (<= (frame-parameter nil 'tool-bar-lines) 0))
b66b6aeb 771 (tool-bar-mode 1))
7d1eb6a4 772
3413f928 773 ;; Can't do this init in defcustom because the relevant variables
a3194d03
SM
774 ;; are not set.
775 (custom-reevaluate-setting 'blink-cursor-mode)
776 (custom-reevaluate-setting 'normal-erase-is-backspace)
dc86f0a9 777 (custom-reevaluate-setting 'tooltip-mode)
c442c26d 778 (custom-reevaluate-setting 'global-font-lock-mode)
97a7dbee
YM
779 (custom-reevaluate-setting 'mouse-wheel-down-event)
780 (custom-reevaluate-setting 'mouse-wheel-up-event)
db441dba 781 (custom-reevaluate-setting 'file-name-shadow-mode)
a496452f 782 (custom-reevaluate-setting 'send-mail-function)
1e2d7573 783 (custom-reevaluate-setting 'focus-follows-mouse)
3b73087e 784
1592c1ef
EZ
785 ;; Register default TTY colors for the case the terminal hasn't a
786 ;; terminal init file.
51f47f64 787 (unless (memq window-system '(x w32 mac))
bca8c7be
MS
788 ;; We do this regardles of whether the terminal supports colors
789 ;; or not, since they can switch that support on or off in
790 ;; mid-session by setting the tty-color-mode frame parameter.
791 (tty-register-default-colors))
1592c1ef 792
3a55d3d0
JR
793 ;; Record whether the tool-bar is present before the user and site
794 ;; init files are processed. frame-notice-user-settings uses this
795 ;; to determine if the tool-bar has been disabled by the init files,
796 ;; and the frame needs to be resized.
797 (when (fboundp 'frame-notice-user-settings)
798 (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
799 (assq 'tool-bar-lines default-frame-alist))))
800 (setq tool-bar-originally-present
bca8c7be
MS
801 (and tool-bar-lines
802 (cdr tool-bar-lines)
803 (not (eq 0 (cdr tool-bar-lines)))))))
3a55d3d0 804
752ef254
GM
805 (let ((old-scalable-fonts-allowed scalable-fonts-allowed)
806 (old-font-list-limit font-list-limit)
807 (old-face-ignored-fonts face-ignored-fonts))
808
752ef254
GM
809 ;; Run the site-start library if it exists. The point of this file is
810 ;; that it is run before .emacs. There is no point in doing this after
811 ;; .emacs; that is useless.
f1180544 812 (if site-run-file
752ef254
GM
813 (load site-run-file t t))
814
815 ;; Sites should not disable this. Only individuals should disable
816 ;; the startup message.
817 (setq inhibit-startup-message nil)
818
f963ea40 819 ;; Warn for invalid user name.
ce98f555
RS
820 (when init-file-user
821 (if (string-match "[~/:\n]" init-file-user)
822 (display-warning 'initialization
823 (format "Invalid user name %s"
824 init-file-user)
825 :error)
1df1e49e
EZ
826 (if (file-directory-p (expand-file-name
827 ;; We don't support ~USER on MS-Windows except
828 ;; for the current user, and always load .emacs
829 ;; from the current user's home directory (see
830 ;; below). So always check "~", even if invoked
831 ;; with "-u USER", or if $USER or $LOGNAME are
832 ;; set to something different.
833 (if (eq system-type 'windows-nt)
834 "~"
835 (concat "~" init-file-user))))
ce98f555
RS
836 nil
837 (display-warning 'initialization
838 (format "User %s has no home directory"
839 init-file-user)
840 :error))))
f963ea40 841
752ef254
GM
842 ;; Load that user's init file, or the default one, or none.
843 (let (debug-on-error-from-init-file
844 debug-on-error-should-be-set
845 (debug-on-error-initial
846 (if (eq init-file-debug t) 'startup init-file-debug))
847 (orig-enable-multibyte default-enable-multibyte-characters))
848 (let ((debug-on-error debug-on-error-initial)
849 ;; This function actually reads the init files.
850 (inner
851 (function
852 (lambda ()
853 (if init-file-user
854 (let ((user-init-file-1
4e0a3971 855 (cond
752ef254
GM
856 ((eq system-type 'ms-dos)
857 (concat "~" init-file-user "/_emacs"))
858 ((eq system-type 'windows-nt)
fe7ecaf2 859 ;; Prefer .emacs on Windows.
752ef254
GM
860 (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
861 "~/.emacs"
fe7ecaf2
JR
862 ;; Also support _emacs for compatibility.
863 (if (directory-files "~" nil "^_emacs\\(\\.elc?\\)?$")
864 "~/_emacs"
865 ;; But default to .emacs if _emacs does not exist.
866 "~/.emacs")))
f1180544 867 ((eq system-type 'vax-vms)
752ef254 868 "sys$login:.emacs")
4e0a3971 869 (t
752ef254
GM
870 (concat "~" init-file-user "/.emacs")))))
871 ;; This tells `load' to store the file name found
872 ;; into user-init-file.
873 (setq user-init-file t)
874 (load user-init-file-1 t t)
f1180544 875
a04d5983
RS
876 (when (eq user-init-file t)
877 ;; If we did not find ~/.emacs, try
c3ab3701 878 ;; ~/.emacs.d/init.el.
a04d5983
RS
879 (let ((otherfile
880 (expand-file-name
c3ab3701 881 "init"
a04d5983 882 (file-name-as-directory
c3ab3701 883 (concat "~" init-file-user "/.emacs.d")))))
a04d5983
RS
884 (load otherfile t t)
885
886 ;; If we did not find the user's init file,
887 ;; set user-init-file conclusively.
888 ;; Don't let it be set from default.el.
889 (when (eq user-init-file t)
890 (setq user-init-file user-init-file-1))))
f1180544 891
752ef254
GM
892 ;; If we loaded a compiled file, set
893 ;; `user-init-file' to the source version if that
894 ;; exists.
895 (when (and user-init-file
896 (equal (file-name-extension user-init-file)
897 "elc"))
898 (let* ((source (file-name-sans-extension user-init-file))
899 (alt (concat source ".el")))
900 (setq source (cond ((file-exists-p alt) alt)
901 ((file-exists-p source) source)
902 (t nil)))
903 (when source
904 (when (file-newer-than-file-p source user-init-file)
905 (message "Warning: %s is newer than %s"
906 source user-init-file)
907 (sit-for 1))
908 (setq user-init-file source))))
f1180544 909
bca8c7be
MS
910 (unless inhibit-default-init
911 (let ((inhibit-startup-message nil))
912 ;; Users are supposed to be told their rights.
913 ;; (Plus how to get help and how to undo.)
914 ;; Don't you dare turn this off for anyone
915 ;; except yourself.
916 (load "default" t t)))))))))
752ef254
GM
917 (if init-file-debug
918 ;; Do this without a condition-case if the user wants to debug.
919 (funcall inner)
920 (condition-case error
921 (progn
922 (funcall inner)
923 (setq init-file-had-error nil))
924 (error
925 (let ((message-log-max nil))
926 (save-excursion
927 (set-buffer (get-buffer-create "*Messages*"))
928 (insert "\n\n"
929 (format "An error has occurred while loading `%s':\n\n"
930 user-init-file)
931 (format "%s%s%s"
932 (get (car error) 'error-message)
933 (if (cdr error) ": " "")
f5b6cffd 934 (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", "))
752ef254 935 "\n\n"
f5b6cffd
KS
936 "To ensure normal operation, you should investigate and remove the\n"
937 "cause of the error in your initialization file. Start Emacs with\n"
938 "the `--debug-init' option to view a complete error backtrace.\n\n"))
752ef254
GM
939 (message "Error in init file: %s%s%s"
940 (get (car error) 'error-message)
941 (if (cdr error) ": " "")
942 (mapconcat 'prin1-to-string (cdr error) ", "))
f5b6cffd
KS
943 (let ((pop-up-windows nil))
944 (pop-to-buffer "*Messages*"))
752ef254 945 (setq init-file-had-error t)))))
ac3186fd 946
9c8b2150
RS
947 (if (and deactivate-mark transient-mark-mode)
948 (with-current-buffer (window-buffer)
949 (deactivate-mark)))
950
ac3186fd
RS
951 ;; If the user has a file of abbrevs, read it.
952 (if (file-exists-p abbrev-file-name)
953 (quietly-read-abbrev-file abbrev-file-name))
954
70b199c3
RS
955 ;; If the abbrevs came entirely from the init file or the
956 ;; abbrevs file, they do not need saving.
957 (setq abbrevs-changed nil)
958
752ef254
GM
959 ;; If we can tell that the init file altered debug-on-error,
960 ;; arrange to preserve the value that it set up.
961 (or (eq debug-on-error debug-on-error-initial)
962 (setq debug-on-error-should-be-set t
963 debug-on-error-from-init-file debug-on-error)))
964 (if debug-on-error-should-be-set
965 (setq debug-on-error debug-on-error-from-init-file))
966 (unless (or default-enable-multibyte-characters
967 (eq orig-enable-multibyte default-enable-multibyte-characters))
968 ;; Init file changed to unibyte. Reset existing multibyte
969 ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*).
970 ;; Arguably this should only be done if they're free of
971 ;; multibyte characters.
972 (mapcar (lambda (buffer)
973 (with-current-buffer buffer
974 (if enable-multibyte-characters
975 (set-buffer-multibyte nil))))
976 (buffer-list))
977 ;; Also re-set the language environment in case it was
978 ;; originally done before unibyte was set and is sensitive to
979 ;; unibyte (display table, terminal coding system &c).
980 (set-language-environment current-language-environment)))
f1180544 981
752ef254 982 ;; Do this here in case the init file sets mail-host-address.
5b88a2c5 983 (if (equal user-mail-address "")
cee0c996
EZ
984 (setq user-mail-address (or (getenv "EMAIL")
985 (concat (user-login-name) "@"
986 (or mail-host-address
987 (system-name))))))
752ef254 988
d60b49ac
DN
989 ;; Originally face attributes were specified via
990 ;; `font-lock-face-attributes'. Users then changed the default
991 ;; face attributes by setting that variable. However, we try and
992 ;; be back-compatible and respect its value if set except for
993 ;; faces where M-x customize has been used to save changes for the
994 ;; face.
995 (when (boundp 'font-lock-face-attributes)
996 (let ((face-attributes font-lock-face-attributes))
997 (while face-attributes
998 (let* ((face-attribute (pop face-attributes))
999 (face (car face-attribute)))
1000 ;; Rustle up a `defface' SPEC from a
1001 ;; `font-lock-face-attributes' entry.
1002 (unless (get face 'saved-face)
1003 (let ((foreground (nth 1 face-attribute))
1004 (background (nth 2 face-attribute))
1005 (bold-p (nth 3 face-attribute))
1006 (italic-p (nth 4 face-attribute))
1007 (underline-p (nth 5 face-attribute))
1008 face-spec)
1009 (when foreground
1010 (setq face-spec (cons ':foreground (cons foreground face-spec))))
1011 (when background
1012 (setq face-spec (cons ':background (cons background face-spec))))
1013 (when bold-p
1014 (setq face-spec (append '(:weight bold) face-spec)))
1015 (when italic-p
1016 (setq face-spec (append '(:slant italic) face-spec)))
1017 (when underline-p
1018 (setq face-spec (append '(:underline t) face-spec)))
1019 (face-spec-set face (list (list t face-spec)) nil)))))))
1020
752ef254
GM
1021 ;; If parameter have been changed in the init file which influence
1022 ;; face realization, clear the face cache so that new faces will
1023 ;; be realized.
1024 (unless (and (eq scalable-fonts-allowed old-scalable-fonts-allowed)
1025 (eq font-list-limit old-font-list-limit)
1026 (eq face-ignored-fonts old-face-ignored-fonts))
1027 (clear-face-cache)))
f1180544 1028
e3bd99f5
RM
1029 (run-hooks 'after-init-hook)
1030
1fc67c11 1031 ;; Decode all default-directory.
cea927ed
KH
1032 (if (and default-enable-multibyte-characters locale-coding-system)
1033 (save-excursion
1034 (dolist (elt (buffer-list))
1035 (set-buffer elt)
1036 (if default-directory
1037 (setq default-directory
1038 (decode-coding-string default-directory
1039 locale-coding-system t))))
1040 (setq command-line-default-directory
1041 (decode-coding-string command-line-default-directory
1042 locale-coding-system t))))
1043
a726e0d1
JB
1044 ;; If *scratch* exists and init file didn't change its mode, initialize it.
1045 (if (get-buffer "*scratch*")
694210c4 1046 (with-current-buffer "*scratch*"
a726e0d1
JB
1047 (if (eq major-mode 'fundamental-mode)
1048 (funcall initial-major-mode))))
f1180544 1049
a726e0d1
JB
1050 ;; Load library for our terminal type.
1051 ;; User init file can set term-file-prefix to nil to prevent this.
bca8c7be
MS
1052 (unless (or noninteractive
1053 window-system
1054 (null term-file-prefix))
c7dc8ae1
SM
1055 (let* ((TERM (getenv "TERM"))
1056 (term TERM)
bca8c7be
MS
1057 hyphend)
1058 (while (and term
1059 (not (load (concat term-file-prefix term) t t)))
1060 ;; Strip off last hyphen and what follows, then try again
1061 (setq term
c7dc8ae1 1062 (if (setq hyphend (string-match "[-_][^-_]+\\'" term))
bca8c7be 1063 (substring term 0 hyphend)
4f0c9ba7 1064 nil)))
c7dc8ae1
SM
1065 (setq term TERM)
1066 ;; The terminal file has been loaded, now call the terminal specific
1067 ;; initialization function.
1068 (while term
1069 (let ((term-init-func (intern-soft (concat "terminal-init-" term))))
1070 (if (not (fboundp term-init-func))
1071 ;; Strip off last hyphen and what follows, then try again
1072 (setq term
1073 (if (setq hyphend (string-match "[-_][^-_]+\\'" term))
1074 (substring term 0 hyphend)
1075 nil))
1076 (setq term nil)
4f0c9ba7 1077 (funcall term-init-func))))))
a726e0d1 1078
5777a167
RS
1079 ;; Update the out-of-memory error message based on user's key bindings
1080 ;; for save-some-buffers.
1081 (setq memory-signal-data
1082 (list 'error
1083 (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs")))
1084
03e3c30a 1085 ;; Process the remaining args.
a726e0d1
JB
1086 (command-line-1 (cdr command-line-args))
1087
1088 ;; If -batch, terminate after processing the command options.
ca57f55d
JD
1089 (if noninteractive (kill-emacs t))
1090
1091 ;; Run emacs-session-restore (session management) if started by
1092 ;; the session manager and we have a session manager connection.
bca8c7be
MS
1093 (if (and (boundp 'x-session-previous-id)
1094 (stringp x-session-previous-id))
a99df87d
RS
1095 (with-no-warnings
1096 (emacs-session-restore x-session-previous-id))))
a726e0d1 1097
46cfd295 1098(defcustom initial-scratch-message (purecopy "\
3b79c219
GM
1099;; This buffer is for notes you don't want to save, and for Lisp evaluation.
1100;; If you want to create a file, visit that file with C-x C-f,
1101;; then enter the text in that file's own buffer.
9fe3219e 1102
46cfd295 1103")
9fe3219e 1104 "Initial message displayed in *scratch* buffer at startup.
249d9683
LT
1105If this is nil, no message will be displayed.
1106If `inhibit-splash-screen' is non-nil, then no message is displayed,
1107regardless of the value of this variable."
fa071a47
RS
1108 :type '(choice (text :tag "Message")
1109 (const :tag "none" nil))
1110 :group 'initialization)
9fe3219e 1111
ce9ded5d
GM
1112\f
1113;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1114;;; Fancy splash screen
1115;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1116
1117(defvar fancy-splash-text
aa260907 1118 '((:face (variable-pitch :weight bold)
ce9ded5d 1119 "Important Help menu items:\n"
959f1226
TTN
1120 :face variable-pitch
1121 (lambda ()
1122 (let* ((en "TUTORIAL")
1123 (tut (or (get-language-info current-language-environment
1124 'tutorial)
1125 en))
1126 (title (with-temp-buffer
1127 (insert-file-contents
1128 (expand-file-name tut data-directory)
1129 nil 0 256)
1130 (search-forward ".")
1131 (buffer-substring (point-min) (1- (point))))))
1132 ;; If there is a specific tutorial for the current language
1133 ;; environment and it is not English, append its title.
1134 (concat
1135 "Emacs Tutorial\tLearn how to use Emacs efficiently"
1136 (if (string= en tut)
1137 ""
1138 (concat " (" title ")"))
1139 "\n")))
1140 :face variable-pitch "\
1fc02b3c 1141Emacs FAQ\tFrequently asked questions and answers
81a0b042
RS
1142View Emacs Manual\tView the Emacs manual using Info
1143Absence of Warranty\tGNU Emacs comes with "
26ff68aa 1144 :face (variable-pitch :slant oblique)
ce9ded5d 1145 "ABSOLUTELY NO WARRANTY\n"
26ff68aa 1146 :face variable-pitch
d3c5bad2 1147 "\
d7618b60 1148Copying Conditions\tConditions for redistributing and changing Emacs
9ab281f0 1149Getting New Versions\tHow to obtain the latest version of Emacs
682b60ae 1150More Manuals / Ordering Manuals Buying printed manuals from the FSF\n")
aa260907
CY
1151 (:face (variable-pitch :weight bold)
1152 "Useful File menu items:\n"
5b309ebf
RS
1153 :face variable-pitch
1154 "Exit Emacs\t\t(Or type "
1155 :face default
1156 "Control-x"
1157 :face variable-pitch
1158 " followed by "
1159 :face default
1160 "Control-c"
1161 :face variable-pitch
1162 ")
dc58296d 1163Recover Crashed Session\tRecover files you were editing before a crash
d7618b60
GM
1164
1165
1166
3f334882 1167
aa260907 1168
d7618b60
GM
1169"
1170 ))
ce9ded5d
GM
1171 "A list of texts to show in the middle part of splash screens.
1172Each element in the list should be a list of strings or pairs
1173`:face FACE', like `fancy-splash-insert' accepts them.")
1174
1175
fb275c02 1176(defgroup fancy-splash-screen ()
a01bb1db 1177 "Fancy splash screen when Emacs starts."
fb275c02 1178 :version "21.1"
a01bb1db
GM
1179 :group 'initialization)
1180
1181
1ef0ffc6 1182(defcustom fancy-splash-delay 7
49939379 1183 "*Delay in seconds between splash screens."
a01bb1db 1184 :group 'fancy-splash-screen
ce9ded5d
GM
1185 :type 'integer)
1186
1187
1ef0ffc6 1188(defcustom fancy-splash-max-time 30
e9da51a1 1189 "*Show splash screens for at most this number of seconds.
1ef0ffc6 1190Values less than twice `fancy-splash-delay' are ignored."
e9da51a1
GM
1191 :group 'fancy-splash-screen
1192 :type 'integer)
1193
1194
8ad8561b
GM
1195(defcustom fancy-splash-image nil
1196 "*The image to show in the splash screens, or nil for defaults."
a01bb1db 1197 :group 'fancy-splash-screen
8ad8561b
GM
1198 :type '(choice (const :tag "Default" nil)
1199 (file :tag "File")))
ce9ded5d
GM
1200
1201
f645586f
GM
1202;; These are temporary storage areas for the splash screen display.
1203
1204(defvar fancy-current-text nil)
1205(defvar fancy-splash-help-echo nil)
e9da51a1 1206(defvar fancy-splash-stop-time nil)
eae91b60 1207(defvar fancy-splash-outer-buffer nil)
d3f4ab73 1208(defvar fancy-splash-last-input-event nil)
f645586f 1209
ce9ded5d
GM
1210(defun fancy-splash-insert (&rest args)
1211 "Insert text into the current buffer, with faces.
959f1226
TTN
1212Arguments from ARGS should be either strings, functions called
1213with no args that return a string, or pairs `:face FACE',
ce9ded5d 1214where FACE is a valid face specification, as it can be used with
a8a64bf4 1215`put-text-property'."
ce9ded5d
GM
1216 (let ((current-face nil))
1217 (while args
1218 (if (eq (car args) :face)
1219 (setq args (cdr args) current-face (car args))
959f1226
TTN
1220 (insert (propertize (let ((it (car args)))
1221 (if (functionp it)
1222 (funcall it)
1223 it))
f645586f
GM
1224 'face current-face
1225 'help-echo fancy-splash-help-echo)))
ce9ded5d
GM
1226 (setq args (cdr args)))))
1227
1228
1229(defun fancy-splash-head ()
1230 "Insert the head part of the splash screen into the current buffer."
51e8cfdd
GM
1231 (let* ((image-file (cond ((stringp fancy-splash-image)
1232 fancy-splash-image)
1233 ((and (display-color-p)
1234 (image-type-available-p 'xpm))
1235 (if (and (fboundp 'x-display-planes)
1236 (= (funcall 'x-display-planes) 8))
1237 "splash8.xpm"
1238 "splash.xpm"))
1239 (t "splash.pbm")))
1240 (img (create-image image-file))
ce9ded5d
GM
1241 (image-width (and img (car (image-size img))))
1242 (window-width (window-width (selected-window))))
1243 (when img
1244 (when (> window-width image-width)
f645586f 1245 ;; Center the image in the window.
e2c60824
KS
1246 (insert (propertize " " 'display
1247 `(space :align-to (+ center (-0.5 . ,img)))))
f645586f 1248
e7f3afa9
MB
1249 ;; Change the color of the XPM version of the splash image
1250 ;; so that it is visible with a dark frame background.
1251 (when (and (memq 'xpm img)
1252 (eq (frame-parameter nil 'background-mode) 'dark))
1253 (setq img (append img '(:color-symbols (("#000000" . "gray30"))))))
1254
f645586f
GM
1255 ;; Insert the image with a help-echo and a keymap.
1256 (let ((map (make-sparse-keymap))
a622451f 1257 (help-echo "mouse-2: browse http://www.gnu.org/"))
f645586f
GM
1258 (define-key map [mouse-2]
1259 (lambda ()
1260 (interactive)
a622451f 1261 (browse-url "http://www.gnu.org/")
f645586f
GM
1262 (throw 'exit nil)))
1263 (define-key map [down-mouse-2] 'ignore)
1264 (define-key map [up-mouse-2] 'ignore)
1265 (insert-image img (propertize "xxx" 'help-echo help-echo
1266 'keymap map)))
ce9ded5d 1267 (insert "\n"))))
9d5cf87c
RS
1268 (fancy-splash-insert
1269 :face '(variable-pitch :foreground "red")
1270 (if (eq system-type 'gnu/linux)
1271 "GNU Emacs is one component of the GNU/Linux operating system."
b831c087 1272 "GNU Emacs is one component of the GNU operating system."))
eae91b60 1273 (insert "\n")
aa260907
CY
1274 (fancy-splash-insert
1275 :face 'variable-pitch
1276 "You can do basic editing with the menu bar and scroll bar \
1277using the mouse.\n\n")
5b309ebf
RS
1278 (when fancy-splash-outer-buffer
1279 (fancy-splash-insert
1280 :face 'variable-pitch
1281 "Type "
1282 :face 'default
1283 (substitute-command-keys
1284 "\\[recenter]")
1285 :face 'variable-pitch
1286 " to begin editing"
1287 (if (equal (buffer-name fancy-splash-outer-buffer)
1288 "*scratch*")
1289 ".\n"
1290 " your file.\n"))))
ce9ded5d
GM
1291
1292(defun fancy-splash-tail ()
1293 "Insert the tail part of the splash screen into the current buffer."
95fadcca
GM
1294 (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
1295 "cyan" "darkblue")))
1296 (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
1297 "\nThis is "
1298 (emacs-version)
1299 "\n"
1300 :face '(variable-pitch :height 0.5)
1ca41b97 1301 "Copyright (C) 2006 Free Software Foundation, Inc.")
ed638cc9
RS
1302 (and auto-save-list-file-prefix
1303 ;; Don't signal an error if the
1304 ;; directory for auto-save-list files
1305 ;; does not yet exist.
1306 (file-directory-p (file-name-directory
1307 auto-save-list-file-prefix))
1308 (directory-files
1309 (file-name-directory auto-save-list-file-prefix)
1310 nil
1311 (concat "\\`"
1312 (regexp-quote (file-name-nondirectory
1313 auto-save-list-file-prefix)))
1314 t)
1315 (fancy-splash-insert :face '(variable-pitch :foreground "red")
1316 "\n\nIf an Emacs session crashed recently, "
5b309ebf
RS
1317 "type "
1318 :face '(fixed-pitch :foreground "red")
1319 "Meta-x recover-session RET"
1320 :face '(variable-pitch :foreground "red")
1321 "\nto recover"
ed638cc9 1322 " the files you were editing."))))
ce9ded5d 1323
f645586f
GM
1324(defun fancy-splash-screens-1 (buffer)
1325 "Timer function displaying a splash screen."
e9da51a1
GM
1326 (when (> (float-time) fancy-splash-stop-time)
1327 (throw 'stop-splashing nil))
f645586f
GM
1328 (unless fancy-current-text
1329 (setq fancy-current-text fancy-splash-text))
1330 (let ((text (car fancy-current-text)))
1331 (set-buffer buffer)
1332 (erase-buffer)
b693e375 1333 (if pure-space-overflow
0bfd44c1
EZ
1334 (insert "\
1335Warning Warning!!! Pure space overflow !!!Warning Warning
6f1b5591 1336\(See the node Pure Storage in the Lisp manual for details.)\n"))
f645586f
GM
1337 (fancy-splash-head)
1338 (apply #'fancy-splash-insert text)
1339 (fancy-splash-tail)
1340 (unless (current-message)
1341 (message fancy-splash-help-echo))
1342 (set-buffer-modified-p nil)
dbeb499b 1343 (goto-char (point-min))
f645586f
GM
1344 (force-mode-line-update)
1345 (setq fancy-current-text (cdr fancy-current-text))))
1346
1347
1348(defun fancy-splash-default-action ()
732950b1
JB
1349 "Stop displaying the splash screen buffer.
1350This is an internal function used to turn off the splash screen after
1351the user caused an input event by hitting a key or clicking with the
1352mouse."
f645586f 1353 (interactive)
ed256b30 1354 (if (and (memq 'down (event-modifiers last-command-event))
d54f452e
KS
1355 (eq (posn-window (event-start last-command-event))
1356 (selected-window)))
1357 ;; This is a mouse-down event in the spash screen window.
1358 ;; Ignore it and consume the corresponding mouse-up event.
1359 (read-event)
1360 (push last-command-event unread-command-events))
f645586f
GM
1361 (throw 'exit nil))
1362
d3f4ab73
YM
1363(defun fancy-splash-special-event-action ()
1364 "Save the last event and stop displaying the splash screen buffer.
1365This is an internal function used to turn off the splash screen after
1366the user caused an input event that is bound in `special-event-map'"
1367 (interactive)
1368 (setq fancy-splash-last-input-event last-input-event)
1369 (throw 'exit nil))
1370
f645586f 1371
6e85b03c 1372(defun fancy-splash-screens (&optional hide-on-input)
f645586f 1373 "Display fancy splash screens when Emacs starts."
6e85b03c
CY
1374 (if hide-on-input
1375 (let ((old-hourglass display-hourglass)
1376 (fancy-splash-outer-buffer (current-buffer))
1377 splash-buffer
1378 (old-minor-mode-map-alist minor-mode-map-alist)
1379 (old-emulation-mode-map-alists emulation-mode-map-alists)
d3f4ab73 1380 (old-special-event-map special-event-map)
6e85b03c
CY
1381 (frame (fancy-splash-frame))
1382 timer)
1383 (save-selected-window
1384 (select-frame frame)
fbd6b429 1385 (switch-to-buffer " GNU Emacs")
6e85b03c
CY
1386 (setq splash-buffer (current-buffer))
1387 (catch 'stop-splashing
1388 (unwind-protect
81a0b042
RS
1389 (let ((map (make-sparse-keymap))
1390 (cursor-type nil))
6e85b03c
CY
1391 (use-local-map map)
1392 (define-key map [switch-frame] 'ignore)
1393 (define-key map [t] 'fancy-splash-default-action)
1394 (define-key map [mouse-movement] 'ignore)
1395 (define-key map [mode-line t] 'ignore)
d3f4ab73
YM
1396 ;; Temporarily bind special events to
1397 ;; fancy-splash-special-event-action so as to stop
1398 ;; displaying splash screens with such events.
1399 ;; Otherwise, drag-n-drop into splash screens may
1400 ;; leave us in recursive editing with invisible
1401 ;; cursors for a while.
1402 (setq special-event-map (make-sparse-keymap))
1403 (map-keymap
1404 (lambda (key def)
1405 (define-key special-event-map (vector key)
1406 (if (eq def 'ignore)
1407 'ignore
1408 'fancy-splash-special-event-action)))
1409 old-special-event-map)
81a0b042 1410 (setq display-hourglass nil
6e85b03c
CY
1411 minor-mode-map-alist nil
1412 emulation-mode-map-alists nil
1413 buffer-undo-list t
1414 mode-line-format (propertize "---- %b %-"
1415 'face 'mode-line-buffer-id)
1416 fancy-splash-stop-time (+ (float-time)
1417 fancy-splash-max-time)
1418 timer (run-with-timer 0 fancy-splash-delay
1419 #'fancy-splash-screens-1
1420 splash-buffer))
81a0b042 1421 (message "%s" (startup-echo-area-message))
6e85b03c
CY
1422 (recursive-edit))
1423 (cancel-timer timer)
1424 (setq display-hourglass old-hourglass
1425 minor-mode-map-alist old-minor-mode-map-alist
d3f4ab73
YM
1426 emulation-mode-map-alists old-emulation-mode-map-alists
1427 special-event-map old-special-event-map)
1428 (kill-buffer splash-buffer)
1429 (when fancy-splash-last-input-event
1430 (setq last-input-event fancy-splash-last-input-event
1431 fancy-splash-last-input-event nil)
1432 (command-execute (lookup-key special-event-map
1433 (vector last-input-event))
1434 nil (vector last-input-event) t))))))
46d6e692 1435 ;; If hide-on-input is nil, don't hide the buffer on input.
6e85b03c
CY
1436 (if (or (window-minibuffer-p)
1437 (window-dedicated-p (selected-window)))
1438 (pop-to-buffer (current-buffer))
76a1a8a6 1439 (switch-to-buffer "*About GNU Emacs*"))
08326816 1440 (setq buffer-read-only nil)
6e85b03c
CY
1441 (erase-buffer)
1442 (if pure-space-overflow
1443 (insert "\
1444Warning Warning!!! Pure space overflow !!!Warning Warning
1445\(See the node Pure Storage in the Lisp manual for details.)\n"))
1446 (let (fancy-splash-outer-buffer)
1447 (fancy-splash-head)
1448 (dolist (text fancy-splash-text)
aa260907
CY
1449 (apply #'fancy-splash-insert text)
1450 (insert "\n"))
1451 (skip-chars-backward "\n")
1452 (delete-region (point) (point-max))
1453 (insert "\n")
6e85b03c
CY
1454 (fancy-splash-tail)
1455 (set-buffer-modified-p nil)
08326816
RF
1456 (setq buffer-read-only t)
1457 (if (and view-read-only (not view-mode))
1458 (view-mode-enter nil 'kill-buffer))
6e85b03c 1459 (goto-char (point-min)))))
6b20fb8e
RS
1460
1461(defun fancy-splash-frame ()
1462 "Return the frame to use for the fancy splash screen.
1463Returning non-nil does not mean we should necessarily
1464use the fancy splash screen, but if we do use it,
1465we put it on this frame."
1466 (let (chosen-frame)
3a321ddb 1467 (dolist (frame (append (frame-list) (list (selected-frame))))
6b20fb8e
RS
1468 (if (and (frame-visible-p frame)
1469 (not (window-minibuffer-p (frame-selected-window frame))))
1470 (setq chosen-frame frame)))
1471 chosen-frame))
f645586f 1472
285991dc
GM
1473(defun use-fancy-splash-screens-p ()
1474 "Return t if fancy splash screens should be used."
9df076f2
GM
1475 (when (and (display-graphic-p)
1476 (or (and (display-color-p)
285991dc 1477 (image-type-available-p 'xpm))
9df076f2 1478 (image-type-available-p 'pbm)))
16d2fae9
JPW
1479 (let ((frame (fancy-splash-frame)))
1480 (when frame
1481 (let* ((img (create-image (or fancy-splash-image
1482 (if (and (display-color-p)
1483 (image-type-available-p 'xpm))
1484 "splash.xpm" "splash.pbm"))))
a68ccb40
RS
1485 (image-height (and img (cdr (image-size img nil frame))))
1486 ;; We test frame-height so that, if the frame is split
1487 ;; by displaying a warning, that doesn't cause the normal
1488 ;; splash screen to be used.
1489 (frame-height (1- (frame-height frame))))
1490 (> frame-height (+ image-height 19)))))))
285991dc
GM
1491
1492
6e85b03c 1493(defun normal-splash-screen (&optional hide-on-input)
c61453ea 1494 "Display splash screen when Emacs starts."
82e736c1
JPW
1495 (let ((prev-buffer (current-buffer)))
1496 (unwind-protect
1497 (with-current-buffer (get-buffer-create "GNU Emacs")
08326816 1498 (setq buffer-read-only nil)
6e85b03c 1499 (erase-buffer)
260a5020 1500 (set (make-local-variable 'tab-width) 8)
6e85b03c
CY
1501 (if hide-on-input
1502 (set (make-local-variable 'mode-line-format)
1503 (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
260a5020
SM
1504
1505 (if pure-space-overflow
0bfd44c1
EZ
1506 (insert "\
1507Warning Warning!!! Pure space overflow !!!Warning Warning
6f1b5591 1508\(See the node Pure Storage in the Lisp manual for details.)\n"))
260a5020
SM
1509
1510 ;; The convention for this piece of code is that
1511 ;; each piece of output starts with one or two newlines
1512 ;; and does not end with any newlines.
1513 (insert "Welcome to GNU Emacs")
1514 (insert
1515 (if (eq system-type 'gnu/linux)
1516 ", one component of the GNU/Linux operating system.\n"
1517 ", a part of the GNU operating system.\n"))
1518
6e85b03c
CY
1519 (if hide-on-input
1520 (insert (substitute-command-keys
1521 (concat
1522 "\nType \\[recenter] to begin editing"
1523 (if (equal (buffer-name prev-buffer) "*scratch*")
1524 ".\n"
1525 " your file.\n")))))
260a5020
SM
1526
1527 (if (display-mouse-p)
1528 ;; The user can use the mouse to activate menus
1529 ;; so give help in terms of menu items.
1530 (progn
1531 (insert "\
c61453ea
PJ
1532You can do basic editing with the menu bar and scroll bar using the mouse.
1533
1534Useful File menu items:
1535Exit Emacs (or type Control-x followed by Control-c)
93bb512f 1536Recover Crashed Session Recover files you were editing before a crash
c61453ea
PJ
1537
1538Important Help menu items:
9ab281f0 1539Emacs Tutorial Learn how to use Emacs efficiently
c61453ea 1540Emacs FAQ Frequently asked questions and answers
5777a167 1541Read the Emacs Manual View the Emacs manual using Info
c61453ea 1542\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
9ab281f0
JB
1543Copying Conditions Conditions for redistributing and changing Emacs
1544Getting New Versions How to obtain the latest version of Emacs
1545More Manuals / Ordering Manuals How to order printed manuals from the FSF
c61453ea 1546")
260a5020
SM
1547 (insert "\n\n" (emacs-version)
1548 "
1ca41b97 1549Copyright (C) 2006 Free Software Foundation, Inc."))
c61453ea 1550
260a5020
SM
1551 ;; No mouse menus, so give help using kbd commands.
1552
1553 ;; If keys have their default meanings,
1554 ;; use precomputed string to save lots of time.
1555 (if (and (eq (key-binding "\C-h") 'help-command)
1556 (eq (key-binding "\C-xu") 'advertised-undo)
1557 (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
1558 (eq (key-binding "\C-ht") 'help-with-tutorial)
1559 (eq (key-binding "\C-hi") 'info)
1560 (eq (key-binding "\C-hr") 'info-emacs-manual)
1561 (eq (key-binding "\C-h\C-n") 'view-emacs-news))
1562 (insert "
c61453ea 1563Get help C-h (Hold down CTRL and press h)
5777a167
RS
1564Emacs manual C-h r
1565Emacs tutorial C-h t Undo changes C-x u
1566Buy manuals C-h C-m Exit Emacs C-x C-c
1567Browse manuals C-h i")
1568
260a5020
SM
1569 (insert (substitute-command-keys
1570 (format "\n
c61453ea 1571Get help %s
5777a167 1572Emacs manual \\[info-emacs-manual]
82e736c1
JPW
1573Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
1574Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs]
5777a167 1575Browse manuals \\[info]"
260a5020
SM
1576 (let ((where (where-is-internal
1577 'help-command nil t)))
1578 (if where
1579 (key-description where)
1580 "M-x help"))))))
1581
1582 ;; Say how to use the menu bar with the keyboard.
1583 (if (and (eq (key-binding "\M-`") 'tmm-menubar)
1584 (eq (key-binding [f10]) 'tmm-menubar))
1585 (insert "
c61453ea 1586Activate menubar F10 or ESC ` or M-`")
260a5020 1587 (insert (substitute-command-keys "
c61453ea
PJ
1588Activate menubar \\[tmm-menubar]")))
1589
260a5020
SM
1590 ;; Many users seem to have problems with these.
1591 (insert "
c61453ea
PJ
1592\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
1593If you have no Meta key, you may instead type ESC followed by the character.)")
1594
260a5020
SM
1595 (insert "\n\n" (emacs-version)
1596 "
1ca41b97 1597Copyright (C) 2006 Free Software Foundation, Inc.")
c61453ea 1598
260a5020
SM
1599 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
1600 (eq (key-binding "\C-h\C-d") 'describe-distribution)
1601 (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
1602 (insert
1603 "\n
c61453ea
PJ
1604GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
1605Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1606of Emacs and modify it; type C-h C-c to see the conditions.
1607Type C-h C-d for information on getting the latest version.")
260a5020
SM
1608 (insert (substitute-command-keys
1609 "\n
c61453ea
PJ
1610GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
1611Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1612of Emacs and modify it; type \\[describe-copying] to see the conditions.
1613Type \\[describe-distribution] for information on getting the latest version."))))
1614
260a5020
SM
1615 ;; The rest of the startup screen is the same on all
1616 ;; kinds of terminals.
1617
1618 ;; Give information on recovering, if there was a crash.
1619 (and auto-save-list-file-prefix
1620 ;; Don't signal an error if the
1621 ;; directory for auto-save-list files
1622 ;; does not yet exist.
1623 (file-directory-p (file-name-directory
1624 auto-save-list-file-prefix))
1625 (directory-files
1626 (file-name-directory auto-save-list-file-prefix)
1627 nil
1628 (concat "\\`"
1629 (regexp-quote (file-name-nondirectory
1630 auto-save-list-file-prefix)))
1631 t)
1632 (insert "\n\nIf an Emacs session crashed recently, "
81a0b042 1633 "type Meta-x recover-session RET\nto recover"
260a5020
SM
1634 " the files you were editing."))
1635
1636 ;; Display the input that we set up in the buffer.
1637 (set-buffer-modified-p nil)
08326816
RF
1638 (setq buffer-read-only t)
1639 (if (and view-read-only (not view-mode))
1640 (view-mode-enter nil 'kill-buffer))
260a5020 1641 (goto-char (point-min))
46d6e692
SM
1642 (if hide-on-input
1643 (if (or (window-minibuffer-p)
1644 (window-dedicated-p (selected-window)))
1645 ;; If hide-on-input is nil, creating a new frame will
1646 ;; generate enough events that the subsequent `sit-for'
1647 ;; will immediately return anyway.
1648 nil ;; (pop-to-buffer (current-buffer))
6e85b03c 1649 (save-window-excursion
46d6e692
SM
1650 (switch-to-buffer (current-buffer))
1651 (sit-for 120)))
1652 (condition-case nil
1653 (switch-to-buffer (current-buffer))
1654 ;; In case the window is dedicated or something.
1655 (error (pop-to-buffer (current-buffer))))))
82e736c1 1656 ;; Unwind ... ensure splash buffer is killed
6e85b03c 1657 (if hide-on-input
76a1a8a6
RS
1658 (kill-buffer "GNU Emacs")
1659 (switch-to-buffer "GNU Emacs")
1660 (rename-buffer "*About GNU Emacs*" t)))))
82e736c1 1661
c61453ea 1662
f645586f
GM
1663(defun startup-echo-area-message ()
1664 (if (eq (key-binding "\C-h\C-p") 'describe-project)
1665 "For information about the GNU Project and its goals, type C-h C-p."
1666 (substitute-command-keys
1667 "For information about the GNU Project and its goals, type \
1668\\[describe-project].")))
ce9ded5d
GM
1669
1670
49939379 1671(defun display-startup-echo-area-message ()
15fa6db0 1672 (let ((resize-mini-windows t))
8a26c165 1673 (message "%s" (startup-echo-area-message))))
f645586f 1674
49939379 1675
6e85b03c 1676(defun display-splash-screen (&optional hide-on-input)
c61453ea
PJ
1677 "Display splash screen according to display.
1678Fancy splash screens are used on graphic displays,
eb89917c
KH
1679normal otherwise.
1680With a prefix argument, any user input hides the splash screen."
1681 (interactive "P")
9df076f2 1682 (if (use-fancy-splash-screens-p)
6e85b03c
CY
1683 (fancy-splash-screens hide-on-input)
1684 (normal-splash-screen hide-on-input)))
c61453ea
PJ
1685
1686
a726e0d1 1687(defun command-line-1 (command-line-args-left)
52320897 1688 (or noninteractive (input-pending-p) init-file-had-error
ed638cc9
RS
1689 ;; t if the init file says to inhibit the echo area startup message.
1690 (and inhibit-startup-echo-area-message
1691 user-init-file
1692 (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
1693 (equal inhibit-startup-echo-area-message
bca8c7be 1694 (if (equal init-file-user "")
ed638cc9
RS
1695 (user-login-name)
1696 init-file-user)))
1697 ;; Wasn't set with custom; see if .emacs has a setq.
1698 (let ((buffer (get-buffer-create " *temp*")))
1699 (prog1
1700 (condition-case nil
1701 (save-excursion
1702 (set-buffer buffer)
1703 (insert-file-contents user-init-file)
1704 (re-search-forward
1705 (concat
1706 "([ \t\n]*setq[ \t\n]+"
1707 "inhibit-startup-echo-area-message[ \t\n]+"
1708 (regexp-quote
1709 (prin1-to-string
bca8c7be 1710 (if (equal init-file-user "")
ed638cc9
RS
1711 (user-login-name)
1712 init-file-user)))
1713 "[ \t\n]*)")
1714 nil t))
1715 (error nil))
1716 (kill-buffer buffer)))))
11dd83c8
GM
1717 ;; display-splash-screen at the end of command-line-1 calls
1718 ;; use-fancy-splash-screens-p. This can cause image.el to be
1719 ;; loaded, putting "Loading image... done" in the echo area.
1720 ;; This hides startup-echo-area-message. So
1721 ;; use-fancy-splash-screens-p is called here simply to get the
1722 ;; loading of image.el (if needed) out of the way before
1723 ;; display-startup-echo-area-message runs.
79f9f704 1724 (progn
79f9f704
GM
1725 (use-fancy-splash-screens-p)
1726 (display-startup-echo-area-message)))
ed638cc9
RS
1727
1728 ;; Delay 2 seconds after an init file error message
1729 ;; was displayed, so user can read it.
bca8c7be
MS
1730 (when init-file-had-error
1731 (sit-for 2))
1732
cb58ea33
RS
1733 (when (and pure-space-overflow
1734 (not noninteractive))
1735 (display-warning
1736 'initialization
2dca98f3 1737 "Building Emacs overflowed pure space. (See the node Pure Storage in the Lisp manual for details.)"
cb58ea33
RS
1738 :warning))
1739
bca8c7be
MS
1740 (when command-line-args-left
1741 ;; We have command args; process them.
1742 (let ((dir command-line-default-directory)
1743 (file-count 0)
1744 first-file-buffer
1745 tem
b9687971
TTN
1746 ;; This approach loses for "-batch -L DIR --eval "(require foo)",
1747 ;; if foo is intended to be found in DIR.
1748 ;;
1749 ;; ;; The directories listed in --directory/-L options will *appear*
1750 ;; ;; at the front of `load-path' in the order they appear on the
1751 ;; ;; command-line. We cannot do this by *placing* them at the front
1752 ;; ;; in the order they appear, so we need this variable to hold them,
1753 ;; ;; temporarily.
1754 ;; extra-load-path
1755 ;;
1756 ;; To DTRT we keep track of the splice point and modify `load-path'
1757 ;; straight away upon any --directory/-L option.
1758 splice
bca8c7be
MS
1759 just-files ;; t if this follows the magic -- option.
1760 ;; This includes our standard options' long versions
1761 ;; and long versions of what's on command-switch-alist.
1762 (longopts
1763 (append '(("--funcall") ("--load") ("--insert") ("--kill")
1764 ("--directory") ("--eval") ("--execute") ("--no-splash")
6ff901c7 1765 ("--find-file") ("--visit") ("--file") ("--no-desktop"))
bca8c7be
MS
1766 (mapcar (lambda (elt)
1767 (list (concat "-" (car elt))))
1768 command-switch-alist)))
1769 (line 0)
1770 (column 0))
1771
1772 ;; Add the long X options to longopts.
1773 (dolist (tem command-line-x-option-alist)
1774 (if (string-match "^--" (car tem))
1775 (push (list (car tem)) longopts)))
1776
1777 ;; Loop, processing options.
1778 (while command-line-args-left
1779 (let* ((argi (car command-line-args-left))
1780 (orig-argi argi)
1781 argval completion)
1782 (setq command-line-args-left (cdr command-line-args-left))
1783
1784 ;; Do preliminary decoding of the option.
1785 (if just-files
1786 ;; After --, don't look for options; treat all args as files.
1787 (setq argi "")
1788 ;; Convert long options to ordinary options
1789 ;; and separate out an attached option argument into argval.
1790 (when (string-match "^\\(--[^=]*\\)=" argi)
1791 (setq argval (substring argi (match-end 0))
1792 argi (match-string 1 argi)))
1793 (if (equal argi "--")
1794 (setq completion nil)
1795 (setq completion (try-completion argi longopts)))
1796 (if (eq completion t)
1797 (setq argi (substring argi 1))
1798 (if (stringp completion)
1799 (let ((elt (assoc completion longopts)))
1800 (or elt
1801 (error "Option `%s' is ambiguous" argi))
1802 (setq argi (substring (car elt) 1)))
1803 (setq argval nil
1804 argi orig-argi))))
1805
1806 ;; Execute the option.
1807 (cond ((setq tem (assoc argi command-switch-alist))
1808 (if argval
1809 (let ((command-line-args-left
1810 (cons argval command-line-args-left)))
1811 (funcall (cdr tem) argi))
1812 (funcall (cdr tem) argi)))
1813
1814 ((equal argi "-no-splash")
1815 (setq inhibit-startup-message t))
1816
1817 ((member argi '("-f" ; what the manual claims
1818 "-funcall"
1819 "-e")) ; what the source used to say
1820 (setq tem (intern (or argval (pop command-line-args-left))))
f39864ec 1821 (if (commandp tem)
bca8c7be
MS
1822 (command-execute tem)
1823 (funcall tem)))
1824
1825 ((member argi '("-eval" "-execute"))
1826 (eval (read (or argval (pop command-line-args-left)))))
bca8c7be
MS
1827
1828 ((member argi '("-L" "-directory"))
b9687971
TTN
1829 (setq tem (expand-file-name
1830 (command-line-normalize-file-name
1831 (or argval (pop command-line-args-left)))))
1832 (cond (splice (setcdr splice (cons tem (cdr splice)))
1833 (setq splice (cdr splice)))
1834 (t (setq load-path (cons tem load-path)
1835 splice load-path))))
bca8c7be
MS
1836
1837 ((member argi '("-l" "-load"))
1838 (let* ((file (command-line-normalize-file-name
1839 (or argval (pop command-line-args-left))))
1840 ;; Take file from default dir if it exists there;
1841 ;; otherwise let `load' search for it.
1842 (file-ex (expand-file-name file)))
1843 (when (file-exists-p file-ex)
1844 (setq file file-ex))
1845 (load file nil t)))
1846
56b3b16b
RS
1847 ;; This is used to handle -script. It's not clear
1848 ;; we need to document it.
0f0cef08
RS
1849 ((member argi '("-scriptload"))
1850 (let* ((file (command-line-normalize-file-name
1851 (or argval (pop command-line-args-left))))
1852 ;; Take file from default dir.
1853 (file-ex (expand-file-name file)))
1854 (load file-ex nil t t)))
1855
bca8c7be
MS
1856 ((equal argi "-insert")
1857 (setq tem (or argval (pop command-line-args-left)))
1858 (or (stringp tem)
1859 (error "File name omitted from `-insert' option"))
1860 (insert-file-contents (command-line-normalize-file-name tem)))
1861
1862 ((equal argi "-kill")
1863 (kill-emacs t))
1864
6ff901c7
EZ
1865 ;; This is for when they use --no-desktop with -q, or
1866 ;; don't load Desktop in their .emacs. If desktop.el
1867 ;; _is_ loaded, it will handle this switch, and we
1868 ;; won't see it by the time we get here.
1869 ((equal argi "-no-desktop")
1870 (message "\"--no-desktop\" ignored because the Desktop package is not loaded"))
1871
bca8c7be 1872 ((string-match "^\\+[0-9]+\\'" argi)
027a4b6b 1873 (setq line (string-to-number argi)))
bca8c7be
MS
1874
1875 ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
027a4b6b
JB
1876 (setq line (string-to-number (match-string 1 argi))
1877 column (string-to-number (match-string 2 argi))))
bca8c7be
MS
1878
1879 ((setq tem (assoc argi command-line-x-option-alist))
1880 ;; Ignore X-windows options and their args if not using X.
1881 (setq command-line-args-left
1882 (nthcdr (nth 1 tem) command-line-args-left)))
1883
1884 ((member argi '("-find-file" "-file" "-visit"))
1885 ;; An explicit option to specify visiting a file.
1886 (setq tem (or argval (pop command-line-args-left)))
1887 (unless (stringp tem)
1888 (error "File name omitted from `%s' option" argi))
1889 (setq file-count (1+ file-count))
1890 (let ((file (expand-file-name
1891 (command-line-normalize-file-name tem) dir)))
1892 (if (= file-count 1)
1893 (setq first-file-buffer (find-file file))
1894 (find-file-other-window file)))
1895 (or (zerop line)
1896 (goto-line line))
1897 (setq line 0)
1898 (unless (< column 1)
1899 (move-to-column (1- column)))
1900 (setq column 0))
1901
1902 ((equal argi "--")
1903 (setq just-files t))
1904 (t
1905 ;; We have almost exhausted our options. See if the
1906 ;; user has made any other command-line options available
1907 (let ((hooks command-line-functions) ;; lrs 7/31/89
1908 (did-hook nil))
1909 (while (and hooks
1910 (not (setq did-hook (funcall (car hooks)))))
1911 (setq hooks (cdr hooks)))
1912 (if (not did-hook)
1913 ;; Presume that the argument is a file name.
1914 (progn
1915 (if (string-match "\\`-" argi)
1916 (error "Unknown option `%s'" argi))
1917 (setq file-count (1+ file-count))
1918 (let ((file
1919 (expand-file-name
1920 (command-line-normalize-file-name orig-argi)
1921 dir)))
1922 (if (= file-count 1)
1923 (setq first-file-buffer (find-file file))
1924 (find-file-other-window file)))
1925 (or (zerop line)
1926 (goto-line line))
1927 (setq line 0)
1928 (unless (< column 1)
1929 (move-to-column (1- column)))
4e35ba2f
CY
1930 (setq column 0))))))
1931 ;; In unusual circumstances, the execution of Lisp code due
1932 ;; to command-line options can cause the last visible frame
1933 ;; to be deleted. In this case, kill emacs to avoid an
1934 ;; abort later.
1935 (unless (frame-live-p (selected-frame)) (kill-emacs nil))))
bca8c7be 1936
bca8c7be
MS
1937 ;; If 3 or more files visited, and not all visible,
1938 ;; show user what they all are. But leave the last one current.
1939 (and (> file-count 2)
1940 (not noninteractive)
1941 (not inhibit-startup-buffer-menu)
1942 (or (get-buffer-window first-file-buffer)
1943 (list-buffers)))))
eae91b60
RS
1944
1945 ;; Maybe display a startup screen.
e2c60824
KS
1946 (unless (or inhibit-startup-message
1947 noninteractive
3c24b4e4 1948 emacs-quick-startup)
eae91b60
RS
1949 ;; Display a startup screen, after some preparations.
1950
1951 ;; If there are no switches to process, we might as well
1952 ;; run this hook now, and there may be some need to do it
1953 ;; before doing any output.
deebb0e9 1954 (run-hooks 'emacs-startup-hook)
eae91b60
RS
1955 (and term-setup-hook
1956 (run-hooks 'term-setup-hook))
deebb0e9 1957 (setq inhibit-startup-hooks t)
eae91b60
RS
1958
1959 ;; It's important to notice the user settings before we
1960 ;; display the startup message; otherwise, the settings
1961 ;; won't take effect until the user gives the first
1962 ;; keystroke, and that's distracting.
1963 (when (fboundp 'frame-notice-user-settings)
1964 (frame-notice-user-settings))
1965
1966 ;; If there are no switches to process, we might as well
1967 ;; run this hook now, and there may be some need to do it
1968 ;; before doing any output.
1969 (when window-setup-hook
1970 (run-hooks 'window-setup-hook)
1971 ;; Don't let the hook be run twice.
1972 (setq window-setup-hook nil))
1973
1974 ;; Do this now to avoid an annoying delay if the user
1975 ;; clicks the menu bar during the sit-for.
1976 (when (display-popup-menus-p)
1977 (precompute-menubar-bindings))
d759a2f5
RS
1978 (with-no-warnings
1979 (setq menubar-bindings-done t))
ed638cc9 1980
eae91b60
RS
1981 ;; If *scratch* is selected and it is empty, insert an
1982 ;; initial message saying not to create a file there.
1983 (when (and initial-scratch-message
bca8c7be 1984 (equal (buffer-name) "*scratch*")
ed638cc9 1985 (= 0 (buffer-size)))
eae91b60
RS
1986 (insert initial-scratch-message)
1987 (set-buffer-modified-p nil))
ed638cc9 1988
eae91b60
RS
1989 ;; If user typed input during all that work,
1990 ;; abort the startup screen. Otherwise, display it now.
c61453ea 1991 (unless (input-pending-p)
6e85b03c 1992 (display-splash-screen t))))
c88ab9ce 1993
49939379 1994
47c7adae
RS
1995(defun command-line-normalize-file-name (file)
1996 "Collapse multiple slashes to one, to handle non-Emacs file names."
6b9e794f
RS
1997 (save-match-data
1998 ;; Use arg 1 so that we don't collapse // at the start of the file name.
1999 ;; That is significant on some systems.
2000 ;; However, /// at the beginning is supposed to mean just /, not //.
2001 (if (string-match "^///+" file)
2002 (setq file (replace-match "/" t t file)))
2003 (while (string-match "//+" file 1)
2004 (setq file (replace-match "/" t t file)))
2005 file))
47c7adae 2006
a3194d03 2007;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db
c88ab9ce 2008;;; startup.el ends here