*** empty log message ***
[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.
481 (frame-set-background-mode (selected-frame)))
482
6f2c86fa
KH
483 ;; Now we know the user's default font, so add it to the menu.
484 (if (fboundp 'font-menu-add-default)
485 (font-menu-add-default))
486 (and window-setup-hook
487 (run-hooks 'window-setup-hook))
488 (or menubar-bindings-done
66c24e1e
EZ
489 (if (display-popup-menus-p)
490 (precompute-menubar-bindings)))))))
6f2c86fa
KH
491
492;; Precompute the keyboard equivalents in the menu bar items.
493(defun precompute-menubar-bindings ()
365636dc
RS
494 (let ((submap (lookup-key global-map [menu-bar])))
495 (while submap
496 (and (consp (car submap))
497 (symbolp (car (car submap)))
498 (stringp (car-safe (cdr (car submap))))
499 (keymapp (cdr (cdr (car submap))))
a18042d7
RS
500 (progn
501 (x-popup-menu nil (cdr (cdr (car submap))))
502 (if purify-flag
503 (garbage-collect))))
365636dc 504 (setq submap (cdr submap))))
5b61c6a7 505 (setq define-key-rebound-commands t))
a726e0d1 506
c381f482
EZ
507;; Command-line options supported by tty's:
508(defconst tty-long-option-alist
509 '(("--name" . "-name")
510 ("--title" . "-T")
511 ("--reverse-video" . "-reverse")
512 ("--foreground-color" . "-fg")
513 ("--background-color" . "-bg")))
514
515;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc.
516(defun tty-handle-args (args)
517 (let ((rest nil))
518 (message "%s" args)
519 (while (and args
520 (not (equal (car args) "--")))
521 (let* ((this (car args))
522 (orig-this this)
523 completion argval)
524 (setq args (cdr args))
525 ;; Check for long options with attached arguments
526 ;; and separate out the attached option argument into argval.
527 (if (string-match "^--[^=]*=" this)
528 (setq argval (substring this (match-end 0))
529 this (substring this 0 (1- (match-end 0)))))
530 (when (string-match "^--" this)
531 (setq completion (try-completion this tty-long-option-alist))
532 (if (eq completion t)
533 ;; Exact match for long option.
534 (setq this (cdr (assoc this tty-long-option-alist)))
535 (if (stringp completion)
536 (let ((elt (assoc completion tty-long-option-alist)))
537 ;; Check for abbreviated long option.
538 (or elt
539 (error "Option `%s' is ambiguous" this))
540 (setq this (cdr elt)))
541 ;; Check for a short option.
542 (setq argval nil this orig-this))))
543 (cond ((or (string= this "-fg") (string= this "-foreground"))
544 (or argval (setq argval (car args) args (cdr args)))
545 (setq default-frame-alist
546 (cons (cons 'foreground-color argval)
547 default-frame-alist)))
548 ((or (string= this "-bg") (string= this "-background"))
549 (or argval (setq argval (car args) args (cdr args)))
550 (setq default-frame-alist
551 (cons (cons 'background-color argval)
552 default-frame-alist)))
553 ((or (string= this "-T") (string= this "-name"))
554 (or argval (setq argval (car args) args (cdr args)))
555 (setq default-frame-alist
556 (cons
557 (cons 'title
558 (if (stringp argval)
559 argval
560 (let ((case-fold-search t)
561 i)
562 (setq argval (invocation-name))
563
564 ;; Change any . or * characters in name to
565 ;; hyphens, so as to emulate behavior on X.
566 (while
567 (setq i (string-match "[.*]" argval))
568 (aset argval i ?-))
569 argval)))
570 default-frame-alist)))
571 ((or (string= this "-r")
572 (string= this "-rv")
573 (string= this "-reverse"))
574 (setq default-frame-alist
575 (cons '(reverse . t)
576 default-frame-alist)))
577 (t (setq rest (cons this rest))))))
578 (nreverse rest)))
579
a726e0d1 580(defun command-line ()
09a1077c
RS
581 (setq command-line-default-directory default-directory)
582
849eedba
RS
583 ;; Choose a reasonable location for temporary files.
584 (setq temporary-file-directory
585 (file-name-as-directory
586 (cond ((memq system-type '(ms-dos windows-nt))
587 (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
588 ((memq system-type '(vax-vms axp-vms))
589 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
590 (t
591 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))))
607f86f5
EZ
592 (setq small-temporary-file-directory
593 (if (eq system-type 'ms-dos)
f5568df0 594 (getenv "TMPDIR")))
849eedba 595
74f2ab06 596 ;; See if we should import version-control from the environment variable.
a726e0d1
JB
597 (let ((vc (getenv "VERSION_CONTROL")))
598 (cond ((eq vc nil)) ;don't do anything if not set
599 ((or (string= vc "t")
600 (string= vc "numbered"))
601 (setq version-control t))
602 ((or (string= vc "nil")
603 (string= vc "existing"))
604 (setq version-control nil))
605 ((or (string= vc "never")
606 (string= vc "simple"))
607 (setq version-control 'never))))
608
64ed733a 609 (set-locale-environment nil)
e9d8e8c7 610
79058860
JB
611 ;;! This has been commented out; I currently find the behavior when
612 ;;! split-window-keep-point is nil disturbing, but if I can get used
613 ;;! to it, then it would be better to eliminate the option.
614 ;;! ;; Choose a good default value for split-window-keep-point.
615 ;;! (setq split-window-keep-point (> baud-rate 2400))
f35fe3c6 616
d4308a4d
EZ
617 ;; Set the default strings to display in mode line for
618 ;; end-of-line formats that aren't native to this platform.
619 (cond
620 ((memq system-type '(ms-dos windows-nt emx))
621 (setq eol-mnemonic-unix "(Unix)")
622 (setq eol-mnemonic-mac "(Mac)"))
623 ;; Mac-specific settings should come here, once there's a
624 ;; system-type symbol specific to MacOS.
625 (t ; this is for Unix/GNU/Linux systems
626 (setq eol-mnemonic-dos "(DOS)")
627 (setq eol-mnemonic-mac "(Mac)")))
628
a726e0d1 629 ;; Read window system's init file if using a window system.
1ed14cfd
RS
630 (condition-case error
631 (if (and window-system (not noninteractive))
632 (load (concat term-file-prefix
633 (symbol-name window-system)
634 "-win")
635 ;; Every window system should have a startup file;
636 ;; barf if we can't find it.
637 nil t))
638 ;; If we can't read it, print the error message and exit.
639 (error
2677ad61
RS
640 (princ
641 (if (eq (car error) 'error)
642 (apply 'concat (cdr error))
643 (if (memq 'file-error (get (car error) 'error-conditions))
644 (format "%s: %s"
645 (nth 1 error)
ffaf8bbb 646 (mapconcat (lambda (obj) (prin1-to-string obj t))
2677ad61
RS
647 (cdr (cdr error)) ", "))
648 (format "%s: %s"
649 (get (car error) 'error-message)
ffaf8bbb 650 (mapconcat (lambda (obj) (prin1-to-string obj t))
2677ad61
RS
651 (cdr error) ", "))))
652 'external-debugging-output)
653 (setq window-system nil)
1ed14cfd 654 (kill-emacs)))
a726e0d1 655
c381f482
EZ
656 ;; Windowed displays do this inside their *-win.el.
657 (when (and (not (display-graphic-p))
658 (not noninteractive))
659 (setq command-line-args (tty-handle-args command-line-args)))
660
03e3c30a
JB
661 (let ((done nil)
662 (args (cdr command-line-args)))
663
a726e0d1
JB
664 ;; Figure out which user's init file to load,
665 ;; either from the environment or from the options.
666 (setq init-file-user (if noninteractive nil (user-login-name)))
667 ;; If user has not done su, use current $HOME to find .emacs.
668 (and init-file-user (string= init-file-user (user-real-login-name))
669 (setq init-file-user ""))
03e3c30a
JB
670
671 ;; Process the command-line args, and delete the arguments
672 ;; processed. This is consistent with the way main in emacs.c
673 ;; does things.
a726e0d1 674 (while (and (not done) args)
096b7031 675 (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
a360cae9 676 ("--debug-init") ("--iconic") ("--icon-type")))
096b7031
KH
677 (argi (car args))
678 (argval nil))
452e9090
RS
679 ;; Handle --OPTION=VALUE format.
680 (if (and (string-match "\\`--" argi)
681 (string-match "=" argi))
a981e7ff
KH
682 (setq argval (substring argi (match-end 0))
683 argi (substring argi 0 (match-beginning 0))))
f7ad212d
RS
684 (or (equal argi "--")
685 (let ((completion (try-completion argi longopts)))
686 (if (eq completion t)
687 (setq argi (substring argi 1))
688 (if (stringp completion)
689 (let ((elt (assoc completion longopts)))
690 (or elt
691 (error "Option `%s' is ambiguous" argi))
692 (setq argi (substring (car elt) 1)))
693 (setq argval nil)))))
a726e0d1
JB
694 (cond
695 ((or (string-equal argi "-q")
696 (string-equal argi "-no-init-file"))
697 (setq init-file-user nil
698 args (cdr args)))
699 ((or (string-equal argi "-u")
700 (string-equal argi "-user"))
096b7031 701 (or argval
d3bea05f
RS
702 (setq args (cdr args)
703 argval (car args)))
096b7031
KH
704 (setq init-file-user argval
705 argval nil
a726e0d1 706 args (cdr args)))
b7444d31
RS
707 ((string-equal argi "-no-site-file")
708 (setq site-run-file nil
709 args (cdr args)))
a726e0d1
JB
710 ((string-equal argi "-debug-init")
711 (setq init-file-debug t
712 args (cdr args)))
a360cae9
RS
713 ((string-equal argi "-iconic")
714 (setq initial-frame-alist
715 (cons '(visibility . icon) initial-frame-alist))
716 (setq args (cdr args)))
717 ((or (string-equal argi "-icon-type")
718 (string-equal argi "-i")
719 (string-equal argi "-itype"))
720 (setq default-frame-alist
721 (cons '(icon-type . t) default-frame-alist))
722 (setq args (cdr args)))
096b7031
KH
723 (t (setq done t)))
724 ;; Was argval set but not used?
725 (and argval
726 (error "Option `%s' doesn't allow an argument" argi))))
727
03e3c30a 728 ;; Re-attach the program name to the front of the arg list.
4048e56d 729 (and command-line-args (setcdr command-line-args args)))
a726e0d1 730
c722566c 731 ;; Under X Windows, this creates the X frame and deletes the terminal frame.
853ccbd5
RS
732 (if (fboundp 'frame-initialize)
733 (frame-initialize))
1fe0333f 734 ;; If frame was created with a menu bar, set menu-bar-mode on.
ffaf8bbb
SM
735 (if (and (not noninteractive)
736 (or (not (memq window-system '(x w32)))
737 (> (cdr (assq 'menu-bar-lines (frame-parameters))) 0)))
1fe0333f 738 (menu-bar-mode t))
c722566c 739
7d1eb6a4
GM
740 ;; If frame was created with a tool bar, switch tool-bar-mode on.
741 (when (and (not noninteractive)
66c24e1e 742 (display-graphic-p)
7d1eb6a4
GM
743 (> (frame-parameter nil 'tool-bar-lines) 0))
744 (tool-bar-mode t))
745
6753393b
GM
746 ;; Can't do this init in defcustom because window-system isn't set.
747 (when (and (not noninteractive)
748 (not (eq system-type 'ms-dos))
749 (memq window-system '(x w32)))
750 (setq-default blink-cursor t)
751 (blink-cursor-mode 1))
752
1592c1ef
EZ
753 ;; Register default TTY colors for the case the terminal hasn't a
754 ;; terminal init file.
755 (or (memq window-system '(x w32))
756 (not (tty-display-color-p))
757 (let* ((colors (cond ((eq window-system 'pc)
758 msdos-color-values)
759 ((eq system-type 'windows-nt)
760 w32-tty-standard-colors)
761 (t tty-standard-colors)))
762 (color (car colors)))
763 (while colors
764 (tty-color-define (car color) (cadr color) (cddr color))
765 (setq colors (cdr colors) color (car colors)))
766 ;; Modifying color mappings means realized faces don't
767 ;; use the right colors, so clear them.
768 (clear-face-cache)))
769
e3bd99f5 770 (run-hooks 'before-init-hook)
3fc958a4 771
09973c54
RM
772 ;; Run the site-start library if it exists. The point of this file is
773 ;; that it is run before .emacs. There is no point in doing this after
774 ;; .emacs; that is useless.
b7444d31
RS
775 (if site-run-file
776 (load site-run-file t t))
09973c54 777
8a988f45
RS
778 ;; Sites should not disable this. Only individuals should disable
779 ;; the startup message.
780 (setq inhibit-startup-message nil)
781
a726e0d1 782 ;; Load that user's init file, or the default one, or none.
3d1b78f0
RS
783 (let (debug-on-error-from-init-file
784 debug-on-error-should-be-set
785 (debug-on-error-initial
a460d4e3
RS
786 (if (eq init-file-debug t) 'startup init-file-debug))
787 (orig-enable-multibyte default-enable-multibyte-characters))
3d1b78f0
RS
788 (let ((debug-on-error debug-on-error-initial)
789 ;; This function actually reads the init files.
790 (inner
791 (function
792 (lambda ()
793 (if init-file-user
042dc034 794 (let ((user-init-file-1
a4c5c705
RS
795 (cond
796 ((eq system-type 'ms-dos)
797 (concat "~" init-file-user "/_emacs"))
7d1aa45d 798 ((eq system-type 'windows-nt)
06789559 799 (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
521736d1
RS
800 "~/.emacs"
801 "~/_emacs"))
a4c5c705
RS
802 ((eq system-type 'vax-vms)
803 "sys$login:.emacs")
804 (t
042dc034
KH
805 (concat "~" init-file-user "/.emacs")))))
806 ;; This tells `load' to store the file name found
807 ;; into user-init-file.
808 (setq user-init-file t)
809 (load user-init-file-1 t t)
694e6b24
KH
810 ;; If we did not find the user's init file,
811 ;; set user-init-file conclusively to nil;
812 ;; don't let it be set from default.el.
813 (if (eq user-init-file t)
814 (setq user-init-file nil))
46cfd295
DL
815 ;; If we loaded a compiled file, set
816 ;; `user-init-file' to the source version if that
817 ;; exists.
c047136e
GM
818 (when (and user-init-file
819 (equal (file-name-extension user-init-file)
820 "elc")
821 (file-exists-p user-init-file-1))
822 (when (file-newer-than-file-p
823 user-init-file-1 user-init-file)
824 (message "Warning: %s is newer than %s"
825 user-init-file-1 user-init-file)
826 (sit-for 1))
827 (setq user-init-file user-init-file-1))
a4c5c705
RS
828 (or inhibit-default-init
829 (let ((inhibit-startup-message nil))
830 ;; Users are supposed to be told their rights.
831 ;; (Plus how to get help and how to undo.)
832 ;; Don't you dare turn this off for anyone
833 ;; except yourself.
834 (load "default" t t)))))))))
3d1b78f0
RS
835 (if init-file-debug
836 ;; Do this without a condition-case if the user wants to debug.
837 (funcall inner)
838 (condition-case error
839 (progn
840 (funcall inner)
841 (setq init-file-had-error nil))
42bb6910
GM
842 (error
843 (let ((message-log-max nil))
844 (save-excursion
845 (set-buffer (get-buffer-create "*Messages*"))
846 (insert "\n\n"
847 (format "An error has occurred while loading `%s':\n\n"
848 user-init-file)
849 (format "%s%s%s"
850 (get (car error) 'error-message)
851 (if (cdr error) ": " "")
852 (mapconcat 'prin1-to-string (cdr error) ", "))
853 "\n\n"
854 "To ensure normal operation, you should investigate the cause\n"
855 "of the error in your initialization file and remove it. Start\n"
856 "Emacs with the `--debug-init' option to view a complete error\n"
857 "backtrace\n"))
858 (message "Error in init file: %s%s%s"
859 (get (car error) 'error-message)
860 (if (cdr error) ": " "")
861 (mapconcat 'prin1-to-string (cdr error) ", "))
862 (pop-to-buffer "*Messages*")
863 (setq init-file-had-error t)))))
ad2aeb8d 864 ;; If we can tell that the init file altered debug-on-error,
3d1b78f0
RS
865 ;; arrange to preserve the value that it set up.
866 (or (eq debug-on-error debug-on-error-initial)
867 (setq debug-on-error-should-be-set t
868 debug-on-error-from-init-file debug-on-error)))
869 (if debug-on-error-should-be-set
a460d4e3
RS
870 (setq debug-on-error debug-on-error-from-init-file))
871 (unless (or default-enable-multibyte-characters
872 (eq orig-enable-multibyte default-enable-multibyte-characters))
873 ;; Init file changed to unibyte. Reset existing multibyte
874 ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*).
875 ;; Arguably this should only be done if they're free of
876 ;; multibyte characters.
877 (mapcar (lambda (buffer)
878 (with-current-buffer buffer
879 (if enable-multibyte-characters
880 (set-buffer-multibyte nil))))
881 (buffer-list))
882 ;; Also re-set the language environment in case it was
883 ;; originally done before unibyte was set and is sensitive to
884 ;; unibyte (display table, terminal coding system &c).
885 (set-language-environment current-language-environment)))
3fc958a4 886
556f7d77
RS
887 ;; Do this here in case the init file sets mail-host-address.
888 (or user-mail-address
889 (setq user-mail-address (concat (user-login-name) "@"
890 (or mail-host-address
891 (system-name)))))
892
e3bd99f5
RM
893 (run-hooks 'after-init-hook)
894
a726e0d1
JB
895 ;; If *scratch* exists and init file didn't change its mode, initialize it.
896 (if (get-buffer "*scratch*")
897 (save-excursion
898 (set-buffer "*scratch*")
899 (if (eq major-mode 'fundamental-mode)
900 (funcall initial-major-mode))))
e724900d 901
a726e0d1
JB
902 ;; Load library for our terminal type.
903 ;; User init file can set term-file-prefix to nil to prevent this.
904 (and term-file-prefix (not noninteractive) (not window-system)
905 (let ((term (getenv "TERM"))
906 hyphend)
907 (while (and term
908 (not (load (concat term-file-prefix term) t t)))
909 ;; Strip off last hyphen and what follows, then try again
910 (if (setq hyphend (string-match "[-_][^-_]+$" term))
911 (setq term (substring term 0 hyphend))
912 (setq term nil)))))
913
03e3c30a 914 ;; Process the remaining args.
a726e0d1
JB
915 (command-line-1 (cdr command-line-args))
916
917 ;; If -batch, terminate after processing the command options.
918 (if noninteractive (kill-emacs t)))
919
46cfd295 920(defcustom initial-scratch-message (purecopy "\
3b79c219
GM
921;; This buffer is for notes you don't want to save, and for Lisp evaluation.
922;; If you want to create a file, visit that file with C-x C-f,
923;; then enter the text in that file's own buffer.
9fe3219e 924
46cfd295 925")
9fe3219e
RS
926 "Initial message displayed in *scratch* buffer at startup.
927If this is nil, no message will be displayed."
928 :type 'string)
929
ce9ded5d
GM
930\f
931;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
932;;; Fancy splash screen
933;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
934
935(defvar fancy-splash-text
26ff68aa 936 '((:face variable-pitch
926aa0ee
GM
937 "You can do basic editing with the menu bar and scroll bar \
938using the mouse.\n\n"
26ff68aa 939 :face (variable-pitch :weight bold)
ce9ded5d 940 "Useful Files menu items:\n"
26ff68aa 941 :face variable-pitch "\
ce9ded5d
GM
942Exit Emacs (or type Control-x followed by Control-c)
943Recover Session recover files you were editing before a crash
944
945
946"
947 )
558f409e 948 (:face variable-pitch
926aa0ee
GM
949 "You can do basic editing with the menu bar and scroll bar \
950using the mouse.\n\n"
26ff68aa 951 :face (variable-pitch :weight bold)
ce9ded5d 952 "Important Help menu items:\n"
26ff68aa 953 :face variable-pitch "\
ce9ded5d
GM
954Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently.
955Emacs FAQ Frequently asked questions and answers
956\(Non)Warranty GNU Emacs comes with "
26ff68aa 957 :face (variable-pitch :slant oblique)
ce9ded5d 958 "ABSOLUTELY NO WARRANTY\n"
26ff68aa 959 :face variable-pitch
d3c5bad2
GM
960 "\
961Copying Conditions Conditions for redistributing and changing Emacs\n"))
ce9ded5d
GM
962 "A list of texts to show in the middle part of splash screens.
963Each element in the list should be a list of strings or pairs
964`:face FACE', like `fancy-splash-insert' accepts them.")
965
966
fb275c02 967(defgroup fancy-splash-screen ()
a01bb1db 968 "Fancy splash screen when Emacs starts."
fb275c02 969 :version "21.1"
a01bb1db
GM
970 :group 'initialization)
971
972
ce9ded5d 973(defcustom fancy-splash-delay 5
49939379 974 "*Delay in seconds between splash screens."
a01bb1db 975 :group 'fancy-splash-screen
ce9ded5d
GM
976 :type 'integer)
977
978
8ad8561b
GM
979(defcustom fancy-splash-image nil
980 "*The image to show in the splash screens, or nil for defaults."
a01bb1db 981 :group 'fancy-splash-screen
8ad8561b
GM
982 :type '(choice (const :tag "Default" nil)
983 (file :tag "File")))
ce9ded5d
GM
984
985
f645586f
GM
986;; These are temporary storage areas for the splash screen display.
987
988(defvar fancy-current-text nil)
989(defvar fancy-splash-help-echo nil)
990
991
ce9ded5d
GM
992(defun fancy-splash-insert (&rest args)
993 "Insert text into the current buffer, with faces.
994Arguments from ARGS should be either strings or pairs `:face FACE',
995where FACE is a valid face specification, as it can be used with
996`put-text-properties'."
997 (let ((current-face nil))
998 (while args
999 (if (eq (car args) :face)
1000 (setq args (cdr args) current-face (car args))
f645586f
GM
1001 (insert (propertize (car args)
1002 'face current-face
1003 'help-echo fancy-splash-help-echo)))
ce9ded5d
GM
1004 (setq args (cdr args)))))
1005
1006
1007(defun fancy-splash-head ()
1008 "Insert the head part of the splash screen into the current buffer."
8ad8561b 1009 (let* ((img (create-image (or fancy-splash-image
d7a7f131
DL
1010 (if (and (display-color-p)
1011 (image-type-available-p 'xpm))
13f93dee 1012 "splash.xpm" "splash.pbm"))))
ce9ded5d
GM
1013 (image-width (and img (car (image-size img))))
1014 (window-width (window-width (selected-window))))
1015 (when img
1016 (when (> window-width image-width)
f645586f 1017 ;; Center the image in the window.
ce9ded5d
GM
1018 (let ((pos (/ (- window-width image-width) 2)))
1019 (insert (propertize " " 'display `(space :align-to ,pos))))
f645586f
GM
1020
1021 ;; Change the color of the XPM version of the splash image
1022 ;; so that it is visible with a dark frame background.
8ad8561b
GM
1023 (when (and (memq 'xpm img)
1024 (eq (frame-parameter nil 'background-mode) 'dark))
49939379 1025 (setq img (append img '(:color-symbols (("#000000" . "gray"))))))
f645586f
GM
1026
1027 ;; Insert the image with a help-echo and a keymap.
1028 (let ((map (make-sparse-keymap))
a622451f 1029 (help-echo "mouse-2: browse http://www.gnu.org/"))
f645586f
GM
1030 (define-key map [mouse-2]
1031 (lambda ()
1032 (interactive)
a622451f 1033 (browse-url "http://www.gnu.org/")
f645586f
GM
1034 (throw 'exit nil)))
1035 (define-key map [down-mouse-2] 'ignore)
1036 (define-key map [up-mouse-2] 'ignore)
1037 (insert-image img (propertize "xxx" 'help-echo help-echo
1038 'keymap map)))
ce9ded5d 1039 (insert "\n"))))
b831c087
GM
1040 (if (eq system-type 'gnu/linux)
1041 (fancy-splash-insert
1042 :face '(variable-pitch :foreground "red")
1043 "GNU Emacs is one component of a Linux-based GNU system.")
ce9ded5d
GM
1044 (fancy-splash-insert
1045 :face '(variable-pitch :foreground "red")
b831c087 1046 "GNU Emacs is one component of the GNU operating system."))
ce9ded5d
GM
1047 (insert "\n"))
1048
1049
1050(defun fancy-splash-tail ()
1051 "Insert the tail part of the splash screen into the current buffer."
95fadcca
GM
1052 (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
1053 "cyan" "darkblue")))
1054 (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
1055 "\nThis is "
1056 (emacs-version)
1057 "\n"
1058 :face '(variable-pitch :height 0.5)
1059 "Copyright (C) 2000 Free Software Foundation, Inc.")))
ce9ded5d
GM
1060
1061
f645586f
GM
1062(defun fancy-splash-screens-1 (buffer)
1063 "Timer function displaying a splash screen."
1064 (unless fancy-current-text
1065 (setq fancy-current-text fancy-splash-text))
1066 (let ((text (car fancy-current-text)))
1067 (set-buffer buffer)
1068 (erase-buffer)
1069 (fancy-splash-head)
1070 (apply #'fancy-splash-insert text)
1071 (fancy-splash-tail)
1072 (unless (current-message)
1073 (message fancy-splash-help-echo))
1074 (set-buffer-modified-p nil)
dbeb499b 1075 (goto-char (point-min))
f645586f
GM
1076 (force-mode-line-update)
1077 (setq fancy-current-text (cdr fancy-current-text))))
1078
1079
1080(defun fancy-splash-default-action ()
1081 "Default action for events in the splash screen buffer."
1082 (interactive)
1083 (push last-command-event unread-command-events)
1084 (throw 'exit nil))
1085
1086
ce9ded5d 1087(defun fancy-splash-screens ()
f645586f 1088 "Display fancy splash screens when Emacs starts."
5b61c6a7
GM
1089 (setq fancy-splash-help-echo (startup-echo-area-message))
1090 (switch-to-buffer "GNU Emacs")
39250ec3 1091 (let ((old-busy-cursor display-busy-cursor)
5b61c6a7 1092 (splash-buffer (current-buffer))
5b61c6a7
GM
1093 timer)
1094 (unwind-protect
39250ec3 1095 (let ((map (make-sparse-keymap))
5b61c6a7 1096 (show-help-function nil))
39250ec3
SM
1097 (use-local-map map)
1098 (define-key map [t] 'fancy-splash-default-action)
5b61c6a7 1099 (define-key map [mouse-movement] 'ignore)
5b61c6a7
GM
1100 (setq cursor-type nil
1101 display-busy-cursor nil
754a29c9 1102 buffer-undo-list t
5b61c6a7
GM
1103 mode-line-format
1104 (propertize "---- %b %-" 'face '(:weight bold))
dada41e1
GM
1105 timer (run-with-timer 0 fancy-splash-delay
1106 #'fancy-splash-screens-1
5b61c6a7 1107 splash-buffer))
5b61c6a7 1108 (recursive-edit))
5b61c6a7 1109 (cancel-timer timer)
5b61c6a7
GM
1110 (setq display-busy-cursor old-busy-cursor)
1111 (kill-buffer splash-buffer))))
f645586f
GM
1112
1113
1114(defun startup-echo-area-message ()
1115 (if (eq (key-binding "\C-h\C-p") 'describe-project)
1116 "For information about the GNU Project and its goals, type C-h C-p."
1117 (substitute-command-keys
1118 "For information about the GNU Project and its goals, type \
1119\\[describe-project].")))
ce9ded5d
GM
1120
1121
49939379 1122(defun display-startup-echo-area-message ()
f645586f
GM
1123 (message (startup-echo-area-message)))
1124
49939379 1125
a726e0d1 1126(defun command-line-1 (command-line-args-left)
52320897 1127 (or noninteractive (input-pending-p) init-file-had-error
49939379
GM
1128 (and inhibit-startup-echo-area-message
1129 user-init-file
1130 (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
1131 (equal inhibit-startup-echo-area-message
1132 (if (string= init-file-user "")
1133 (user-login-name)
1134 init-file-user)))
1135 ;; Wasn't set with custom; see if .emacs has a setq.
1136 (let ((buffer (get-buffer-create " *temp*")))
1137 (prog1
1138 (condition-case nil
1139 (save-excursion
1140 (set-buffer buffer)
1141 (insert-file-contents user-init-file)
1142 (re-search-forward
1143 (concat
1144 "([ \t\n]*setq[ \t\n]+"
1145 "inhibit-startup-echo-area-message[ \t\n]+"
1146 (regexp-quote
1147 (prin1-to-string
1148 (if (string= init-file-user "")
1149 (user-login-name)
1150 init-file-user)))
1151 "[ \t\n]*)")
1152 nil t))
1153 (error nil))
1154 (kill-buffer buffer)))))
1155 (display-startup-echo-area-message))
a726e0d1
JB
1156 (if (null command-line-args-left)
1157 (cond ((and (not inhibit-startup-message) (not noninteractive)
1158 ;; Don't clobber a non-scratch buffer if init file
1159 ;; has selected it.
8baabd2a 1160 (string= (buffer-name) "*scratch*"))
a726e0d1
JB
1161 ;; If there are no switches to process, we might as well
1162 ;; run this hook now, and there may be some need to do it
1163 ;; before doing any output.
1164 (and term-setup-hook
1165 (run-hooks 'term-setup-hook))
1166 ;; Don't let the hook be run twice.
1167 (setq term-setup-hook nil)
4e1b1e72
JB
1168
1169 ;; It's important to notice the user settings before we
1170 ;; display the startup message; otherwise, the settings
1171 ;; won't take effect until the user gives the first
1172 ;; keystroke, and that's distracting.
5b61c6a7
GM
1173 (when (fboundp 'frame-notice-user-settings)
1174 (frame-notice-user-settings))
1175
1176 (when window-setup-hook
1177 (run-hooks 'window-setup-hook)
1178 (setq window-setup-hook nil))
1179
66c24e1e 1180 (when (display-popup-menus-p)
5b61c6a7
GM
1181 (precompute-menubar-bindings))
1182 (setq menubar-bindings-done t)
1183
fd11871a
RS
1184 ;; Do this now to avoid an annoying delay if the user
1185 ;; clicks the menu bar during the sit-for.
f862008d 1186 (when (= (buffer-size) 0)
5b61c6a7
GM
1187 (let ((buffer-undo-list t)
1188 (wait-for-input t))
f862008d 1189 (unwind-protect
8baabd2a 1190 (when (not (input-pending-p))
f862008d
RS
1191 (goto-char (point-max))
1192 ;; The convention for this piece of code is that
1193 ;; each piece of output starts with one or two newlines
1194 ;; and does not end with any newlines.
1195 (insert "Welcome to GNU Emacs")
1196 (if (eq system-type 'gnu/linux)
1197 (insert ", one component of a Linux-based GNU system."))
1198 (insert "\n")
5b61c6a7 1199
acfd1011 1200 (if (assq 'display (frame-parameters))
5b61c6a7 1201
8ad8561b
GM
1202 (if (or (and (display-color-p)
1203 (image-type-available-p 'xpm))
13f93dee 1204 (image-type-available-p 'pbm))
5b61c6a7
GM
1205 (progn
1206 (setq wait-for-input nil)
1207 (fancy-splash-screens))
ce9ded5d
GM
1208 (progn
1209 (insert "\
926aa0ee 1210You can do basic editing with the menu bar and scroll bar using the mouse.
acfd1011
RS
1211
1212Useful Files menu items:
1213Exit Emacs (or type Control-x followed by Control-c)
1214Recover Session recover files you were editing before a crash
1215
1216Important Help menu items:
1217Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently.
b11d37de 1218Emacs FAQ Frequently asked questions and answers
acfd1011
RS
1219\(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
1220Copying Conditions Conditions for redistributing and changing Emacs.
1221Getting New Versions How to obtain the latest version of Emacs.
1222")
ce9ded5d 1223 (insert "\n\n" (emacs-version)
49939379 1224 "
ce9ded5d 1225Copyright (C) 2000 Free Software Foundation, Inc.")))
5b61c6a7 1226
acfd1011
RS
1227 ;; If keys have their default meanings,
1228 ;; use precomputed string to save lots of time.
1229 (if (and (eq (key-binding "\C-h") 'help-command)
1230 (eq (key-binding "\C-xu") 'advertised-undo)
1231 (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
1232 (eq (key-binding "\C-ht") 'help-with-tutorial)
1233 (eq (key-binding "\C-hi") 'info)
1234 (eq (key-binding "\C-h\C-n") 'view-emacs-news))
1235 (insert "
3f5a3e12
RS
1236Get help C-h (Hold down CTRL and press h)
1237Undo changes C-x u Exit Emacs C-x C-c
1238Get a tutorial C-h t Use Info to read docs C-h i")
acfd1011
RS
1239 (insert (substitute-command-keys
1240 (format "\n
3f5a3e12
RS
1241Get help %s
1242Undo changes \\[advertised-undo]
1243Exit Emacs \\[save-buffers-kill-emacs]
1244Get a tutorial \\[help-with-tutorial]
1245Use Info to read docs \\[info]"
acfd1011
RS
1246 (let ((where (where-is-internal
1247 'help-command nil t)))
1248 (if where
1249 (key-description where)
1250 "M-x help"))))))
1251 ;; Say how to use the menu bar
1252 ;; if that is not with the mouse.
1253 (if (and (eq (key-binding "\M-`") 'tmm-menubar)
1254 (eq (key-binding [f10]) 'tmm-menubar))
1255 (insert "
3f5a3e12 1256Activate menubar F10 or ESC ` or M-`")
acfd1011
RS
1257 (insert (substitute-command-keys "
1258Activate menubar \\[tmm-menubar]")))
e65a6404 1259
66c24e1e 1260 (if (display-mouse-p)
acfd1011 1261 (insert "
3f5a3e12 1262Mode-specific menu C-mouse-3 (third button, with CTRL)"))
acfd1011
RS
1263 ;; Many users seem to have problems with these.
1264 (insert "
3f5a3e12
RS
1265\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
1266If you have no Meta key, you may instead type ESC followed by the character.)")
acfd1011 1267 (and auto-save-list-file-prefix
cfc75d05
EZ
1268 ;; Don't signal an error if the
1269 ;; directory for auto-save-list files
1270 ;; does not yet exist.
1271 (file-directory-p (file-name-directory
1272 auto-save-list-file-prefix))
acfd1011
RS
1273 (directory-files
1274 (file-name-directory auto-save-list-file-prefix)
1275 nil
1276 (concat "\\`"
1277 (regexp-quote (file-name-nondirectory
1278 auto-save-list-file-prefix)))
1279 t)
1280 (insert "\n\nIf an Emacs session crashed recently, "
1281 "type M-x recover-session RET\nto recover"
1282 " the files you were editing."))
1283
1284 (insert "\n\n" (emacs-version)
1285 "
e27e8d71 1286Copyright (C) 2000 Free Software Foundation, Inc.")
acfd1011
RS
1287 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
1288 (eq (key-binding "\C-h\C-d") 'describe-distribution)
1289 (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
1290 (insert
1291 "\n
a726e0d1 1292GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
70e00413
KH
1293Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1294of Emacs and modify it; type C-h C-c to see the conditions.
a726e0d1 1295Type C-h C-d for information on getting the latest version.")
acfd1011
RS
1296 (insert (substitute-command-keys
1297 "\n
a726e0d1 1298GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
70e00413
KH
1299Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1300of Emacs and modify it; type \\[describe-copying] to see the conditions.
acfd1011 1301Type \\[describe-distribution] for information on getting the latest version."))))
f862008d 1302 (goto-char (point-min))
fb3afe87 1303
f862008d 1304 (set-buffer-modified-p nil)
5b61c6a7
GM
1305 (when wait-for-input
1306 (sit-for 120)))
1307
f862008d
RS
1308 (with-current-buffer (get-buffer "*scratch*")
1309 (erase-buffer)
5b61c6a7
GM
1310 (when initial-scratch-message
1311 (insert initial-scratch-message))
dbeb499b 1312 (set-buffer-modified-p nil)))))))
5b61c6a7 1313
eca1cf26
RS
1314 ;; Delay 2 seconds after the init file error message
1315 ;; was displayed, so user can read it.
1316 (if init-file-had-error
1317 (sit-for 2))
09a1077c 1318 (let ((dir command-line-default-directory)
a726e0d1
JB
1319 (file-count 0)
1320 first-file-buffer
14d9a663 1321 tem
49939379 1322 just-files;; t if this follows the magic -- option.
14d9a663
RS
1323 ;; This includes our standard options' long versions
1324 ;; and long versions of what's on command-switch-alist.
1325 (longopts
1326 (append '(("--funcall") ("--load") ("--insert") ("--kill")
dc2cd811
GM
1327 ("--directory") ("--eval") ("--execute")
1328 ("--find-file") ("--visit") ("--file"))
ffaf8bbb
SM
1329 (mapcar (lambda (elt)
1330 (list (concat "-" (car elt))))
14d9a663 1331 command-switch-alist)))
a726e0d1 1332 (line 0))
14d9a663
RS
1333
1334 ;; Add the long X options to longopts.
1335 (setq tem command-line-x-option-alist)
1336 (while tem
1337 (if (string-match "^--" (car (car tem)))
1338 (setq longopts (cons (list (car (car tem))) longopts)))
1339 (setq tem (cdr tem)))
1340
1341 ;; Loop, processing options.
1342 (while (and command-line-args-left)
3f53ddd0
RS
1343 (let* ((argi (car command-line-args-left))
1344 (orig-argi argi)
14d9a663 1345 argval completion
aba66e2a
RS
1346 ;; List of directories specified in -L/--directory,
1347 ;; in reverse of the order specified.
1348 extra-load-path
1349 (initial-load-path load-path))
a726e0d1 1350 (setq command-line-args-left (cdr command-line-args-left))
3f53ddd0 1351
14d9a663
RS
1352 ;; Do preliminary decoding of the option.
1353 (if just-files
1354 ;; After --, don't look for options; treat all args as files.
1355 (setq argi "")
1356 ;; Convert long options to ordinary options
1357 ;; and separate out an attached option argument into argval.
1358 (if (string-match "^--[^=]*=" argi)
1359 (setq argval (substring argi (match-end 0))
1360 argi (substring argi 0 (1- (match-end 0)))))
1361 (if (equal argi "--")
1362 (setq completion nil)
1363 (setq completion (try-completion argi longopts)))
1364 (if (eq completion t)
1365 (setq argi (substring argi 1))
1366 (if (stringp completion)
1367 (let ((elt (assoc completion longopts)))
1368 (or elt
1369 (error "Option `%s' is ambiguous" argi))
1370 (setq argi (substring (car elt) 1)))
1371 (setq argval nil argi orig-argi))))
3f53ddd0
RS
1372
1373 ;; Execute the option.
a726e0d1 1374 (cond ((setq tem (assoc argi command-switch-alist))
3f53ddd0
RS
1375 (if argval
1376 (let ((command-line-args-left
1377 (cons argval command-line-args-left)))
1378 (funcall (cdr tem) argi))
1379 (funcall (cdr tem) argi)))
dc2cd811 1380
49939379 1381 ((or (string-equal argi "-f") ;what the manual claims
a726e0d1
JB
1382 (string-equal argi "-funcall")
1383 (string-equal argi "-e")) ; what the source used to say
3f53ddd0
RS
1384 (if argval
1385 (setq tem (intern argval))
1386 (setq tem (intern (car command-line-args-left)))
1387 (setq command-line-args-left (cdr command-line-args-left)))
1908c565
RS
1388 (if (arrayp (symbol-function tem))
1389 (command-execute tem)
1390 (funcall tem)))
dc2cd811
GM
1391
1392 ((or (string-equal argi "-eval")
1393 (string-equal argi "-execute"))
e6b75e30
RS
1394 (if argval
1395 (setq tem argval)
1396 (setq tem (car command-line-args-left))
1397 (setq command-line-args-left (cdr command-line-args-left)))
955093c9 1398 (eval (read tem)))
aba66e2a 1399 ;; Set the default directory as specified in -L.
dc2cd811 1400
aba66e2a
RS
1401 ((or (string-equal argi "-L")
1402 (string-equal argi "-directory"))
1403 (if argval
1404 (setq tem argval)
1405 (setq tem (car command-line-args-left)
1406 command-line-args-left (cdr command-line-args-left)))
47c7adae 1407 (setq tem (command-line-normalize-file-name tem))
aba66e2a
RS
1408 (setq extra-load-path
1409 (cons (expand-file-name tem) extra-load-path))
1410 (setq load-path (append (nreverse extra-load-path)
1411 initial-load-path)))
dc2cd811 1412
a726e0d1
JB
1413 ((or (string-equal argi "-l")
1414 (string-equal argi "-load"))
3f53ddd0
RS
1415 (if argval
1416 (setq tem argval)
1417 (setq tem (car command-line-args-left)
1418 command-line-args-left (cdr command-line-args-left)))
47c7adae 1419 (let ((file (command-line-normalize-file-name tem)))
a726e0d1
JB
1420 ;; Take file from default dir if it exists there;
1421 ;; otherwise let `load' search for it.
1422 (if (file-exists-p (expand-file-name file))
1423 (setq file (expand-file-name file)))
3f53ddd0 1424 (load file nil t)))
dc2cd811 1425
fbce8654 1426 ((string-equal argi "-insert")
3f53ddd0
RS
1427 (if argval
1428 (setq tem argval)
1429 (setq tem (car command-line-args-left)
1430 command-line-args-left (cdr command-line-args-left)))
2d2aae54
EN
1431 (or (stringp tem)
1432 (error "File name omitted from `-insert' option"))
47c7adae 1433 (insert-file-contents (command-line-normalize-file-name tem)))
dc2cd811 1434
a726e0d1
JB
1435 ((string-equal argi "-kill")
1436 (kill-emacs t))
dc2cd811 1437
a726e0d1
JB
1438 ((string-match "^\\+[0-9]+\\'" argi)
1439 (setq line (string-to-int argi)))
dc2cd811 1440
b3afdeb8
RS
1441 ((setq tem (assoc argi command-line-x-option-alist))
1442 ;; Ignore X-windows options and their args if not using X.
1443 (setq command-line-args-left
1444 (nthcdr (nth 1 tem) command-line-args-left)))
dc2cd811 1445
14d9a663 1446 ((or (string-equal argi "-find-file")
dc2cd811 1447 (string-equal argi "-file")
14d9a663
RS
1448 (string-equal argi "-visit"))
1449 ;; An explicit option to specify visiting a file.
dc2cd811
GM
1450 (if argval
1451 (setq tem argval)
1452 (setq tem (car command-line-args-left)
1453 command-line-args-left (cdr command-line-args-left)))
1454 (unless (stringp tem)
1455 (error "File name omitted from `%s' option" argi))
14d9a663 1456 (setq file-count (1+ file-count))
dc2cd811
GM
1457 (let ((file (expand-file-name
1458 (command-line-normalize-file-name tem) dir)))
14d9a663
RS
1459 (if (= file-count 1)
1460 (setq first-file-buffer (find-file file))
1461 (find-file-other-window file)))
1462 (or (zerop line)
1463 (goto-line line))
1464 (setq line 0))
dc2cd811 1465
f7ad212d 1466 ((equal argi "--")
14d9a663 1467 (setq just-files t))
a726e0d1
JB
1468 (t
1469 ;; We have almost exhausted our options. See if the
1470 ;; user has made any other command-line options available
1471 (let ((hooks command-line-functions);; lrs 7/31/89
1472 (did-hook nil))
1473 (while (and hooks
1474 (not (setq did-hook (funcall (car hooks)))))
1475 (setq hooks (cdr hooks)))
1476 (if (not did-hook)
1477 ;; Ok, presume that the argument is a file name
1478 (progn
7a79b90c
RS
1479 (if (string-match "\\`-" argi)
1480 (error "Unknown option `%s'" argi))
a726e0d1 1481 (setq file-count (1+ file-count))
14d9a663
RS
1482 (let ((file
1483 (expand-file-name
1484 (command-line-normalize-file-name orig-argi)
1485 dir)))
1486 (if (= file-count 1)
1487 (setq first-file-buffer (find-file file))
1488 (find-file-other-window file)))
a726e0d1
JB
1489 (or (zerop line)
1490 (goto-line line))
1491 (setq line 0))))))))
1492 ;; If 3 or more files visited, and not all visible,
1493 ;; show user what they all are.
ac707ebc
RS
1494 (and (> file-count 2)
1495 (not noninteractive)
1496 (or (get-buffer-window first-file-buffer)
1497 (progn (other-window 1)
1498 (buffer-menu)))))))
c88ab9ce 1499
49939379 1500
47c7adae
RS
1501(defun command-line-normalize-file-name (file)
1502 "Collapse multiple slashes to one, to handle non-Emacs file names."
6b9e794f
RS
1503 (save-match-data
1504 ;; Use arg 1 so that we don't collapse // at the start of the file name.
1505 ;; That is significant on some systems.
1506 ;; However, /// at the beginning is supposed to mean just /, not //.
1507 (if (string-match "^///+" file)
1508 (setq file (replace-match "/" t t file)))
1509 (while (string-match "//+" file 1)
1510 (setq file (replace-match "/" t t file)))
1511 file))
47c7adae 1512
c88ab9ce 1513;;; startup.el ends here