(custom-face-value-create): If face name doesn't end with "face", add
[bpt/emacs.git] / lisp / startup.el
CommitLineData
c88ab9ce
ER
1;;; startup.el --- process Emacs shell arguments
2
fb275c02 3;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
eea8d4ef 4
630cc463 5;; Maintainer: FSF
d7b4d18f 6;; Keywords: internal
630cc463 7
a726e0d1
JB
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
4746118a 12;; the Free Software Foundation; either version 2, or (at your option)
a726e0d1
JB
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
b578f267
EN
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
a726e0d1 24
630cc463 25;;; Commentary:
a726e0d1 26
ab30fc8a
RS
27;; This file parses the command line and gets Emacs running. Options on
28;; the command line are handled in precedence order. The order is the
29;; one in the list below; first described means first handled. Options
30;; within each category (delimited by a bar) are handled in the order
31;; encountered on the command line.
32
33;; -------------------------
34;; -version Print Emacs version to stderr, then exit
35;; --version successfully right away.
36;; This option is handled by emacs.c
37;; -------------------------
38;; -help Print a short usage description and exit
39;; --help successfully right away.
40;; This option is handled by emacs.c
41;; -------------------------
42;; -nl Do not use shared memory (for systems that
43;; -no-shared-memory support this) for the dumped Emacs data.
44;; This option is handled by emacs.c
45;;
46;; -map For VMS.
47;; --map-data This option is handled by emacs.c
48;; -------------------------
49;; -t FILE Use FILE as the name of the terminal.
50;; --terminal FILE Using this implies "-nw" also.
51;; This option is handled by emacs.c
52;; -------------------------
64b0dbdb 53;; -d DISPNAME Use DISPNAME as the name of the X
ab30fc8a
RS
54;; -display DISPNAME display for the initial frame.
55;; --display DISPNAME This option is handled by emacs.c
56;; -------------------------
57;; -nw Do not use a windows system (but use the
58;; --no-windows terminal instead.)
59;; This option is handled by emacs.c
60;; -------------------------
61;; -batch Execute noninteractively (messages go to stdout,
62;; --batch variable noninteractive set to t)
63;; This option is handled by emacs.c
64;; -------------------------
65;; -q Do not load user's init file and do not load
66;; -no-init-file "default.el". Regardless of this switch,
6f9340dd 67;; --no-init-file "site-start" is still loaded.
ab30fc8a 68;; -------------------------
6f9340dd 69;; -no-site-file Do not load "site-start.el". (This is the ONLY
ab30fc8a
RS
70;; --no-site-file way to prevent loading that file.)
71;; -------------------------
72;; -u USER Load USER's init file instead of the init
73;; -user USER file belonging to the user starting Emacs.
74;; --user USER
75;; -------------------------
76;; -debug-init Don't catch errors in init files; let the
77;; --debug-init debugger run.
78;; -------------------------
79;; -i ICONTYPE Set type of icon using when Emacs is
64b0dbdb 80;; -itype ICONTYPE iconified under X.
ab30fc8a
RS
81;; --icon-type ICONTYPE This option is passed on to term/x-win.el
82;;
64b0dbdb 83;; -iconic Start Emacs iconified.
ab30fc8a
RS
84;; --iconic This option is passed on to term/x-win.el
85;; -------------------------
64b0dbdb 86;; Various X options for colors/fonts/geometry/title etc.
ab30fc8a
RS
87;; These options are passed on to term/x-win.el which see. Certain
88;; of these are also found in term/pc-win.el
89;; -------------------------
90;; FILE Visit FILE.
dc2cd811
GM
91;; -visit FILE
92;; --visit FILE
93;; -file FILE
94;; --file FILE
ab30fc8a
RS
95;;
96;; -L DIRNAME Add DIRNAME to load-path
97;; -directory DIRNAME
98;; --directory DIRNAME
99;;
100;; -l FILE Load and execute the Emacs lisp code
101;; -load FILE in FILE.
102;; --load FILE
103;;
104;; -f FUNC Execute Emacs lisp function FUNC with
105;; -funcall FUNC no arguments. The "-e" form is outdated
106;; --funcall FUNC and should not be used. (It's a typo
107;; -e FUNC promoted to a feature.)
108;;
955093c9
EN
109;; -eval FORM Execute Emacs lisp form FORM.
110;; --eval FORM
dc2cd811
GM
111;; -execute EXPR
112;; --execute EXPR
e6b75e30 113;;
ab30fc8a
RS
114;; -insert FILE Insert the contents of FILE into buffer.
115;; --insert FILE
116;; -------------------------
117;; -kill Kill (exit) Emacs right away.
118;; --kill
119;; -------------------------
a726e0d1 120
630cc463
ER
121;;; Code:
122
a726e0d1
JB
123(setq top-level '(normal-top-level))
124
42a3e6fa
RS
125(defvar command-line-processed nil
126 "Non-nil once command line has been processed")
a726e0d1 127
42a3e6fa
RS
128(defgroup initialization nil
129 "Emacs start-up procedure"
130 :group 'internal)
131
132(defcustom inhibit-startup-message nil
1d7da582 133 "*Non-nil inhibits the initial startup message.
a726e0d1 134This is for use in your personal init file, once you are familiar
42a3e6fa
RS
135with the contents of the startup message."
136 :type 'boolean
137 :group 'initialization)
a726e0d1 138
42a3e6fa 139(defcustom inhibit-startup-echo-area-message nil
1d7da582 140 "*Non-nil inhibits the initial startup echo area message.
42a3e6fa
RS
141Setting this variable takes effect
142only if you do it with the customization buffer
94487c4e 143or if your `.emacs' file contains a line of this form:
54a003f7 144 (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
e5575c06
RS
145If your `.emacs' file is byte-compiled, use the following form instead:
146 (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
1d7da582 147Thus, someone else using a copy of your `.emacs' file will see
42a3e6fa
RS
148the startup message unless he personally acts to inhibit it."
149 :type '(choice (const :tag "Don't inhibit")
150 (string :tag "Enter your user name, to inhibit"))
151 :group 'initialization)
1d7da582 152
42a3e6fa
RS
153(defcustom inhibit-default-init nil
154 "*Non-nil inhibits loading the `default' library."
155 :type 'boolean
156 :group 'initialization)
a726e0d1 157
d7fa5aa2 158(defvar command-switch-alist nil
a726e0d1
JB
159 "Alist of command-line switches.
160Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
161HANDLER-FUNCTION receives switch name as sole arg;
162remaining command-line args are in the variable `command-line-args-left'.")
163
860befc8
RS
164(defvar command-line-args-left nil
165 "List of command-line args not yet processed.")
166
a726e0d1
JB
167(defvar command-line-functions nil ;; lrs 7/31/89
168 "List of functions to process unrecognized command-line arguments.
169Each function should access the dynamically bound variables
b4484ea8 170`argi' (the current argument) and `command-line-args-left' (the remaining
a726e0d1 171arguments). The function should return non-nil only if it recognizes and
b4484ea8
RS
172processes `argi'. If it does so, it may consume successive arguments by
173altering `command-line-args-left' to remove them.")
a726e0d1 174
09a1077c
RS
175(defvar command-line-default-directory nil
176 "Default directory to use for command line arguments.
177This is normally copied from `default-directory' when Emacs starts.")
178
b3afdeb8
RS
179;;; This is here, rather than in x-win.el, so that we can ignore these
180;;; options when we are not using X.
46cfd295 181(defconst command-line-x-option-alist
b3afdeb8
RS
182 '(("-bw" 1 x-handle-numeric-switch border-width)
183 ("-d" 1 x-handle-display)
184 ("-display" 1 x-handle-display)
5676ab57 185 ("-name" 1 x-handle-name-switch)
2c3fef40
RS
186 ("-title" 1 x-handle-switch title)
187 ("-T" 1 x-handle-switch title)
b3afdeb8
RS
188 ("-r" 0 x-handle-switch reverse t)
189 ("-rv" 0 x-handle-switch reverse t)
190 ("-reverse" 0 x-handle-switch reverse t)
191 ("-reverse-video" 0 x-handle-switch reverse t)
192 ("-fn" 1 x-handle-switch font)
193 ("-font" 1 x-handle-switch font)
194 ("-ib" 1 x-handle-numeric-switch internal-border-width)
1f7f78f1 195 ("-g" 1 x-handle-geometry)
9ff6bda1 196 ("-lsp" 1 x-handle-numeric-switch line-spacing)
1f7f78f1 197 ("-geometry" 1 x-handle-geometry)
b3afdeb8
RS
198 ("-fg" 1 x-handle-switch foreground-color)
199 ("-foreground" 1 x-handle-switch foreground-color)
200 ("-bg" 1 x-handle-switch background-color)
201 ("-background" 1 x-handle-switch background-color)
202 ("-ms" 1 x-handle-switch mouse-color)
203 ("-itype" 0 x-handle-switch icon-type t)
204 ("-i" 0 x-handle-switch icon-type t)
205 ("-iconic" 0 x-handle-iconic)
206 ("-xrm" 1 x-handle-xrm-switch)
207 ("-cr" 1 x-handle-switch cursor-color)
208 ("-vb" 0 x-handle-switch vertical-scroll-bars t)
209 ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
210 ("-bd" 1 x-handle-switch)
211 ("--border-width" 1 x-handle-numeric-switch border-width)
212 ("--display" 1 x-handle-display)
5676ab57 213 ("--name" 1 x-handle-name-switch)
7775acb8 214 ("--title" 1 x-handle-switch title)
b3afdeb8
RS
215 ("--reverse-video" 0 x-handle-switch reverse t)
216 ("--font" 1 x-handle-switch font)
217 ("--internal-border" 1 x-handle-numeric-switch internal-border-width)
1f7f78f1 218 ("--geometry" 1 x-handle-geometry)
b3afdeb8
RS
219 ("--foreground-color" 1 x-handle-switch foreground-color)
220 ("--background-color" 1 x-handle-switch background-color)
221 ("--mouse-color" 1 x-handle-switch mouse-color)
222 ("--icon-type" 0 x-handle-switch icon-type t)
223 ("--iconic" 0 x-handle-iconic)
224 ("--xrm" 1 x-handle-xrm-switch)
225 ("--cursor-color" 1 x-handle-switch cursor-color)
226 ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
9ff6bda1 227 ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
b3afdeb8
RS
228 ("--border-color" 1 x-handle-switch border-width))
229 "Alist of X Windows options.
230Each element has the form
231 (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
232where NAME is the option name string, NUMARGS is the number of arguments
233that the option accepts, HANDLER is a function to call to handle the option.
234FRAME-PARAM (optional) is the frame parameter this option specifies,
235and VALUE is the value which is given to that frame parameter
236\(most options use the argument for this, so VALUE is not present).")
237
e3bd99f5 238(defvar before-init-hook nil
db3f571a 239 "Normal hook run after handling urgent options but before loading init files.")
3fc958a4 240
e3bd99f5 241(defvar after-init-hook nil
db3f571a
KH
242 "Normal hook run after loading the init files, `~/.emacs' and `default.el'.
243There is no `condition-case' around the running of these functions;
244therefore, if you set `debug-on-error' non-nil in `.emacs',
245an error in one of these functions will invoke the debugger.")
246
247(defvar emacs-startup-hook nil
248 "Normal hook run after loading init files and handling the command line.")
e3bd99f5 249
a726e0d1 250(defvar term-setup-hook nil
db3f571a
KH
251 "Normal hook run after loading terminal-specific Lisp code.
252It also follows `emacs-startup-hook'. This hook exists for users to set,
a726e0d1
JB
253so as to override the definitions made by the terminal-specific file.
254Emacs never sets this variable itself.")
255
256(defvar keyboard-type nil
b4484ea8
RS
257 "The brand of keyboard you are using.
258This variable is used to define
a726e0d1 259the proper function and keypad keys for use under X. It is used in a
94487c4e 260fashion analogous to the environment variable TERM.")
a726e0d1
JB
261
262(defvar window-setup-hook nil
b4484ea8
RS
263 "Normal hook run to initialize window system display.
264Emacs runs this hook after processing the command line arguments and loading
265the user's init file.")
a726e0d1 266
42a3e6fa
RS
267(defcustom initial-major-mode 'lisp-interaction-mode
268 "Major mode command symbol to use for the initial *scratch* buffer."
ce2f921e 269 :type 'function
42a3e6fa 270 :group 'initialization)
a726e0d1 271
42a3e6fa 272(defcustom init-file-user nil
a726e0d1 273 "Identity of user whose `.emacs' file is or was read.
d7fa5aa2
RS
274The value is nil if `-q' or `--no-init-file' was specified,
275meaning do not load any init file.
276
277Otherwise, the value may be the null string, meaning use the init file
278for the user that originally logged in, or it may be a
279string containing a user's name meaning use that person's init file.
a726e0d1 280
2bdfaa42
KH
281In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
282evaluates to the name of the directory where the `.emacs' file was
13fce4e6
RS
283looked for.
284
285Setting `init-file-user' does not prevent Emacs from loading
42a3e6fa
RS
286`site-start.el'. The only way to do that is to use `--no-site-file'."
287 :type '(choice (const :tag "none" nil) string)
288 :group 'initialization)
a726e0d1 289
42a3e6fa 290(defcustom site-run-file "site-start"
b7444d31
RS
291 "File containing site-wide run-time initializations.
292This file is loaded at run-time before `~/.emacs'. It contains inits
293that need to be in place for the entire site, but which, due to their
294higher incidence of change, don't make sense to load into emacs'
295dumped image. Thus, the run-time load order is: 1. file described in
13fce4e6
RS
296this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
297
298Don't use the `site-start.el' file for things some users may not like.
299Put them in `default.el' instead, so that users can more easily
300override them. Users can prevent loading `default.el' with the `-q'
301option or by setting `inhibit-default-init' in their own init files,
302but inhibiting `site-start.el' requires `--no-site-file', which
42a3e6fa 303is less convenient."
93812130 304 :type '(choice (const :tag "none" nil) string)
42a3e6fa 305 :group 'initialization)
b7444d31 306
42a3e6fa
RS
307(defcustom mail-host-address nil
308 "*Name of this machine, for purposes of naming users."
309 :type '(choice (const nil) string)
310 :group 'mail)
c13fbb62 311
42a3e6fa 312(defcustom user-mail-address nil
452e9090
RS
313 "*Full mailing address of this user.
314This is initialized based on `mail-host-address',
42a3e6fa
RS
315after your init file is read, in case it sets `mail-host-address'."
316 :type 'string
317 :group 'mail)
c10d1f06 318
42a3e6fa 319(defcustom auto-save-list-file-prefix
73f13e5a
GM
320 (cond ((eq system-type 'ms-dos)
321 ;; MS-DOS cannot have initial dot, and allows only 8.3 names
4b33deaa 322 "~/_emacs.d/auto-save.list/_s")
73f13e5a
GM
323 (t
324 "~/.emacs.d/auto-save-list/.saves-"))
cdee38c3
KH
325 "Prefix for generating `auto-save-list-file-name'.
326This is used after reading your `.emacs' file to initialize
327`auto-save-list-file-name', by appending Emacs's pid and the system name,
328if you have not already set `auto-save-list-file-name' yourself.
73f13e5a 329Directories in the prefix will be created if necessary.
cdee38c3 330Set this to nil if you want to prevent `auto-save-list-file-name'
42a3e6fa 331from being initialized."
3671f444
KH
332 :type '(choice (const :tag "Don't record a session's auto save list" nil)
333 string)
42a3e6fa 334 :group 'auto-save)
2e05d063 335
a726e0d1
JB
336(defvar init-file-debug nil)
337
52320897
RS
338(defvar init-file-had-error nil)
339
95eada65
RS
340(defvar normal-top-level-add-subdirs-inode-list nil)
341
859e15c1 342(defun normal-top-level-add-subdirs-to-load-path ()
0412d833
RS
343 "Add all subdirectories of current directory to `load-path'.
344More precisely, this uses only the subdirectories whose names
f734a13e
DL
345start with letters or digits; it excludes any subdirectory named `RCS'
346or `CVS', and any subdirectory that contains a file named `.nosearch'."
859e15c1 347 (let (dirs
95eada65 348 attrs
859e15c1
KH
349 (pending (list default-directory)))
350 ;; This loop does a breadth-first tree walk on DIR's subtree,
351 ;; putting each subdir into DIRS as its contents are examined.
352 (while pending
353 (setq dirs (cons (car pending) dirs))
354 (setq pending (cdr pending))
95eada65 355 (setq attrs (nthcdr 10 (file-attributes (car dirs))))
859e15c1
KH
356 (let ((contents (directory-files (car dirs)))
357 (default-directory (car dirs)))
95eada65
RS
358 (unless (member attrs normal-top-level-add-subdirs-inode-list)
359 (setq normal-top-level-add-subdirs-inode-list
360 (cons attrs normal-top-level-add-subdirs-inode-list))
361 (while contents
362 (unless (member (car contents) '("." ".." "RCS" "CVS"))
a622451f 363 (when (and (string-match "\\`[[:alnum:]]" (car contents))
9d1fb179
RS
364 ;; Avoid doing a `stat' when it isn't necessary
365 ;; because that can cause trouble when an NFS server
366 ;; is down.
367 (not (string-match "\\.elc?\\'" (car contents)))
95eada65
RS
368 (file-directory-p (car contents)))
369 (let ((expanded (expand-file-name (car contents))))
370 (unless (file-exists-p (expand-file-name ".nosearch"
371 expanded))
372 (setq pending (nconc pending (list expanded)))))))
373 (setq contents (cdr contents))))))
bb15e81a 374 (normal-top-level-add-to-load-path (cdr (nreverse dirs)))))
859e15c1 375
537b6e4e
RS
376;; This function is called from a subdirs.el file.
377;; It assumes that default-directory is the directory
378;; in which the subdirs.el file exists,
379;; and it adds to load-path the subdirs of that directory
380;; as specified in DIRS. Normally the elements of DIRS are relative.
e87a7309 381(defun normal-top-level-add-to-load-path (dirs)
cd1c10f6
RS
382 (let ((tail load-path)
383 (thisdir (directory-file-name default-directory)))
384 (while (and tail
138e541f
GM
385 ;;Don't go all the way to the nil terminator.
386 (cdr tail)
cd1c10f6
RS
387 (not (equal thisdir (car tail)))
388 (not (and (memq system-type '(ms-dos windows-nt))
389 (equal (downcase thisdir) (downcase (car tail))))))
390 (setq tail (cdr tail)))
138e541f
GM
391 ;;Splice the new section in.
392 (when tail
393 (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
e87a7309 394
a726e0d1
JB
395(defun normal-top-level ()
396 (if command-line-processed
397 (message "Back to top level.")
398 (setq command-line-processed t)
8d4c2221
RS
399 ;; Give *Messages* the same default-directory as *scratch*,
400 ;; just to keep things predictable.
401 (let ((dir default-directory))
402 (save-excursion
403 (set-buffer (get-buffer "*Messages*"))
404 (setq default-directory dir)))
80d71556
KH
405 ;; For root, preserve owner and group when editing files.
406 (if (equal (user-uid) 0)
407 (setq backup-by-copying-when-mismatch t))
e87a7309
RS
408 ;; Look in each dir in load-path for a subdirs.el file.
409 ;; If we find one, load it, which will add the appropriate subdirs
410 ;; of that dir into load-path,
357438eb
KH
411 ;; Look for a leim-list.el file too. Loading it will register
412 ;; available input methods.
e87a7309
RS
413 (let ((tail load-path)
414 new)
415 (while tail
416 (setq new (cons (car tail) new))
bbfc7591
GM
417 (condition-case nil
418 (let ((default-directory (car tail)))
419 (load (expand-file-name "subdirs.el" (car tail)) t t t)))
357438eb
KH
420 (condition-case nil
421 (let ((default-directory (car tail)))
422 (load (expand-file-name "leim-list.el" (car tail)) t t t)))
e87a7309 423 (setq tail (cdr tail))))
ffd56f97 424 (if (not (eq system-type 'vax-vms))
a4b33896
JB
425 (progn
426 ;; If the PWD environment variable isn't accurate, delete it.
427 (let ((pwd (getenv "PWD")))
428 (and (stringp pwd)
429 ;; Use FOO/., so that if FOO is a symlink, file-attributes
430 ;; describes the directory linked to, not FOO itself.
431 (or (equal (file-attributes
432 (concat (file-name-as-directory pwd) "."))
433 (file-attributes
434 (concat (file-name-as-directory default-directory)
435 ".")))
436 (setq process-environment
437 (delete (concat "PWD=" pwd)
438 process-environment)))))))
492878e4 439 (setq default-directory (abbreviate-file-name default-directory))
6f2c86fa
KH
440 (let ((menubar-bindings-done nil))
441 (unwind-protect
442 (command-line)
443 ;; Do this again, in case .emacs defined more abbreviations.
444 (setq default-directory (abbreviate-file-name default-directory))
b3c7c12c
RS
445 ;; Specify the file for recording all the auto save files of this session.
446 ;; This is used by recover-session.
cdee38c3
KH
447 (or auto-save-list-file-name
448 (and auto-save-list-file-prefix
449 (setq auto-save-list-file-name
1f7f78f1
RS
450 ;; Under MS-DOS our PID is almost always reused between
451 ;; Emacs invocations. We need something more unique.
4b33deaa
EZ
452 (cond ((eq system-type 'ms-dos)
453 ;; We are going to access the auto-save
454 ;; directory, so make sure it exists.
455 (make-directory
456 (file-name-directory auto-save-list-file-prefix)
457 t)
458 (concat
459 (make-temp-name
460 (expand-file-name
461 auto-save-list-file-prefix))
462 "~"))
463 (t
464 (expand-file-name
465 (format "%s%d-%s~"
466 auto-save-list-file-prefix
467 (emacs-pid)
468 (system-name))))))))
6f2c86fa
KH
469 (run-hooks 'emacs-startup-hook)
470 (and term-setup-hook
471 (run-hooks 'term-setup-hook))
472 ;; Modify the initial frame based on what .emacs puts into
473 ;; ...-frame-alist.
474 (if (fboundp 'frame-notice-user-settings)
475 (frame-notice-user-settings))
13ab33c4
MB
476 (if (fboundp 'frame-set-background-mode)
477 ;; Set the faces for the initial background mode even if
478 ;; frame-notice-user-settings didn't (such as on a tty).
479 ;; frame-set-background-mode is idempotent, so it won't
480 ;; cause any harm if it's already been done.
5ebc02b3
EZ
481 (let ((frame-background-mode frame-background-mode)
482 (frame (selected-frame))
483 term)
484 (when (and (null window-system)
485 ;; Don't override a possibly customized value.
486 (null frame-background-mode)
487 ;; Don't override user specifications.
488 (null (frame-parameter frame 'reverse))
489 (let ((bg (frame-parameter frame 'background-color)))
490 (or (null bg)
491 (member bg '(unspecified "unspecified-bg")))))
492 (setq term (getenv "TERM"))
493 (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
494 term)
495 (setq frame-background-mode 'light)))
496 (frame-set-background-mode (selected-frame))))
13ab33c4 497
6f2c86fa
KH
498 ;; Now we know the user's default font, so add it to the menu.
499 (if (fboundp 'font-menu-add-default)
500 (font-menu-add-default))
501 (and window-setup-hook
502 (run-hooks 'window-setup-hook))
503 (or menubar-bindings-done
66c24e1e
EZ
504 (if (display-popup-menus-p)
505 (precompute-menubar-bindings)))))))
6f2c86fa
KH
506
507;; Precompute the keyboard equivalents in the menu bar items.
508(defun precompute-menubar-bindings ()
365636dc
RS
509 (let ((submap (lookup-key global-map [menu-bar])))
510 (while submap
511 (and (consp (car submap))
512 (symbolp (car (car submap)))
513 (stringp (car-safe (cdr (car submap))))
514 (keymapp (cdr (cdr (car submap))))
a18042d7
RS
515 (progn
516 (x-popup-menu nil (cdr (cdr (car submap))))
517 (if purify-flag
518 (garbage-collect))))
365636dc 519 (setq submap (cdr submap))))
5b61c6a7 520 (setq define-key-rebound-commands t))
a726e0d1 521
c381f482
EZ
522;; Command-line options supported by tty's:
523(defconst tty-long-option-alist
524 '(("--name" . "-name")
525 ("--title" . "-T")
526 ("--reverse-video" . "-reverse")
527 ("--foreground-color" . "-fg")
528 ("--background-color" . "-bg")))
529
530;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc.
531(defun tty-handle-args (args)
532 (let ((rest nil))
533 (message "%s" args)
534 (while (and args
535 (not (equal (car args) "--")))
536 (let* ((this (car args))
537 (orig-this this)
538 completion argval)
539 (setq args (cdr args))
540 ;; Check for long options with attached arguments
541 ;; and separate out the attached option argument into argval.
542 (if (string-match "^--[^=]*=" this)
543 (setq argval (substring this (match-end 0))
544 this (substring this 0 (1- (match-end 0)))))
545 (when (string-match "^--" this)
546 (setq completion (try-completion this tty-long-option-alist))
547 (if (eq completion t)
548 ;; Exact match for long option.
549 (setq this (cdr (assoc this tty-long-option-alist)))
550 (if (stringp completion)
551 (let ((elt (assoc completion tty-long-option-alist)))
552 ;; Check for abbreviated long option.
553 (or elt
554 (error "Option `%s' is ambiguous" this))
555 (setq this (cdr elt)))
556 ;; Check for a short option.
557 (setq argval nil this orig-this))))
558 (cond ((or (string= this "-fg") (string= this "-foreground"))
559 (or argval (setq argval (car args) args (cdr args)))
560 (setq default-frame-alist
561 (cons (cons 'foreground-color argval)
562 default-frame-alist)))
563 ((or (string= this "-bg") (string= this "-background"))
564 (or argval (setq argval (car args) args (cdr args)))
565 (setq default-frame-alist
566 (cons (cons 'background-color argval)
567 default-frame-alist)))
568 ((or (string= this "-T") (string= this "-name"))
569 (or argval (setq argval (car args) args (cdr args)))
570 (setq default-frame-alist
571 (cons
572 (cons 'title
573 (if (stringp argval)
574 argval
575 (let ((case-fold-search t)
576 i)
577 (setq argval (invocation-name))
578
579 ;; Change any . or * characters in name to
580 ;; hyphens, so as to emulate behavior on X.
581 (while
582 (setq i (string-match "[.*]" argval))
583 (aset argval i ?-))
584 argval)))
585 default-frame-alist)))
586 ((or (string= this "-r")
587 (string= this "-rv")
588 (string= this "-reverse"))
589 (setq default-frame-alist
590 (cons '(reverse . t)
591 default-frame-alist)))
592 (t (setq rest (cons this rest))))))
593 (nreverse rest)))
594
a726e0d1 595(defun command-line ()
09a1077c
RS
596 (setq command-line-default-directory default-directory)
597
849eedba
RS
598 ;; Choose a reasonable location for temporary files.
599 (setq temporary-file-directory
600 (file-name-as-directory
601 (cond ((memq system-type '(ms-dos windows-nt))
602 (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
603 ((memq system-type '(vax-vms axp-vms))
604 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
605 (t
606 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))))
607f86f5
EZ
607 (setq small-temporary-file-directory
608 (if (eq system-type 'ms-dos)
f5568df0 609 (getenv "TMPDIR")))
849eedba 610
74f2ab06 611 ;; See if we should import version-control from the environment variable.
a726e0d1
JB
612 (let ((vc (getenv "VERSION_CONTROL")))
613 (cond ((eq vc nil)) ;don't do anything if not set
614 ((or (string= vc "t")
615 (string= vc "numbered"))
616 (setq version-control t))
617 ((or (string= vc "nil")
618 (string= vc "existing"))
619 (setq version-control nil))
620 ((or (string= vc "never")
621 (string= vc "simple"))
622 (setq version-control 'never))))
623
64ed733a 624 (set-locale-environment nil)
e9d8e8c7 625
79058860
JB
626 ;;! This has been commented out; I currently find the behavior when
627 ;;! split-window-keep-point is nil disturbing, but if I can get used
628 ;;! to it, then it would be better to eliminate the option.
629 ;;! ;; Choose a good default value for split-window-keep-point.
630 ;;! (setq split-window-keep-point (> baud-rate 2400))
f35fe3c6 631
d4308a4d
EZ
632 ;; Set the default strings to display in mode line for
633 ;; end-of-line formats that aren't native to this platform.
634 (cond
635 ((memq system-type '(ms-dos windows-nt emx))
636 (setq eol-mnemonic-unix "(Unix)")
637 (setq eol-mnemonic-mac "(Mac)"))
638 ;; Mac-specific settings should come here, once there's a
639 ;; system-type symbol specific to MacOS.
640 (t ; this is for Unix/GNU/Linux systems
641 (setq eol-mnemonic-dos "(DOS)")
642 (setq eol-mnemonic-mac "(Mac)")))
643
a726e0d1 644 ;; Read window system's init file if using a window system.
1ed14cfd
RS
645 (condition-case error
646 (if (and window-system (not noninteractive))
647 (load (concat term-file-prefix
648 (symbol-name window-system)
649 "-win")
650 ;; Every window system should have a startup file;
651 ;; barf if we can't find it.
652 nil t))
653 ;; If we can't read it, print the error message and exit.
654 (error
2677ad61
RS
655 (princ
656 (if (eq (car error) 'error)
657 (apply 'concat (cdr error))
658 (if (memq 'file-error (get (car error) 'error-conditions))
659 (format "%s: %s"
660 (nth 1 error)
ffaf8bbb 661 (mapconcat (lambda (obj) (prin1-to-string obj t))
2677ad61
RS
662 (cdr (cdr error)) ", "))
663 (format "%s: %s"
664 (get (car error) 'error-message)
ffaf8bbb 665 (mapconcat (lambda (obj) (prin1-to-string obj t))
2677ad61
RS
666 (cdr error) ", "))))
667 'external-debugging-output)
668 (setq window-system nil)
1ed14cfd 669 (kill-emacs)))
a726e0d1 670
c381f482
EZ
671 ;; Windowed displays do this inside their *-win.el.
672 (when (and (not (display-graphic-p))
673 (not noninteractive))
674 (setq command-line-args (tty-handle-args command-line-args)))
675
03e3c30a
JB
676 (let ((done nil)
677 (args (cdr command-line-args)))
678
a726e0d1
JB
679 ;; Figure out which user's init file to load,
680 ;; either from the environment or from the options.
681 (setq init-file-user (if noninteractive nil (user-login-name)))
682 ;; If user has not done su, use current $HOME to find .emacs.
683 (and init-file-user (string= init-file-user (user-real-login-name))
684 (setq init-file-user ""))
03e3c30a
JB
685
686 ;; Process the command-line args, and delete the arguments
687 ;; processed. This is consistent with the way main in emacs.c
688 ;; does things.
a726e0d1 689 (while (and (not done) args)
096b7031 690 (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
a360cae9 691 ("--debug-init") ("--iconic") ("--icon-type")))
096b7031
KH
692 (argi (car args))
693 (argval nil))
452e9090
RS
694 ;; Handle --OPTION=VALUE format.
695 (if (and (string-match "\\`--" argi)
696 (string-match "=" argi))
a981e7ff
KH
697 (setq argval (substring argi (match-end 0))
698 argi (substring argi 0 (match-beginning 0))))
f7ad212d
RS
699 (or (equal argi "--")
700 (let ((completion (try-completion argi longopts)))
701 (if (eq completion t)
702 (setq argi (substring argi 1))
703 (if (stringp completion)
704 (let ((elt (assoc completion longopts)))
705 (or elt
706 (error "Option `%s' is ambiguous" argi))
707 (setq argi (substring (car elt) 1)))
708 (setq argval nil)))))
a726e0d1
JB
709 (cond
710 ((or (string-equal argi "-q")
711 (string-equal argi "-no-init-file"))
712 (setq init-file-user nil
713 args (cdr args)))
714 ((or (string-equal argi "-u")
715 (string-equal argi "-user"))
096b7031 716 (or argval
d3bea05f
RS
717 (setq args (cdr args)
718 argval (car args)))
096b7031
KH
719 (setq init-file-user argval
720 argval nil
a726e0d1 721 args (cdr args)))
b7444d31
RS
722 ((string-equal argi "-no-site-file")
723 (setq site-run-file nil
724 args (cdr args)))
a726e0d1
JB
725 ((string-equal argi "-debug-init")
726 (setq init-file-debug t
727 args (cdr args)))
a360cae9
RS
728 ((string-equal argi "-iconic")
729 (setq initial-frame-alist
730 (cons '(visibility . icon) initial-frame-alist))
731 (setq args (cdr args)))
732 ((or (string-equal argi "-icon-type")
733 (string-equal argi "-i")
734 (string-equal argi "-itype"))
735 (setq default-frame-alist
736 (cons '(icon-type . t) default-frame-alist))
737 (setq args (cdr args)))
096b7031
KH
738 (t (setq done t)))
739 ;; Was argval set but not used?
740 (and argval
741 (error "Option `%s' doesn't allow an argument" argi))))
742
03e3c30a 743 ;; Re-attach the program name to the front of the arg list.
4048e56d 744 (and command-line-args (setcdr command-line-args args)))
a726e0d1 745
c722566c 746 ;; Under X Windows, this creates the X frame and deletes the terminal frame.
853ccbd5
RS
747 (if (fboundp 'frame-initialize)
748 (frame-initialize))
1fe0333f 749 ;; If frame was created with a menu bar, set menu-bar-mode on.
ffaf8bbb
SM
750 (if (and (not noninteractive)
751 (or (not (memq window-system '(x w32)))
752 (> (cdr (assq 'menu-bar-lines (frame-parameters))) 0)))
1fe0333f 753 (menu-bar-mode t))
c722566c 754
7d1eb6a4
GM
755 ;; If frame was created with a tool bar, switch tool-bar-mode on.
756 (when (and (not noninteractive)
66c24e1e 757 (display-graphic-p)
7d1eb6a4
GM
758 (> (frame-parameter nil 'tool-bar-lines) 0))
759 (tool-bar-mode t))
760
6753393b
GM
761 ;; Can't do this init in defcustom because window-system isn't set.
762 (when (and (not noninteractive)
763 (not (eq system-type 'ms-dos))
764 (memq window-system '(x w32)))
765 (setq-default blink-cursor t)
766 (blink-cursor-mode 1))
767
1592c1ef
EZ
768 ;; Register default TTY colors for the case the terminal hasn't a
769 ;; terminal init file.
770 (or (memq window-system '(x w32))
771 (not (tty-display-color-p))
772 (let* ((colors (cond ((eq window-system 'pc)
773 msdos-color-values)
774 ((eq system-type 'windows-nt)
775 w32-tty-standard-colors)
776 (t tty-standard-colors)))
777 (color (car colors)))
778 (while colors
779 (tty-color-define (car color) (cadr color) (cddr color))
780 (setq colors (cdr colors) color (car colors)))
781 ;; Modifying color mappings means realized faces don't
782 ;; use the right colors, so clear them.
783 (clear-face-cache)))
784
e3bd99f5 785 (run-hooks 'before-init-hook)
3fc958a4 786
09973c54
RM
787 ;; Run the site-start library if it exists. The point of this file is
788 ;; that it is run before .emacs. There is no point in doing this after
789 ;; .emacs; that is useless.
b7444d31
RS
790 (if site-run-file
791 (load site-run-file t t))
09973c54 792
8a988f45
RS
793 ;; Sites should not disable this. Only individuals should disable
794 ;; the startup message.
795 (setq inhibit-startup-message nil)
796
a726e0d1 797 ;; Load that user's init file, or the default one, or none.
3d1b78f0
RS
798 (let (debug-on-error-from-init-file
799 debug-on-error-should-be-set
800 (debug-on-error-initial
a460d4e3
RS
801 (if (eq init-file-debug t) 'startup init-file-debug))
802 (orig-enable-multibyte default-enable-multibyte-characters))
3d1b78f0
RS
803 (let ((debug-on-error debug-on-error-initial)
804 ;; This function actually reads the init files.
805 (inner
806 (function
807 (lambda ()
808 (if init-file-user
042dc034 809 (let ((user-init-file-1
a4c5c705
RS
810 (cond
811 ((eq system-type 'ms-dos)
812 (concat "~" init-file-user "/_emacs"))
7d1aa45d 813 ((eq system-type 'windows-nt)
06789559 814 (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
521736d1
RS
815 "~/.emacs"
816 "~/_emacs"))
a4c5c705
RS
817 ((eq system-type 'vax-vms)
818 "sys$login:.emacs")
819 (t
042dc034
KH
820 (concat "~" init-file-user "/.emacs")))))
821 ;; This tells `load' to store the file name found
822 ;; into user-init-file.
823 (setq user-init-file t)
824 (load user-init-file-1 t t)
694e6b24
KH
825 ;; If we did not find the user's init file,
826 ;; set user-init-file conclusively to nil;
827 ;; don't let it be set from default.el.
828 (if (eq user-init-file t)
829 (setq user-init-file nil))
46cfd295
DL
830 ;; If we loaded a compiled file, set
831 ;; `user-init-file' to the source version if that
832 ;; exists.
c047136e
GM
833 (when (and user-init-file
834 (equal (file-name-extension user-init-file)
835 "elc")
836 (file-exists-p user-init-file-1))
837 (when (file-newer-than-file-p
838 user-init-file-1 user-init-file)
839 (message "Warning: %s is newer than %s"
840 user-init-file-1 user-init-file)
841 (sit-for 1))
842 (setq user-init-file user-init-file-1))
a4c5c705
RS
843 (or inhibit-default-init
844 (let ((inhibit-startup-message nil))
845 ;; Users are supposed to be told their rights.
846 ;; (Plus how to get help and how to undo.)
847 ;; Don't you dare turn this off for anyone
848 ;; except yourself.
849 (load "default" t t)))))))))
3d1b78f0
RS
850 (if init-file-debug
851 ;; Do this without a condition-case if the user wants to debug.
852 (funcall inner)
853 (condition-case error
854 (progn
855 (funcall inner)
856 (setq init-file-had-error nil))
42bb6910
GM
857 (error
858 (let ((message-log-max nil))
859 (save-excursion
860 (set-buffer (get-buffer-create "*Messages*"))
861 (insert "\n\n"
862 (format "An error has occurred while loading `%s':\n\n"
863 user-init-file)
864 (format "%s%s%s"
865 (get (car error) 'error-message)
866 (if (cdr error) ": " "")
867 (mapconcat 'prin1-to-string (cdr error) ", "))
868 "\n\n"
869 "To ensure normal operation, you should investigate the cause\n"
870 "of the error in your initialization file and remove it. Start\n"
871 "Emacs with the `--debug-init' option to view a complete error\n"
872 "backtrace\n"))
873 (message "Error in init file: %s%s%s"
874 (get (car error) 'error-message)
875 (if (cdr error) ": " "")
876 (mapconcat 'prin1-to-string (cdr error) ", "))
877 (pop-to-buffer "*Messages*")
878 (setq init-file-had-error t)))))
ad2aeb8d 879 ;; If we can tell that the init file altered debug-on-error,
3d1b78f0
RS
880 ;; arrange to preserve the value that it set up.
881 (or (eq debug-on-error debug-on-error-initial)
882 (setq debug-on-error-should-be-set t
883 debug-on-error-from-init-file debug-on-error)))
884 (if debug-on-error-should-be-set
a460d4e3
RS
885 (setq debug-on-error debug-on-error-from-init-file))
886 (unless (or default-enable-multibyte-characters
887 (eq orig-enable-multibyte default-enable-multibyte-characters))
888 ;; Init file changed to unibyte. Reset existing multibyte
889 ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*).
890 ;; Arguably this should only be done if they're free of
891 ;; multibyte characters.
892 (mapcar (lambda (buffer)
893 (with-current-buffer buffer
894 (if enable-multibyte-characters
895 (set-buffer-multibyte nil))))
896 (buffer-list))
897 ;; Also re-set the language environment in case it was
898 ;; originally done before unibyte was set and is sensitive to
899 ;; unibyte (display table, terminal coding system &c).
900 (set-language-environment current-language-environment)))
3fc958a4 901
556f7d77
RS
902 ;; Do this here in case the init file sets mail-host-address.
903 (or user-mail-address
904 (setq user-mail-address (concat (user-login-name) "@"
905 (or mail-host-address
906 (system-name)))))
907
e3bd99f5
RM
908 (run-hooks 'after-init-hook)
909
a726e0d1
JB
910 ;; If *scratch* exists and init file didn't change its mode, initialize it.
911 (if (get-buffer "*scratch*")
912 (save-excursion
913 (set-buffer "*scratch*")
914 (if (eq major-mode 'fundamental-mode)
915 (funcall initial-major-mode))))
e724900d 916
a726e0d1
JB
917 ;; Load library for our terminal type.
918 ;; User init file can set term-file-prefix to nil to prevent this.
919 (and term-file-prefix (not noninteractive) (not window-system)
920 (let ((term (getenv "TERM"))
921 hyphend)
922 (while (and term
923 (not (load (concat term-file-prefix term) t t)))
924 ;; Strip off last hyphen and what follows, then try again
925 (if (setq hyphend (string-match "[-_][^-_]+$" term))
926 (setq term (substring term 0 hyphend))
927 (setq term nil)))))
928
03e3c30a 929 ;; Process the remaining args.
a726e0d1
JB
930 (command-line-1 (cdr command-line-args))
931
932 ;; If -batch, terminate after processing the command options.
933 (if noninteractive (kill-emacs t)))
934
46cfd295 935(defcustom initial-scratch-message (purecopy "\
3b79c219
GM
936;; This buffer is for notes you don't want to save, and for Lisp evaluation.
937;; If you want to create a file, visit that file with C-x C-f,
938;; then enter the text in that file's own buffer.
9fe3219e 939
46cfd295 940")
9fe3219e
RS
941 "Initial message displayed in *scratch* buffer at startup.
942If this is nil, no message will be displayed."
943 :type 'string)
944
ce9ded5d
GM
945\f
946;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
947;;; Fancy splash screen
948;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
949
950(defvar fancy-splash-text
26ff68aa 951 '((:face variable-pitch
926aa0ee
GM
952 "You can do basic editing with the menu bar and scroll bar \
953using the mouse.\n\n"
26ff68aa 954 :face (variable-pitch :weight bold)
ce9ded5d 955 "Useful Files menu items:\n"
26ff68aa 956 :face variable-pitch "\
ce9ded5d
GM
957Exit Emacs (or type Control-x followed by Control-c)
958Recover Session recover files you were editing before a crash
959
960
961"
962 )
558f409e 963 (:face variable-pitch
926aa0ee
GM
964 "You can do basic editing with the menu bar and scroll bar \
965using the mouse.\n\n"
26ff68aa 966 :face (variable-pitch :weight bold)
ce9ded5d 967 "Important Help menu items:\n"
26ff68aa 968 :face variable-pitch "\
ce9ded5d
GM
969Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently.
970Emacs FAQ Frequently asked questions and answers
971\(Non)Warranty GNU Emacs comes with "
26ff68aa 972 :face (variable-pitch :slant oblique)
ce9ded5d 973 "ABSOLUTELY NO WARRANTY\n"
26ff68aa 974 :face variable-pitch
d3c5bad2
GM
975 "\
976Copying Conditions Conditions for redistributing and changing Emacs\n"))
ce9ded5d
GM
977 "A list of texts to show in the middle part of splash screens.
978Each element in the list should be a list of strings or pairs
979`:face FACE', like `fancy-splash-insert' accepts them.")
980
981
fb275c02 982(defgroup fancy-splash-screen ()
a01bb1db 983 "Fancy splash screen when Emacs starts."
fb275c02 984 :version "21.1"
a01bb1db
GM
985 :group 'initialization)
986
987
ce9ded5d 988(defcustom fancy-splash-delay 5
49939379 989 "*Delay in seconds between splash screens."
a01bb1db 990 :group 'fancy-splash-screen
ce9ded5d
GM
991 :type 'integer)
992
993
8ad8561b
GM
994(defcustom fancy-splash-image nil
995 "*The image to show in the splash screens, or nil for defaults."
a01bb1db 996 :group 'fancy-splash-screen
8ad8561b
GM
997 :type '(choice (const :tag "Default" nil)
998 (file :tag "File")))
ce9ded5d
GM
999
1000
f645586f
GM
1001;; These are temporary storage areas for the splash screen display.
1002
1003(defvar fancy-current-text nil)
1004(defvar fancy-splash-help-echo nil)
1005
1006
ce9ded5d
GM
1007(defun fancy-splash-insert (&rest args)
1008 "Insert text into the current buffer, with faces.
1009Arguments from ARGS should be either strings or pairs `:face FACE',
1010where FACE is a valid face specification, as it can be used with
1011`put-text-properties'."
1012 (let ((current-face nil))
1013 (while args
1014 (if (eq (car args) :face)
1015 (setq args (cdr args) current-face (car args))
f645586f
GM
1016 (insert (propertize (car args)
1017 'face current-face
1018 'help-echo fancy-splash-help-echo)))
ce9ded5d
GM
1019 (setq args (cdr args)))))
1020
1021
1022(defun fancy-splash-head ()
1023 "Insert the head part of the splash screen into the current buffer."
8ad8561b 1024 (let* ((img (create-image (or fancy-splash-image
d7a7f131
DL
1025 (if (and (display-color-p)
1026 (image-type-available-p 'xpm))
13f93dee 1027 "splash.xpm" "splash.pbm"))))
ce9ded5d
GM
1028 (image-width (and img (car (image-size img))))
1029 (window-width (window-width (selected-window))))
1030 (when img
1031 (when (> window-width image-width)
f645586f 1032 ;; Center the image in the window.
ce9ded5d
GM
1033 (let ((pos (/ (- window-width image-width) 2)))
1034 (insert (propertize " " 'display `(space :align-to ,pos))))
f645586f
GM
1035
1036 ;; Change the color of the XPM version of the splash image
1037 ;; so that it is visible with a dark frame background.
8ad8561b
GM
1038 (when (and (memq 'xpm img)
1039 (eq (frame-parameter nil 'background-mode) 'dark))
49939379 1040 (setq img (append img '(:color-symbols (("#000000" . "gray"))))))
f645586f
GM
1041
1042 ;; Insert the image with a help-echo and a keymap.
1043 (let ((map (make-sparse-keymap))
a622451f 1044 (help-echo "mouse-2: browse http://www.gnu.org/"))
f645586f
GM
1045 (define-key map [mouse-2]
1046 (lambda ()
1047 (interactive)
a622451f 1048 (browse-url "http://www.gnu.org/")
f645586f
GM
1049 (throw 'exit nil)))
1050 (define-key map [down-mouse-2] 'ignore)
1051 (define-key map [up-mouse-2] 'ignore)
1052 (insert-image img (propertize "xxx" 'help-echo help-echo
1053 'keymap map)))
ce9ded5d 1054 (insert "\n"))))
b831c087
GM
1055 (if (eq system-type 'gnu/linux)
1056 (fancy-splash-insert
1057 :face '(variable-pitch :foreground "red")
1058 "GNU Emacs is one component of a Linux-based GNU system.")
ce9ded5d
GM
1059 (fancy-splash-insert
1060 :face '(variable-pitch :foreground "red")
b831c087 1061 "GNU Emacs is one component of the GNU operating system."))
ce9ded5d
GM
1062 (insert "\n"))
1063
1064
1065(defun fancy-splash-tail ()
1066 "Insert the tail part of the splash screen into the current buffer."
95fadcca
GM
1067 (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
1068 "cyan" "darkblue")))
1069 (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
1070 "\nThis is "
1071 (emacs-version)
1072 "\n"
1073 :face '(variable-pitch :height 0.5)
1074 "Copyright (C) 2000 Free Software Foundation, Inc.")))
ce9ded5d
GM
1075
1076
f645586f
GM
1077(defun fancy-splash-screens-1 (buffer)
1078 "Timer function displaying a splash screen."
1079 (unless fancy-current-text
1080 (setq fancy-current-text fancy-splash-text))
1081 (let ((text (car fancy-current-text)))
1082 (set-buffer buffer)
1083 (erase-buffer)
1084 (fancy-splash-head)
1085 (apply #'fancy-splash-insert text)
1086 (fancy-splash-tail)
1087 (unless (current-message)
1088 (message fancy-splash-help-echo))
1089 (set-buffer-modified-p nil)
dbeb499b 1090 (goto-char (point-min))
f645586f
GM
1091 (force-mode-line-update)
1092 (setq fancy-current-text (cdr fancy-current-text))))
1093
1094
1095(defun fancy-splash-default-action ()
1096 "Default action for events in the splash screen buffer."
1097 (interactive)
1098 (push last-command-event unread-command-events)
1099 (throw 'exit nil))
1100
1101
ce9ded5d 1102(defun fancy-splash-screens ()
f645586f 1103 "Display fancy splash screens when Emacs starts."
5b61c6a7
GM
1104 (setq fancy-splash-help-echo (startup-echo-area-message))
1105 (switch-to-buffer "GNU Emacs")
39250ec3 1106 (let ((old-busy-cursor display-busy-cursor)
5b61c6a7 1107 (splash-buffer (current-buffer))
5b61c6a7
GM
1108 timer)
1109 (unwind-protect
39250ec3 1110 (let ((map (make-sparse-keymap))
5b61c6a7 1111 (show-help-function nil))
39250ec3
SM
1112 (use-local-map map)
1113 (define-key map [t] 'fancy-splash-default-action)
5b61c6a7 1114 (define-key map [mouse-movement] 'ignore)
5b61c6a7
GM
1115 (setq cursor-type nil
1116 display-busy-cursor nil
754a29c9 1117 buffer-undo-list t
5b61c6a7
GM
1118 mode-line-format
1119 (propertize "---- %b %-" 'face '(:weight bold))
dada41e1
GM
1120 timer (run-with-timer 0 fancy-splash-delay
1121 #'fancy-splash-screens-1
5b61c6a7 1122 splash-buffer))
5b61c6a7 1123 (recursive-edit))
5b61c6a7 1124 (cancel-timer timer)
5b61c6a7
GM
1125 (setq display-busy-cursor old-busy-cursor)
1126 (kill-buffer splash-buffer))))
f645586f
GM
1127
1128
1129(defun startup-echo-area-message ()
1130 (if (eq (key-binding "\C-h\C-p") 'describe-project)
1131 "For information about the GNU Project and its goals, type C-h C-p."
1132 (substitute-command-keys
1133 "For information about the GNU Project and its goals, type \
1134\\[describe-project].")))
ce9ded5d
GM
1135
1136
49939379 1137(defun display-startup-echo-area-message ()
f645586f
GM
1138 (message (startup-echo-area-message)))
1139
49939379 1140
a726e0d1 1141(defun command-line-1 (command-line-args-left)
52320897 1142 (or noninteractive (input-pending-p) init-file-had-error
49939379
GM
1143 (and inhibit-startup-echo-area-message
1144 user-init-file
1145 (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
1146 (equal inhibit-startup-echo-area-message
1147 (if (string= init-file-user "")
1148 (user-login-name)
1149 init-file-user)))
1150 ;; Wasn't set with custom; see if .emacs has a setq.
1151 (let ((buffer (get-buffer-create " *temp*")))
1152 (prog1
1153 (condition-case nil
1154 (save-excursion
1155 (set-buffer buffer)
1156 (insert-file-contents user-init-file)
1157 (re-search-forward
1158 (concat
1159 "([ \t\n]*setq[ \t\n]+"
1160 "inhibit-startup-echo-area-message[ \t\n]+"
1161 (regexp-quote
1162 (prin1-to-string
1163 (if (string= init-file-user "")
1164 (user-login-name)
1165 init-file-user)))
1166 "[ \t\n]*)")
1167 nil t))
1168 (error nil))
1169 (kill-buffer buffer)))))
1170 (display-startup-echo-area-message))
a726e0d1
JB
1171 (if (null command-line-args-left)
1172 (cond ((and (not inhibit-startup-message) (not noninteractive)
1173 ;; Don't clobber a non-scratch buffer if init file
1174 ;; has selected it.
8baabd2a 1175 (string= (buffer-name) "*scratch*"))
a726e0d1
JB
1176 ;; If there are no switches to process, we might as well
1177 ;; run this hook now, and there may be some need to do it
1178 ;; before doing any output.
1179 (and term-setup-hook
1180 (run-hooks 'term-setup-hook))
1181 ;; Don't let the hook be run twice.
1182 (setq term-setup-hook nil)
4e1b1e72
JB
1183
1184 ;; It's important to notice the user settings before we
1185 ;; display the startup message; otherwise, the settings
1186 ;; won't take effect until the user gives the first
1187 ;; keystroke, and that's distracting.
5b61c6a7
GM
1188 (when (fboundp 'frame-notice-user-settings)
1189 (frame-notice-user-settings))
1190
1191 (when window-setup-hook
1192 (run-hooks 'window-setup-hook)
1193 (setq window-setup-hook nil))
1194
66c24e1e 1195 (when (display-popup-menus-p)
5b61c6a7
GM
1196 (precompute-menubar-bindings))
1197 (setq menubar-bindings-done t)
1198
fd11871a
RS
1199 ;; Do this now to avoid an annoying delay if the user
1200 ;; clicks the menu bar during the sit-for.
f862008d 1201 (when (= (buffer-size) 0)
5b61c6a7
GM
1202 (let ((buffer-undo-list t)
1203 (wait-for-input t))
f862008d 1204 (unwind-protect
8baabd2a 1205 (when (not (input-pending-p))
f862008d
RS
1206 (goto-char (point-max))
1207 ;; The convention for this piece of code is that
1208 ;; each piece of output starts with one or two newlines
1209 ;; and does not end with any newlines.
1210 (insert "Welcome to GNU Emacs")
1211 (if (eq system-type 'gnu/linux)
1212 (insert ", one component of a Linux-based GNU system."))
1213 (insert "\n")
5b61c6a7 1214
acfd1011 1215 (if (assq 'display (frame-parameters))
5b61c6a7 1216
8ad8561b
GM
1217 (if (or (and (display-color-p)
1218 (image-type-available-p 'xpm))
13f93dee 1219 (image-type-available-p 'pbm))
5b61c6a7
GM
1220 (progn
1221 (setq wait-for-input nil)
1222 (fancy-splash-screens))
ce9ded5d
GM
1223 (progn
1224 (insert "\
926aa0ee 1225You can do basic editing with the menu bar and scroll bar using the mouse.
acfd1011
RS
1226
1227Useful Files menu items:
1228Exit Emacs (or type Control-x followed by Control-c)
1229Recover Session recover files you were editing before a crash
1230
1231Important Help menu items:
1232Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently.
b11d37de 1233Emacs FAQ Frequently asked questions and answers
acfd1011
RS
1234\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
1235Copying Conditions Conditions for redistributing and changing Emacs.
1236Getting New Versions How to obtain the latest version of Emacs.
1237")
ce9ded5d 1238 (insert "\n\n" (emacs-version)
49939379 1239 "
ce9ded5d 1240Copyright (C) 2000 Free Software Foundation, Inc.")))
5b61c6a7 1241
acfd1011
RS
1242 ;; If keys have their default meanings,
1243 ;; use precomputed string to save lots of time.
1244 (if (and (eq (key-binding "\C-h") 'help-command)
1245 (eq (key-binding "\C-xu") 'advertised-undo)
1246 (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
1247 (eq (key-binding "\C-ht") 'help-with-tutorial)
1248 (eq (key-binding "\C-hi") 'info)
1249 (eq (key-binding "\C-h\C-n") 'view-emacs-news))
1250 (insert "
3f5a3e12
RS
1251Get help C-h (Hold down CTRL and press h)
1252Undo changes C-x u Exit Emacs C-x C-c
1253Get a tutorial C-h t Use Info to read docs C-h i")
acfd1011
RS
1254 (insert (substitute-command-keys
1255 (format "\n
3f5a3e12
RS
1256Get help %s
1257Undo changes \\[advertised-undo]
1258Exit Emacs \\[save-buffers-kill-emacs]
1259Get a tutorial \\[help-with-tutorial]
1260Use Info to read docs \\[info]"
acfd1011
RS
1261 (let ((where (where-is-internal
1262 'help-command nil t)))
1263 (if where
1264 (key-description where)
1265 "M-x help"))))))
1266 ;; Say how to use the menu bar
1267 ;; if that is not with the mouse.
1268 (if (and (eq (key-binding "\M-`") 'tmm-menubar)
1269 (eq (key-binding [f10]) 'tmm-menubar))
1270 (insert "
3f5a3e12 1271Activate menubar F10 or ESC ` or M-`")
acfd1011
RS
1272 (insert (substitute-command-keys "
1273Activate menubar \\[tmm-menubar]")))
e65a6404 1274
66c24e1e 1275 (if (display-mouse-p)
acfd1011 1276 (insert "
3f5a3e12 1277Mode-specific menu C-mouse-3 (third button, with CTRL)"))
acfd1011
RS
1278 ;; Many users seem to have problems with these.
1279 (insert "
3f5a3e12
RS
1280\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
1281If you have no Meta key, you may instead type ESC followed by the character.)")
acfd1011 1282 (and auto-save-list-file-prefix
cfc75d05
EZ
1283 ;; Don't signal an error if the
1284 ;; directory for auto-save-list files
1285 ;; does not yet exist.
1286 (file-directory-p (file-name-directory
1287 auto-save-list-file-prefix))
acfd1011
RS
1288 (directory-files
1289 (file-name-directory auto-save-list-file-prefix)
1290 nil
1291 (concat "\\`"
1292 (regexp-quote (file-name-nondirectory
1293 auto-save-list-file-prefix)))
1294 t)
1295 (insert "\n\nIf an Emacs session crashed recently, "
1296 "type M-x recover-session RET\nto recover"
1297 " the files you were editing."))
1298
1299 (insert "\n\n" (emacs-version)
1300 "
e27e8d71 1301Copyright (C) 2000 Free Software Foundation, Inc.")
acfd1011
RS
1302 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
1303 (eq (key-binding "\C-h\C-d") 'describe-distribution)
1304 (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
1305 (insert
1306 "\n
a726e0d1 1307GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
70e00413
KH
1308Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1309of Emacs and modify it; type C-h C-c to see the conditions.
a726e0d1 1310Type C-h C-d for information on getting the latest version.")
acfd1011
RS
1311 (insert (substitute-command-keys
1312 "\n
a726e0d1 1313GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
70e00413
KH
1314Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1315of Emacs and modify it; type \\[describe-copying] to see the conditions.
acfd1011 1316Type \\[describe-distribution] for information on getting the latest version."))))
f862008d 1317 (goto-char (point-min))
fb3afe87 1318
f862008d 1319 (set-buffer-modified-p nil)
5b61c6a7
GM
1320 (when wait-for-input
1321 (sit-for 120)))
1322
f862008d
RS
1323 (with-current-buffer (get-buffer "*scratch*")
1324 (erase-buffer)
5b61c6a7
GM
1325 (when initial-scratch-message
1326 (insert initial-scratch-message))
dbeb499b 1327 (set-buffer-modified-p nil)))))))
5b61c6a7 1328
eca1cf26
RS
1329 ;; Delay 2 seconds after the init file error message
1330 ;; was displayed, so user can read it.
1331 (if init-file-had-error
1332 (sit-for 2))
09a1077c 1333 (let ((dir command-line-default-directory)
a726e0d1
JB
1334 (file-count 0)
1335 first-file-buffer
14d9a663 1336 tem
49939379 1337 just-files;; t if this follows the magic -- option.
14d9a663
RS
1338 ;; This includes our standard options' long versions
1339 ;; and long versions of what's on command-switch-alist.
1340 (longopts
1341 (append '(("--funcall") ("--load") ("--insert") ("--kill")
dc2cd811
GM
1342 ("--directory") ("--eval") ("--execute")
1343 ("--find-file") ("--visit") ("--file"))
ffaf8bbb
SM
1344 (mapcar (lambda (elt)
1345 (list (concat "-" (car elt))))
14d9a663 1346 command-switch-alist)))
a726e0d1 1347 (line 0))
14d9a663
RS
1348
1349 ;; Add the long X options to longopts.
1350 (setq tem command-line-x-option-alist)
1351 (while tem
1352 (if (string-match "^--" (car (car tem)))
1353 (setq longopts (cons (list (car (car tem))) longopts)))
1354 (setq tem (cdr tem)))
1355
1356 ;; Loop, processing options.
1357 (while (and command-line-args-left)
3f53ddd0
RS
1358 (let* ((argi (car command-line-args-left))
1359 (orig-argi argi)
14d9a663 1360 argval completion
aba66e2a
RS
1361 ;; List of directories specified in -L/--directory,
1362 ;; in reverse of the order specified.
1363 extra-load-path
1364 (initial-load-path load-path))
a726e0d1 1365 (setq command-line-args-left (cdr command-line-args-left))
3f53ddd0 1366
14d9a663
RS
1367 ;; Do preliminary decoding of the option.
1368 (if just-files
1369 ;; After --, don't look for options; treat all args as files.
1370 (setq argi "")
1371 ;; Convert long options to ordinary options
1372 ;; and separate out an attached option argument into argval.
1373 (if (string-match "^--[^=]*=" argi)
1374 (setq argval (substring argi (match-end 0))
1375 argi (substring argi 0 (1- (match-end 0)))))
1376 (if (equal argi "--")
1377 (setq completion nil)
1378 (setq completion (try-completion argi longopts)))
1379 (if (eq completion t)
1380 (setq argi (substring argi 1))
1381 (if (stringp completion)
1382 (let ((elt (assoc completion longopts)))
1383 (or elt
1384 (error "Option `%s' is ambiguous" argi))
1385 (setq argi (substring (car elt) 1)))
1386 (setq argval nil argi orig-argi))))
3f53ddd0
RS
1387
1388 ;; Execute the option.
a726e0d1 1389 (cond ((setq tem (assoc argi command-switch-alist))
3f53ddd0
RS
1390 (if argval
1391 (let ((command-line-args-left
1392 (cons argval command-line-args-left)))
1393 (funcall (cdr tem) argi))
1394 (funcall (cdr tem) argi)))
dc2cd811 1395
49939379 1396 ((or (string-equal argi "-f") ;what the manual claims
a726e0d1
JB
1397 (string-equal argi "-funcall")
1398 (string-equal argi "-e")) ; what the source used to say
3f53ddd0
RS
1399 (if argval
1400 (setq tem (intern argval))
1401 (setq tem (intern (car command-line-args-left)))
1402 (setq command-line-args-left (cdr command-line-args-left)))
1908c565
RS
1403 (if (arrayp (symbol-function tem))
1404 (command-execute tem)
1405 (funcall tem)))
dc2cd811
GM
1406
1407 ((or (string-equal argi "-eval")
1408 (string-equal argi "-execute"))
e6b75e30
RS
1409 (if argval
1410 (setq tem argval)
1411 (setq tem (car command-line-args-left))
1412 (setq command-line-args-left (cdr command-line-args-left)))
955093c9 1413 (eval (read tem)))
aba66e2a 1414 ;; Set the default directory as specified in -L.
dc2cd811 1415
aba66e2a
RS
1416 ((or (string-equal argi "-L")
1417 (string-equal argi "-directory"))
1418 (if argval
1419 (setq tem argval)
1420 (setq tem (car command-line-args-left)
1421 command-line-args-left (cdr command-line-args-left)))
47c7adae 1422 (setq tem (command-line-normalize-file-name tem))
aba66e2a
RS
1423 (setq extra-load-path
1424 (cons (expand-file-name tem) extra-load-path))
1425 (setq load-path (append (nreverse extra-load-path)
1426 initial-load-path)))
dc2cd811 1427
a726e0d1
JB
1428 ((or (string-equal argi "-l")
1429 (string-equal argi "-load"))
3f53ddd0
RS
1430 (if argval
1431 (setq tem argval)
1432 (setq tem (car command-line-args-left)
1433 command-line-args-left (cdr command-line-args-left)))
47c7adae 1434 (let ((file (command-line-normalize-file-name tem)))
a726e0d1
JB
1435 ;; Take file from default dir if it exists there;
1436 ;; otherwise let `load' search for it.
1437 (if (file-exists-p (expand-file-name file))
1438 (setq file (expand-file-name file)))
3f53ddd0 1439 (load file nil t)))
dc2cd811 1440
fbce8654 1441 ((string-equal argi "-insert")
3f53ddd0
RS
1442 (if argval
1443 (setq tem argval)
1444 (setq tem (car command-line-args-left)
1445 command-line-args-left (cdr command-line-args-left)))
2d2aae54
EN
1446 (or (stringp tem)
1447 (error "File name omitted from `-insert' option"))
47c7adae 1448 (insert-file-contents (command-line-normalize-file-name tem)))
dc2cd811 1449
a726e0d1
JB
1450 ((string-equal argi "-kill")
1451 (kill-emacs t))
dc2cd811 1452
a726e0d1
JB
1453 ((string-match "^\\+[0-9]+\\'" argi)
1454 (setq line (string-to-int argi)))
dc2cd811 1455
b3afdeb8
RS
1456 ((setq tem (assoc argi command-line-x-option-alist))
1457 ;; Ignore X-windows options and their args if not using X.
1458 (setq command-line-args-left
1459 (nthcdr (nth 1 tem) command-line-args-left)))
dc2cd811 1460
14d9a663 1461 ((or (string-equal argi "-find-file")
dc2cd811 1462 (string-equal argi "-file")
14d9a663
RS
1463 (string-equal argi "-visit"))
1464 ;; An explicit option to specify visiting a file.
dc2cd811
GM
1465 (if argval
1466 (setq tem argval)
1467 (setq tem (car command-line-args-left)
1468 command-line-args-left (cdr command-line-args-left)))
1469 (unless (stringp tem)
1470 (error "File name omitted from `%s' option" argi))
14d9a663 1471 (setq file-count (1+ file-count))
dc2cd811
GM
1472 (let ((file (expand-file-name
1473 (command-line-normalize-file-name tem) dir)))
14d9a663
RS
1474 (if (= file-count 1)
1475 (setq first-file-buffer (find-file file))
1476 (find-file-other-window file)))
1477 (or (zerop line)
1478 (goto-line line))
1479 (setq line 0))
dc2cd811 1480
f7ad212d 1481 ((equal argi "--")
14d9a663 1482 (setq just-files t))
a726e0d1
JB
1483 (t
1484 ;; We have almost exhausted our options. See if the
1485 ;; user has made any other command-line options available
1486 (let ((hooks command-line-functions);; lrs 7/31/89
1487 (did-hook nil))
1488 (while (and hooks
1489 (not (setq did-hook (funcall (car hooks)))))
1490 (setq hooks (cdr hooks)))
1491 (if (not did-hook)
1492 ;; Ok, presume that the argument is a file name
1493 (progn
7a79b90c
RS
1494 (if (string-match "\\`-" argi)
1495 (error "Unknown option `%s'" argi))
a726e0d1 1496 (setq file-count (1+ file-count))
14d9a663
RS
1497 (let ((file
1498 (expand-file-name
1499 (command-line-normalize-file-name orig-argi)
1500 dir)))
1501 (if (= file-count 1)
1502 (setq first-file-buffer (find-file file))
1503 (find-file-other-window file)))
a726e0d1
JB
1504 (or (zerop line)
1505 (goto-line line))
1506 (setq line 0))))))))
1507 ;; If 3 or more files visited, and not all visible,
1508 ;; show user what they all are.
ac707ebc
RS
1509 (and (> file-count 2)
1510 (not noninteractive)
1511 (or (get-buffer-window first-file-buffer)
1512 (progn (other-window 1)
1513 (buffer-menu)))))))
c88ab9ce 1514
49939379 1515
47c7adae
RS
1516(defun command-line-normalize-file-name (file)
1517 "Collapse multiple slashes to one, to handle non-Emacs file names."
6b9e794f
RS
1518 (save-match-data
1519 ;; Use arg 1 so that we don't collapse // at the start of the file name.
1520 ;; That is significant on some systems.
1521 ;; However, /// at the beginning is supposed to mean just /, not //.
1522 (if (string-match "^///+" file)
1523 (setq file (replace-match "/" t t file)))
1524 (while (string-match "//+" file 1)
1525 (setq file (replace-match "/" t t file)))
1526 file))
47c7adae 1527
c88ab9ce 1528;;; startup.el ends here