comparison lisp/startup.el @ 88155:d7ddb3e565de

sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents e88404e8f2cf
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; startup.el --- process Emacs shell arguments 1 ;;; startup.el --- process Emacs shell arguments
2 2
3 ;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 3 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
4 ;; Free Software Foundation, Inc. 4 ;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
5 5
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 ;; Keywords: internal 7 ;; Keywords: internal
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details. 19 ;; GNU General Public License for more details.
20 20
21 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
25 25
26 ;;; Commentary: 26 ;;; Commentary:
27 27
28 ;; This file parses the command line and gets Emacs running. Options on 28 ;; This file parses the command line and gets Emacs running. Options
29 ;; the command line are handled in precedence order. The order is the 29 ;; on the command line are handled in precedence order. For priorities
30 ;; one in the list below; first described means first handled. Options 30 ;; see the structure standard_args in the emacs.c file.
31 ;; within each category (delimited by a bar) are handled in the order
32 ;; encountered on the command line.
33
34 ;; -------------------------
35 ;; -version Print Emacs version to stderr, then exit
36 ;; --version successfully right away.
37 ;; This option is handled by emacs.c
38 ;; -------------------------
39 ;; -help Print a short usage description and exit
40 ;; --help successfully right away.
41 ;; This option is handled by emacs.c
42 ;; -------------------------
43 ;; -nl Do not use shared memory (for systems that
44 ;; -no-shared-memory support this) for the dumped Emacs data.
45 ;; This option is handled by emacs.c
46 ;;
47 ;; -map For VMS.
48 ;; --map-data This option is handled by emacs.c
49 ;; -------------------------
50 ;; -t FILE Use FILE as the name of the terminal.
51 ;; --terminal FILE Using this implies "-nw" also.
52 ;; This option is handled by emacs.c
53 ;; -------------------------
54 ;; -d DISPNAME Use DISPNAME as the name of the X
55 ;; -display DISPNAME display for the initial frame.
56 ;; --display DISPNAME This option is handled by emacs.c
57 ;; -------------------------
58 ;; -nw Do not use a windows system (but use the
59 ;; --no-window-system terminal instead.)
60 ;; This option is handled by emacs.c
61 ;; -------------------------
62 ;; -batch Execute noninteractively (messages go to stdout,
63 ;; --batch variable noninteractive set to t)
64 ;; This option is handled by emacs.c
65 ;; -------------------------
66 ;; -q Do not load user's init file and do not load
67 ;; -no-init-file "default.el". Regardless of this switch,
68 ;; --no-init-file "site-start" is still loaded.
69 ;; -------------------------
70 ;; -no-site-file Do not load "site-start.el". (This is the ONLY
71 ;; --no-site-file way to prevent loading that file.)
72 ;; -------------------------
73 ;; -no-splash Don't display a splash screen on startup.
74 ;; --no-splash
75 ;; -------------------------
76 ;; -u USER Load USER's init file instead of the init
77 ;; -user USER file belonging to the user starting Emacs.
78 ;; --user USER
79 ;; -------------------------
80 ;; -debug-init Don't catch errors in init files; let the
81 ;; --debug-init debugger run.
82 ;; -------------------------
83 ;; -i ICONTYPE Set type of icon using when Emacs is
84 ;; -itype ICONTYPE iconified under X.
85 ;; --icon-type ICONTYPE This option is passed on to term/x-win.el
86 ;;
87 ;; -iconic Start Emacs iconified.
88 ;; --iconic This option is passed on to term/x-win.el
89 ;; -------------------------
90 ;; Various X options for colors/fonts/geometry/title etc.
91 ;; These options are passed on to term/x-win.el which see.
92 ;; -------------------------
93 ;; FILE Visit FILE.
94 ;; -visit FILE
95 ;; --visit FILE
96 ;; -file FILE
97 ;; --file FILE
98 ;;
99 ;; -L DIRNAME Add DIRNAME to load-path
100 ;; -directory DIRNAME
101 ;; --directory DIRNAME
102 ;;
103 ;; -l FILE Load and execute the Emacs lisp code
104 ;; -load FILE in FILE.
105 ;; --load FILE
106 ;;
107 ;; -f FUNC Execute Emacs lisp function FUNC with
108 ;; -funcall FUNC no arguments. The "-e" form is outdated
109 ;; --funcall FUNC and should not be used. (It's a typo
110 ;; -e FUNC promoted to a feature.)
111 ;;
112 ;; -eval FORM Execute Emacs lisp form FORM.
113 ;; --eval FORM
114 ;; -execute EXPR
115 ;; --execute EXPR
116 ;;
117 ;; -insert FILE Insert the contents of FILE into buffer.
118 ;; --insert FILE
119 ;; -------------------------
120 ;; -kill Kill (exit) Emacs right away.
121 ;; --kill
122 ;; -------------------------
123 31
124 ;;; Code: 32 ;;; Code:
125 33
126 (setq top-level '(normal-top-level)) 34 (setq top-level '(normal-top-level))
127 35
128 (defvar command-line-processed nil 36 (defvar command-line-processed nil
129 "Non-nil once command line has been processed.") 37 "Non-nil once command line has been processed.")
130 38
131 (defgroup initialization nil 39 (defgroup initialization nil
132 "Emacs start-up procedure" 40 "Emacs start-up procedure."
133 :group 'internal) 41 :group 'internal)
134 42
135 (defcustom inhibit-startup-message nil 43 (defcustom inhibit-splash-screen nil
136 "*Non-nil inhibits the initial startup message. 44 "*Non-nil inhibits the startup screen.
137 This is for use in your personal init file, once you are familiar 45 This is for use in your personal init file, once you are familiar
138 with the contents of the startup message." 46 with the contents of the startup screen."
139 :type 'boolean 47 :type 'boolean
140 :group 'initialization) 48 :group 'initialization)
141 49
142 (defvaralias 'inhibit-splash-screen 'inhibit-startup-message) 50 (defvaralias 'inhibit-startup-message 'inhibit-splash-screen)
143 51
144 (defcustom inhibit-startup-echo-area-message nil 52 (defcustom inhibit-startup-echo-area-message nil
145 "*Non-nil inhibits the initial startup echo area message. 53 "*Non-nil inhibits the initial startup echo area message.
146 Setting this variable takes effect 54 Setting this variable takes effect
147 only if you do it with the customization buffer 55 only if you do it with the customization buffer
166 :group 'initialization) 74 :group 'initialization)
167 75
168 (defvar command-switch-alist nil 76 (defvar command-switch-alist nil
169 "Alist of command-line switches. 77 "Alist of command-line switches.
170 Elements look like (SWITCH-STRING . HANDLER-FUNCTION). 78 Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
171 HANDLER-FUNCTION receives switch name as sole arg; 79 HANDLER-FUNCTION receives the switch string as its sole argument;
172 remaining command-line args are in the variable `command-line-args-left'.") 80 the remaining command-line args are in the variable `command-line-args-left'.")
173 81
174 (defvar command-line-args-left nil 82 (defvar command-line-args-left nil
175 "List of command-line args not yet processed.") 83 "List of command-line args not yet processed.")
176 84
177 (defvar command-line-functions nil ;; lrs 7/31/89 85 (defvar command-line-functions nil ;; lrs 7/31/89
211 ("-fg" 1 x-handle-switch foreground-color) 119 ("-fg" 1 x-handle-switch foreground-color)
212 ("-foreground" 1 x-handle-switch foreground-color) 120 ("-foreground" 1 x-handle-switch foreground-color)
213 ("-bg" 1 x-handle-switch background-color) 121 ("-bg" 1 x-handle-switch background-color)
214 ("-background" 1 x-handle-switch background-color) 122 ("-background" 1 x-handle-switch background-color)
215 ("-ms" 1 x-handle-switch mouse-color) 123 ("-ms" 1 x-handle-switch mouse-color)
216 ("-itype" 0 x-handle-switch icon-type t) 124 ("-nbi" 0 x-handle-switch icon-type nil)
217 ("-i" 0 x-handle-switch icon-type t)
218 ("-iconic" 0 x-handle-iconic) 125 ("-iconic" 0 x-handle-iconic)
219 ("-xrm" 1 x-handle-xrm-switch) 126 ("-xrm" 1 x-handle-xrm-switch)
220 ("-cr" 1 x-handle-switch cursor-color) 127 ("-cr" 1 x-handle-switch cursor-color)
221 ("-vb" 0 x-handle-switch vertical-scroll-bars t) 128 ("-vb" 0 x-handle-switch vertical-scroll-bars t)
222 ("-hb" 0 x-handle-switch horizontal-scroll-bars t) 129 ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
233 ("--internal-border" 1 x-handle-numeric-switch internal-border-width) 140 ("--internal-border" 1 x-handle-numeric-switch internal-border-width)
234 ("--geometry" 1 x-handle-geometry) 141 ("--geometry" 1 x-handle-geometry)
235 ("--foreground-color" 1 x-handle-switch foreground-color) 142 ("--foreground-color" 1 x-handle-switch foreground-color)
236 ("--background-color" 1 x-handle-switch background-color) 143 ("--background-color" 1 x-handle-switch background-color)
237 ("--mouse-color" 1 x-handle-switch mouse-color) 144 ("--mouse-color" 1 x-handle-switch mouse-color)
238 ("--icon-type" 0 x-handle-switch icon-type t) 145 ("--no-bitmap-icon" 0 x-handle-switch icon-type nil)
239 ("--iconic" 0 x-handle-iconic) 146 ("--iconic" 0 x-handle-iconic)
240 ("--xrm" 1 x-handle-xrm-switch) 147 ("--xrm" 1 x-handle-xrm-switch)
241 ("--cursor-color" 1 x-handle-switch cursor-color) 148 ("--cursor-color" 1 x-handle-switch cursor-color)
242 ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t) 149 ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
243 ("--line-spacing" 1 x-handle-numeric-switch line-spacing) 150 ("--line-spacing" 1 x-handle-numeric-switch line-spacing)
244 ("--border-color" 1 x-handle-switch border-width) 151 ("--border-color" 1 x-handle-switch border-color)
245 ("--smid" 1 x-handle-smid)) 152 ("--smid" 1 x-handle-smid))
246 "Alist of X Windows options. 153 "Alist of X Windows options.
247 Each element has the form 154 Each element has the form
248 (NAME NUMARGS HANDLER FRAME-PARAM VALUE) 155 (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
249 where NAME is the option name string, NUMARGS is the number of arguments 156 where NAME is the option name string, NUMARGS is the number of arguments
268 "Normal hook run after loading terminal-specific Lisp code. 175 "Normal hook run after loading terminal-specific Lisp code.
269 It also follows `emacs-startup-hook'. This hook exists for users to set, 176 It also follows `emacs-startup-hook'. This hook exists for users to set,
270 so as to override the definitions made by the terminal-specific file. 177 so as to override the definitions made by the terminal-specific file.
271 Emacs never sets this variable itself.") 178 Emacs never sets this variable itself.")
272 179
180 (defvar inhibit-startup-hooks nil
181 "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'.
182 This is because we already did so.")
183
273 (defvar keyboard-type nil 184 (defvar keyboard-type nil
274 "The brand of keyboard you are using. 185 "The brand of keyboard you are using.
275 This variable is used to define 186 This variable is used to define the proper function and keypad
276 the proper function and keypad keys for use under X. It is used in a 187 keys for use under X. It is used in a fashion analogous to the
277 fashion analogous to the environment variable TERM.") 188 environment variable TERM.")
278 189
279 (defvar window-setup-hook nil 190 (defvar window-setup-hook nil
280 "Normal hook run to initialize window system display. 191 "Normal hook run to initialize window system display.
281 Emacs runs this hook after processing the command line arguments and loading 192 Emacs runs this hook after processing the command line arguments and loading
282 the user's init file.") 193 the user's init file.")
284 (defcustom initial-major-mode 'lisp-interaction-mode 195 (defcustom initial-major-mode 'lisp-interaction-mode
285 "Major mode command symbol to use for the initial *scratch* buffer." 196 "Major mode command symbol to use for the initial *scratch* buffer."
286 :type 'function 197 :type 'function
287 :group 'initialization) 198 :group 'initialization)
288 199
289 (defcustom init-file-user nil 200 (defvar init-file-user nil
290 "Identity of user whose `.emacs' file is or was read. 201 "Identity of user whose `.emacs' file is or was read.
291 The value is nil if `-q' or `--no-init-file' was specified, 202 The value is nil if `-q' or `--no-init-file' was specified,
292 meaning do not load any init file. 203 meaning do not load any init file.
293 204
294 Otherwise, the value may be the null string, meaning use the init file 205 Otherwise, the value may be an empty string, meaning
295 for the user that originally logged in, or it may be a 206 use the init file for the user who originally logged in,
296 string containing a user's name meaning use that person's init file. 207 or it may be a string containing a user's name meaning
208 use that person's init file.
297 209
298 In either of the latter cases, `(concat \"~\" init-file-user \"/\")' 210 In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
299 evaluates to the name of the directory where the `.emacs' file was 211 evaluates to the name of the directory where the `.emacs' file was
300 looked for. 212 looked for.
301 213
302 Setting `init-file-user' does not prevent Emacs from loading 214 Setting `init-file-user' does not prevent Emacs from loading
303 `site-start.el'. The only way to do that is to use `--no-site-file'." 215 `site-start.el'. The only way to do that is to use `--no-site-file'.")
304 :type '(choice (const :tag "none" nil) string)
305 :group 'initialization)
306 216
307 (defcustom site-run-file "site-start" 217 (defcustom site-run-file "site-start"
308 "File containing site-wide run-time initializations. 218 "File containing site-wide run-time initializations.
309 This file is loaded at run-time before `~/.emacs'. It contains inits 219 This file is loaded at run-time before `~/.emacs'. It contains inits
310 that need to be in place for the entire site, but which, due to their 220 that need to be in place for the entire site, but which, due to their
311 higher incidence of change, don't make sense to load into emacs' 221 higher incidence of change, don't make sense to load into Emacs's
312 dumped image. Thus, the run-time load order is: 1. file described in 222 dumped image. Thus, the run-time load order is: 1. file described in
313 this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'. 223 this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
314 224
315 Don't use the `site-start.el' file for things some users may not like. 225 Don't use the `site-start.el' file for things some users may not like.
316 Put them in `default.el' instead, so that users can more easily 226 Put them in `default.el' instead, so that users can more easily
317 override them. Users can prevent loading `default.el' with the `-q' 227 override them. Users can prevent loading `default.el' with the `-q'
318 option or by setting `inhibit-default-init' in their own init files, 228 option or by setting `inhibit-default-init' in their own init files,
319 but inhibiting `site-start.el' requires `--no-site-file', which 229 but inhibiting `site-start.el' requires `--no-site-file', which
320 is less convenient." 230 is less convenient.
231
232 This variable is defined for customization so as to make
233 it visible in the relevant context. However, actually customizing it
234 is not allowed, since it would not work anyway. The only way to set
235 this variable usefully is to set it while building and dumping Emacs."
321 :type '(choice (const :tag "none" nil) string) 236 :type '(choice (const :tag "none" nil) string)
322 :group 'initialization) 237 :group 'initialization
238 :initialize 'custom-initialize-default
239 :set '(lambda (variable value)
240 (error "Customizing `site-run-file' does not work")))
323 241
324 (defcustom mail-host-address nil 242 (defcustom mail-host-address nil
325 "*Name of this machine, for purposes of naming users." 243 "*Name of this machine, for purposes of naming users."
326 :type '(choice (const nil) string) 244 :type '(choice (const nil) string)
327 :group 'mail) 245 :group 'mail)
353 from being initialized." 271 from being initialized."
354 :type '(choice (const :tag "Don't record a session's auto save list" nil) 272 :type '(choice (const :tag "Don't record a session's auto save list" nil)
355 string) 273 string)
356 :group 'auto-save) 274 :group 'auto-save)
357 275
276 (defvar emacs-quick-startup nil)
277
278 (defvar emacs-basic-display nil)
279
358 (defvar init-file-debug nil) 280 (defvar init-file-debug nil)
359 281
360 (defvar init-file-had-error nil) 282 (defvar init-file-had-error nil)
361 283
362 (defvar normal-top-level-add-subdirs-inode-list nil) 284 (defvar normal-top-level-add-subdirs-inode-list nil)
285
286 (defvar no-blinking-cursor nil)
287
288 (defvar default-frame-background-mode)
289
290 (defvar pure-space-overflow nil
291 "Non-nil if building Emacs overflowed pure space.")
363 292
364 (defun normal-top-level-add-subdirs-to-load-path () 293 (defun normal-top-level-add-subdirs-to-load-path ()
365 "Add all subdirectories of current directory to `load-path'. 294 "Add all subdirectories of current directory to `load-path'.
366 More precisely, this uses only the subdirectories whose names 295 More precisely, this uses only the subdirectories whose names
367 start with letters or digits; it excludes any subdirectory named `RCS' 296 start with letters or digits; it excludes any subdirectory named `RCS'
374 (while pending 303 (while pending
375 (push (pop pending) dirs) 304 (push (pop pending) dirs)
376 (let* ((this-dir (car dirs)) 305 (let* ((this-dir (car dirs))
377 (contents (directory-files this-dir)) 306 (contents (directory-files this-dir))
378 (default-directory this-dir) 307 (default-directory this-dir)
379 (canonicalized (and (eq system-type 'windows-nt) 308 (canonicalized (if (fboundp 'untranslated-canonical-name)
380 (untranslated-canonical-name this-dir)))) 309 (untranslated-canonical-name this-dir))))
381 ;; The Windows version doesn't report meaningful inode 310 ;; The Windows version doesn't report meaningful inode
382 ;; numbers, so use the canonicalized absolute file name of the 311 ;; numbers, so use the canonicalized absolute file name of the
383 ;; directory instead. 312 ;; directory instead.
384 (setq attrs (or canonicalized 313 (setq attrs (or canonicalized
385 (nthcdr 10 (file-attributes this-dir)))) 314 (nthcdr 10 (file-attributes this-dir))))
424 (message "Back to top level.") 353 (message "Back to top level.")
425 (setq command-line-processed t) 354 (setq command-line-processed t)
426 ;; Give *Messages* the same default-directory as *scratch*, 355 ;; Give *Messages* the same default-directory as *scratch*,
427 ;; just to keep things predictable. 356 ;; just to keep things predictable.
428 (let ((dir default-directory)) 357 (let ((dir default-directory))
429 (save-excursion 358 (with-current-buffer "*Messages*"
430 (set-buffer (get-buffer "*Messages*"))
431 (setq default-directory dir))) 359 (setq default-directory dir)))
432 ;; `user-full-name' is now known; reset its standard-value here. 360 ;; `user-full-name' is now known; reset its standard-value here.
433 (put 'user-full-name 'standard-value 361 (put 'user-full-name 'standard-value
434 (list (default-value 'user-full-name))) 362 (list (default-value 'user-full-name)))
435 ;; For root, preserve owner and group when editing files. 363 ;; For root, preserve owner and group when editing files.
438 ;; Look in each dir in load-path for a subdirs.el file. 366 ;; Look in each dir in load-path for a subdirs.el file.
439 ;; If we find one, load it, which will add the appropriate subdirs 367 ;; If we find one, load it, which will add the appropriate subdirs
440 ;; of that dir into load-path, 368 ;; of that dir into load-path,
441 ;; Look for a leim-list.el file too. Loading it will register 369 ;; Look for a leim-list.el file too. Loading it will register
442 ;; available input methods. 370 ;; available input methods.
443 (let ((tail load-path) 371 (let ((tail load-path) dir)
444 new)
445 (while tail 372 (while tail
446 (push (car tail) new) 373 (setq dir (car tail))
447 (condition-case nil 374 (let ((default-directory dir))
448 (let ((default-directory (car tail))) 375 (load (expand-file-name "subdirs.el") t t t))
449 (load (expand-file-name "subdirs.el" (car tail)) t t t))) 376 (let ((default-directory dir))
450 (condition-case nil 377 (load (expand-file-name "leim-list.el") t t t))
451 (let ((default-directory (car tail))) 378 ;; We don't use a dolist loop and we put this "setq-cdr" command at
452 (load (expand-file-name "leim-list.el" (car tail)) t t t))) 379 ;; the end, because the subdirs.el files may add elements to the end
453 (setq tail (cdr tail)))) 380 ;; of load-path and we want to take it into account.
454 (if (not (eq system-type 'vax-vms)) 381 (setq tail (cdr tail))))
455 (progn 382 (unless (eq system-type 'vax-vms)
456 ;; If the PWD environment variable isn't accurate, delete it. 383 ;; If the PWD environment variable isn't accurate, delete it.
457 (let ((pwd (getenv "PWD"))) 384 (let ((pwd (getenv "PWD")))
458 (and (stringp pwd) 385 (and (stringp pwd)
459 ;; Use FOO/., so that if FOO is a symlink, file-attributes 386 ;; Use FOO/., so that if FOO is a symlink, file-attributes
460 ;; describes the directory linked to, not FOO itself. 387 ;; describes the directory linked to, not FOO itself.
461 (or (equal (file-attributes 388 (or (equal (file-attributes
462 (concat (file-name-as-directory pwd) ".")) 389 (concat (file-name-as-directory pwd) "."))
463 (file-attributes 390 (file-attributes
464 (concat (file-name-as-directory default-directory) 391 (concat (file-name-as-directory default-directory)
465 "."))) 392 ".")))
466 (setq process-environment 393 (setq process-environment
467 (delete (concat "PWD=" pwd) 394 (delete (concat "PWD=" pwd)
468 process-environment))))))) 395 process-environment))))))
469 (setq default-directory (abbreviate-file-name default-directory)) 396 (setq default-directory (abbreviate-file-name default-directory))
470 (let ((menubar-bindings-done nil)) 397 (let ((menubar-bindings-done nil))
471 (unwind-protect 398 (unwind-protect
472 (command-line) 399 (command-line)
473 ;; Do this again, in case .emacs defined more abbreviations. 400 ;; Do this again, in case .emacs defined more abbreviations.
494 (expand-file-name 421 (expand-file-name
495 (format "%s%d-%s~" 422 (format "%s%d-%s~"
496 auto-save-list-file-prefix 423 auto-save-list-file-prefix
497 (emacs-pid) 424 (emacs-pid)
498 (system-name)))))))) 425 (system-name))))))))
499 (run-hooks 'emacs-startup-hook) 426 (unless inhibit-startup-hooks
500 (and term-setup-hook 427 (run-hooks 'emacs-startup-hook)
501 (run-hooks 'term-setup-hook)) 428 (and term-setup-hook
429 (run-hooks 'term-setup-hook)))
502 430
503 ;; Don't do this if we failed to create the initial frame, 431 ;; Don't do this if we failed to create the initial frame,
504 ;; for instance due to a dense colormap. 432 ;; for instance due to a dense colormap.
505 (when (or frame-initial-frame 433 (when (or frame-initial-frame
506 ;; If frame-initial-frame has no meaning, do this anyway. 434 ;; If frame-initial-frame has no meaning, do this anyway.
514 (if (fboundp 'frame-set-background-mode) 442 (if (fboundp 'frame-set-background-mode)
515 ;; Set the faces for the initial background mode even if 443 ;; Set the faces for the initial background mode even if
516 ;; frame-notice-user-settings didn't (such as on a tty). 444 ;; frame-notice-user-settings didn't (such as on a tty).
517 ;; frame-set-background-mode is idempotent, so it won't 445 ;; frame-set-background-mode is idempotent, so it won't
518 ;; cause any harm if it's already been done. 446 ;; cause any harm if it's already been done.
519 (let ((frame-background-mode frame-background-mode) 447 (let ((frame (selected-frame))
520 (frame (selected-frame))
521 term) 448 term)
522 (when (and (null window-system) 449 (when (and (null window-system)
523 ;; Don't override a possibly customized value. 450 ;; Don't override default set by files in lisp/term.
524 (null frame-background-mode) 451 (null default-frame-background-mode)
525 ;; Don't override user specifications.
526 (null (frame-parameter frame 'reverse))
527 (let ((bg (frame-parameter frame 'background-color))) 452 (let ((bg (frame-parameter frame 'background-color)))
528 (or (null bg) 453 (or (null bg)
529 (member bg '(unspecified "unspecified-bg"))))) 454 (member bg '(unspecified "unspecified-bg"
455 "unspecified-fg")))))
456
530 (setq term (getenv "TERM")) 457 (setq term (getenv "TERM"))
531 ;; Some files in lisp/term do a better job with the 458 ;; Some files in lisp/term do a better job with the
532 ;; background mode, but we leave this here anyway, in 459 ;; background mode, but we leave this here anyway, in
533 ;; case they remove those files. 460 ;; case they remove those files.
534 (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" 461 (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
535 term) 462 term)
536 (setq frame-background-mode 'light))) 463 (setq default-frame-background-mode 'light)))
537 (frame-set-background-mode (selected-frame))))) 464 (frame-set-background-mode (selected-frame)))))
538 465
539 ;; Now we know the user's default font, so add it to the menu. 466 ;; Now we know the user's default font, so add it to the menu.
540 (if (fboundp 'font-menu-add-default) 467 (if (fboundp 'font-menu-add-default)
541 (font-menu-add-default)) 468 (font-menu-add-default))
573 "Height in pixels of images in the tool bar.") 500 "Height in pixels of images in the tool bar.")
574 501
575 (defvar tool-bar-originally-present nil 502 (defvar tool-bar-originally-present nil
576 "Non-nil if tool-bars are present before user and site init files are read.") 503 "Non-nil if tool-bars are present before user and site init files are read.")
577 504
578 ;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc. 505 ;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc.
579 (defun tty-handle-args (args) 506 (defun tty-handle-args (args)
580 (let ((rest nil)) 507 (let (rest)
581 (message "%s" args) 508 (message "%s" args)
582 (while (and args 509 (while (and args
583 (not (equal (car args) "--"))) 510 (not (equal (car args) "--")))
584 (let* ((this (car args)) 511 (let* ((argi (pop args))
585 (orig-this this) 512 (orig-argi argi)
586 completion argval) 513 argval completion)
587 (setq args (cdr args))
588 ;; Check for long options with attached arguments 514 ;; Check for long options with attached arguments
589 ;; and separate out the attached option argument into argval. 515 ;; and separate out the attached option argument into argval.
590 (if (string-match "^--[^=]*=" this) 516 (when (string-match "^\\(--[^=]*\\)=" argi)
591 (setq argval (substring this (match-end 0)) 517 (setq argval (substring argi (match-end 0))
592 this (substring this 0 (1- (match-end 0))))) 518 argi (match-string 1 argi)))
593 (when (string-match "^--" this) 519 (when (string-match "^--" argi)
594 (setq completion (try-completion this tty-long-option-alist)) 520 (setq completion (try-completion argi tty-long-option-alist))
595 (if (eq completion t) 521 (if (eq completion t)
596 ;; Exact match for long option. 522 ;; Exact match for long option.
597 (setq this (cdr (assoc this tty-long-option-alist))) 523 (setq argi (cdr (assoc argi tty-long-option-alist)))
598 (if (stringp completion) 524 (if (stringp completion)
599 (let ((elt (assoc completion tty-long-option-alist))) 525 (let ((elt (assoc completion tty-long-option-alist)))
600 ;; Check for abbreviated long option. 526 ;; Check for abbreviated long option.
601 (or elt 527 (or elt
602 (error "Option `%s' is ambiguous" this)) 528 (error "Option `%s' is ambiguous" argi))
603 (setq this (cdr elt))) 529 (setq argi (cdr elt)))
604 ;; Check for a short option. 530 ;; Check for a short option.
605 (setq argval nil this orig-this)))) 531 (setq argval nil
606 (cond ((or (string= this "-fg") (string= this "-foreground")) 532 argi orig-argi))))
607 (or argval (setq argval (car args) args (cdr args))) 533 (cond ((member argi '("-fg" "-foreground"))
608 (setq default-frame-alist 534 (push (cons 'foreground-color (or argval (pop args)))
609 (cons (cons 'foreground-color argval) 535 default-frame-alist))
610 default-frame-alist))) 536 ((member argi '("-bg" "-background"))
611 ((or (string= this "-bg") (string= this "-background")) 537 (push (cons 'background-color (or argval (pop args)))
612 (or argval (setq argval (car args) args (cdr args))) 538 default-frame-alist))
613 (setq default-frame-alist 539 ((member argi '("-T" "-name"))
614 (cons (cons 'background-color argval) 540 (unless argval (setq argval (pop args)))
615 default-frame-alist))) 541 (push (cons 'title
616 ((or (string= this "-T") (string= this "-name")) 542 (if (stringp argval)
617 (or argval (setq argval (car args) args (cdr args))) 543 argval
618 (setq default-frame-alist 544 (let ((case-fold-search t)
619 (cons 545 i)
620 (cons 'title 546 (setq argval (invocation-name))
621 (if (stringp argval) 547
622 argval 548 ;; Change any . or * characters in name to
623 (let ((case-fold-search t) 549 ;; hyphens, so as to emulate behavior on X.
624 i) 550 (while
625 (setq argval (invocation-name)) 551 (setq i (string-match "[.*]" argval))
626 552 (aset argval i ?-))
627 ;; Change any . or * characters in name to 553 argval)))
628 ;; hyphens, so as to emulate behavior on X. 554 default-frame-alist))
629 (while 555 ((member argi '("-r" "-rv" "-reverse"))
630 (setq i (string-match "[.*]" argval)) 556 (push '(reverse . t)
631 (aset argval i ?-)) 557 default-frame-alist))
632 argval))) 558 ((equal argi "-color")
633 default-frame-alist))) 559 (unless argval (setq argval 8)) ; default --color means 8 ANSI colors
634 ((or (string= this "-r") 560 (push (cons 'tty-color-mode
635 (string= this "-rv") 561 (cond
636 (string= this "-reverse")) 562 ((numberp argval) argval)
637 (setq default-frame-alist 563 ((string-match "-?[0-9]+" argval)
638 (cons '(reverse . t) 564 (string-to-number argval))
639 default-frame-alist))) 565 (t (intern argval))))
640 ((string= this "-color") 566 default-frame-alist))
641 (if (null argval) 567 (t
642 (setq argval 8)) ; default --color means 8 ANSI colors 568 (push argi rest)))))
643 (setq default-frame-alist 569 (nreverse rest)))
644 (cons (cons 'tty-color-mode
645 (cond
646 ((numberp argval) argval)
647 ((string-match "-?[0-9]+" argval)
648 (string-to-number argval))
649 (t (intern argval))))
650 default-frame-alist)))
651 (t (setq rest (cons this rest))))))
652 (nreverse rest)))
653 570
654 (defun command-line () 571 (defun command-line ()
655 (setq command-line-default-directory default-directory) 572 (setq command-line-default-directory default-directory)
656 573
657 ;; Choose a reasonable location for temporary files. 574 ;; Choose a reasonable location for temporary files.
658 (setq temporary-file-directory 575 (custom-reevaluate-setting 'temporary-file-directory)
659 (file-name-as-directory 576 (custom-reevaluate-setting 'small-temporary-file-directory)
660 (cond ((memq system-type '(ms-dos windows-nt)) 577 (custom-reevaluate-setting 'auto-save-file-name-transforms)
661 (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
662 ((memq system-type '(vax-vms axp-vms))
663 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
664 (t
665 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))))
666 (setq small-temporary-file-directory
667 (if (eq system-type 'ms-dos)
668 (getenv "TMPDIR")))
669 (setq auto-save-file-name-transforms
670 (list (list "\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
671 ;; Don't put "\\2" inside expand-file-name, since
672 ;; it will be transformed to "/2" on DOS/Windows.
673 (concat temporary-file-directory "\\2") t)))
674 578
675 ;; See if we should import version-control from the environment variable. 579 ;; See if we should import version-control from the environment variable.
676 (let ((vc (getenv "VERSION_CONTROL"))) 580 (let ((vc (getenv "VERSION_CONTROL")))
677 (cond ((eq vc nil)) ;don't do anything if not set 581 (cond ((eq vc nil)) ;don't do anything if not set
678 ((or (string= vc "t") 582 ((member vc '("t" "numbered"))
679 (string= vc "numbered"))
680 (setq version-control t)) 583 (setq version-control t))
681 ((or (string= vc "nil") 584 ((member vc '("nil" "existing"))
682 (string= vc "existing"))
683 (setq version-control nil)) 585 (setq version-control nil))
684 ((or (string= vc "never") 586 ((member vc '("never" "simple"))
685 (string= vc "simple"))
686 (setq version-control 'never)))) 587 (setq version-control 'never))))
687 588
688 ;;! This has been commented out; I currently find the behavior when 589 ;;! This has been commented out; I currently find the behavior when
689 ;;! split-window-keep-point is nil disturbing, but if I can get used 590 ;;! split-window-keep-point is nil disturbing, but if I can get used
690 ;;! to it, then it would be better to eliminate the option. 591 ;;! to it, then it would be better to eliminate the option.
693 594
694 ;; Set the default strings to display in mode line for 595 ;; Set the default strings to display in mode line for
695 ;; end-of-line formats that aren't native to this platform. 596 ;; end-of-line formats that aren't native to this platform.
696 (cond 597 (cond
697 ((memq system-type '(ms-dos windows-nt emx)) 598 ((memq system-type '(ms-dos windows-nt emx))
698 (setq eol-mnemonic-unix "(Unix)") 599 (setq eol-mnemonic-unix "(Unix)"
699 (setq eol-mnemonic-mac "(Mac)")) 600 eol-mnemonic-mac "(Mac)"))
700 ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the 601 ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the
701 ;; abbreviated strings `/' and `:' set in coding.c for them. 602 ;; abbreviated strings `/' and `:' set in coding.c for them.
702 ((eq system-type 'macos) 603 ((eq system-type 'macos)
703 (setq eol-mnemonic-dos "(DOS)")) 604 (setq eol-mnemonic-dos "(DOS)"))
704 (t ; this is for Unix/GNU/Linux systems 605 (t ; this is for Unix/GNU/Linux systems
705 (setq eol-mnemonic-dos "(DOS)") 606 (setq eol-mnemonic-dos "(DOS)"
706 (setq eol-mnemonic-mac "(Mac)"))) 607 eol-mnemonic-mac "(Mac)")))
707 608
708 ;; Read window system's init file if using a window system. 609 ;; Read window system's init file if using a window system.
709 (condition-case error 610 (condition-case error
710 (if (and window-system (not noninteractive)) 611 (if (and window-system (not noninteractive))
711 (load (concat term-file-prefix 612 (load (concat term-file-prefix
719 (princ 620 (princ
720 (if (eq (car error) 'error) 621 (if (eq (car error) 'error)
721 (apply 'concat (cdr error)) 622 (apply 'concat (cdr error))
722 (if (memq 'file-error (get (car error) 'error-conditions)) 623 (if (memq 'file-error (get (car error) 'error-conditions))
723 (format "%s: %s" 624 (format "%s: %s"
724 (nth 1 error) 625 (nth 1 error)
725 (mapconcat (lambda (obj) (prin1-to-string obj t)) 626 (mapconcat (lambda (obj) (prin1-to-string obj t))
726 (cdr (cdr error)) ", ")) 627 (cdr (cdr error)) ", "))
727 (format "%s: %s" 628 (format "%s: %s"
728 (get (car error) 'error-message) 629 (get (car error) 'error-message)
729 (mapconcat (lambda (obj) (prin1-to-string obj t)) 630 (mapconcat (lambda (obj) (prin1-to-string obj t))
730 (cdr error) ", ")))) 631 (cdr error) ", "))))
731 'external-debugging-output) 632 'external-debugging-output)
732 (terpri 'external-debugging-output) 633 (terpri 'external-debugging-output)
733 (setq window-system nil) 634 (setq window-system nil)
734 (kill-emacs))) 635 (kill-emacs)))
735 636
736 ;; Windowed displays do this inside their *-win.el. 637 ;; Windowed displays do this inside their *-win.el.
737 (when (and (not (display-graphic-p)) 638 (unless (or (display-graphic-p) noninteractive)
738 (not noninteractive))
739 (setq command-line-args (tty-handle-args command-line-args))) 639 (setq command-line-args (tty-handle-args command-line-args)))
740 640
741 (set-locale-environment nil) 641 (set-locale-environment nil)
642
643 ;; Convert preloaded file names to absolute.
644 (let ((lisp-dir
645 (file-name-directory
646 (locate-file "simple" load-path
647 load-suffixes))))
648
649 (setq load-history
650 (mapcar (lambda (elt)
651 (if (and (stringp (car elt))
652 (not (file-name-absolute-p (car elt))))
653 (cons (concat lisp-dir
654 (car elt)
655 (if (string-match "[.]el$" (car elt))
656 "" ".elc"))
657 (cdr elt))
658 elt))
659 load-history)))
742 660
743 ;; Convert the arguments to Emacs internal representation. 661 ;; Convert the arguments to Emacs internal representation.
744 (let ((args (cdr command-line-args))) 662 (let ((args (cdr command-line-args)))
745 (while args 663 (while args
746 (setcar args 664 (setcar args
747 (decode-coding-string (car args) locale-coding-system t)) 665 (decode-coding-string (car args) locale-coding-system t))
748 (setq args (cdr args)))) 666 (pop args)))
749 667
750 (let ((done nil) 668 (let ((done nil)
751 (args (cdr command-line-args))) 669 (args (cdr command-line-args)))
752 670
753 ;; Figure out which user's init file to load, 671 ;; Figure out which user's init file to load,
754 ;; either from the environment or from the options. 672 ;; either from the environment or from the options.
755 (setq init-file-user (if noninteractive nil (user-login-name))) 673 (setq init-file-user (if noninteractive nil (user-login-name)))
756 ;; If user has not done su, use current $HOME to find .emacs. 674 ;; If user has not done su, use current $HOME to find .emacs.
757 (and init-file-user (string= init-file-user (user-real-login-name)) 675 (and init-file-user
676 (equal init-file-user (user-real-login-name))
758 (setq init-file-user "")) 677 (setq init-file-user ""))
759 678
760 ;; Process the command-line args, and delete the arguments 679 ;; Process the command-line args, and delete the arguments
761 ;; processed. This is consistent with the way main in emacs.c 680 ;; processed. This is consistent with the way main in emacs.c
762 ;; does things. 681 ;; does things.
763 (while (and (not done) args) 682 (while (and (not done) args)
764 (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user") 683 (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--debug-init")
765 ("--debug-init") ("--iconic") ("--icon-type"))) 684 ("--user") ("--iconic") ("--icon-type") ("--quick")
766 (argi (pop args)) 685 ("--no-blinking-cursor") ("--basic-display")))
767 (argval nil)) 686 (argi (pop args))
687 (orig-argi argi)
688 argval)
768 ;; Handle --OPTION=VALUE format. 689 ;; Handle --OPTION=VALUE format.
769 (when (and (string-match "\\`--" argi) 690 (when (string-match "^\\(--[^=]*\\)=" argi)
770 (string-match "=" argi))
771 (setq argval (substring argi (match-end 0)) 691 (setq argval (substring argi (match-end 0))
772 argi (substring argi 0 (match-beginning 0)))) 692 argi (match-string 1 argi)))
773 (unless (equal argi "--") 693 (unless (equal argi "--")
774 (let ((completion (try-completion argi longopts))) 694 (let ((completion (try-completion argi longopts)))
775 (if (eq completion t) 695 (if (eq completion t)
776 (setq argi (substring argi 1)) 696 (setq argi (substring argi 1))
777 (if (stringp completion) 697 (if (stringp completion)
778 (let ((elt (assoc completion longopts))) 698 (let ((elt (assoc completion longopts)))
779 (or elt 699 (or elt
780 (error "Option `%s' is ambiguous" argi)) 700 (error "Option `%s' is ambiguous" argi))
781 (setq argi (substring (car elt) 1))) 701 (setq argi (substring (car elt) 1)))
782 (setq argval nil))))) 702 (setq argval nil
703 argi orig-argi)))))
783 (cond 704 (cond
705 ((member argi '("-Q" "-quick"))
706 (setq init-file-user nil
707 site-run-file nil
708 emacs-quick-startup t))
709 ((member argi '("-D" "-basic-display"))
710 (setq no-blinking-cursor t
711 emacs-basic-display t)
712 (push '(vertical-scroll-bars . nil) initial-frame-alist))
784 ((member argi '("-q" "-no-init-file")) 713 ((member argi '("-q" "-no-init-file"))
785 (setq init-file-user nil)) 714 (setq init-file-user nil))
786 ((member argi '("-u" "-user")) 715 ((member argi '("-u" "-user"))
787 (or argval 716 (setq init-file-user (or argval (pop args))
788 (setq argval (pop args)))
789 (setq init-file-user argval
790 argval nil)) 717 argval nil))
791 ((string-equal argi "-no-site-file") 718 ((equal argi "-no-site-file")
792 (setq site-run-file nil)) 719 (setq site-run-file nil))
793 ((string-equal argi "-debug-init") 720 ((equal argi "-debug-init")
794 (setq init-file-debug t)) 721 (setq init-file-debug t))
795 ((string-equal argi "-iconic") 722 ((equal argi "-iconic")
796 (push '(visibility . icon) initial-frame-alist)) 723 (push '(visibility . icon) initial-frame-alist))
797 ((or (string-equal argi "-icon-type") 724 ((member argi '("-icon-type" "-i" "-itype"))
798 (string-equal argi "-i")
799 (string-equal argi "-itype"))
800 (push '(icon-type . t) default-frame-alist)) 725 (push '(icon-type . t) default-frame-alist))
726 ((member argi '("-nbc" "-no-blinking-cursor"))
727 (setq no-blinking-cursor t))
801 ;; Push the popped arg back on the list of arguments. 728 ;; Push the popped arg back on the list of arguments.
802 (t (push argi args) (setq done t))) 729 (t
730 (push argi args)
731 (setq done t)))
803 ;; Was argval set but not used? 732 ;; Was argval set but not used?
804 (and argval 733 (and argval
805 (error "Option `%s' doesn't allow an argument" argi)))) 734 (error "Option `%s' doesn't allow an argument" argi))))
806 735
807 ;; Re-attach the program name to the front of the arg list. 736 ;; Re-attach the program name to the front of the arg list.
808 (and command-line-args (setcdr command-line-args args))) 737 (and command-line-args
809 738 (setcdr command-line-args args)))
810 ;; Under X Windows, this creates the X frame and deletes the terminal frame. 739
740 (run-hooks 'before-init-hook)
741
742 ;; Under X Window, this creates the X frame and deletes the terminal frame.
811 (when (fboundp 'frame-initialize) 743 (when (fboundp 'frame-initialize)
812 (frame-initialize)) 744 (frame-initialize))
813 745
746 ;; Turn off blinking cursor if so specified in X resources. This is here
747 ;; only because all other settings of no-blinking-cursor are here.
748 (unless (or noninteractive
749 emacs-basic-display
750 (and (memq window-system '(x w32 mac))
751 (not (member (x-get-resource "cursorBlink" "CursorBlink")
752 '("off" "false")))))
753 (setq no-blinking-cursor t))
754
814 ;; If frame was created with a menu bar, set menu-bar-mode on. 755 ;; If frame was created with a menu bar, set menu-bar-mode on.
815 (if (and (not noninteractive) 756 (unless (or noninteractive
816 (or (not (memq window-system '(x w32))) 757 emacs-basic-display
817 (> (frame-parameter nil 'menu-bar-lines) 0))) 758 (and (memq window-system '(x w32))
818 (menu-bar-mode t)) 759 (<= (frame-parameter nil 'menu-bar-lines) 0)))
760 (menu-bar-mode 1))
819 761
820 ;; If frame was created with a tool bar, switch tool-bar-mode on. 762 ;; If frame was created with a tool bar, switch tool-bar-mode on.
821 (when (and (not noninteractive) 763 (unless (or noninteractive
822 (display-graphic-p) 764 emacs-basic-display
823 (> (frame-parameter nil 'tool-bar-lines) 0)) 765 (not (display-graphic-p))
766 (<= (frame-parameter nil 'tool-bar-lines) 0))
824 (tool-bar-mode 1)) 767 (tool-bar-mode 1))
825 768
826 ;; Can't do this init in defcustom because window-system isn't set. 769 ;; Can't do this init in defcustom because the relevant variables
827 (when (and (not noninteractive) 770 ;; are not set.
828 (not (eq system-type 'ms-dos)) 771 (custom-reevaluate-setting 'blink-cursor-mode)
829 (memq window-system '(x w32))) 772 (custom-reevaluate-setting 'normal-erase-is-backspace)
830 (setq-default blink-cursor t) 773 (custom-reevaluate-setting 'tooltip-mode)
831 (blink-cursor-mode 1)) 774 (custom-reevaluate-setting 'global-font-lock-mode)
832 775 (custom-reevaluate-setting 'mouse-wheel-down-event)
833 (unless noninteractive 776 (custom-reevaluate-setting 'mouse-wheel-up-event)
834 ;; DOS/Windows systems have a PC-type keyboard which has both 777 (custom-reevaluate-setting 'file-name-shadow-mode)
835 ;; <delete> and <backspace> keys. 778 (custom-reevaluate-setting 'send-mail-function)
836 (when (or (memq system-type '(ms-dos windows-nt))
837 (and (memq window-system '(x))
838 (fboundp 'x-backspace-delete-keys-p)
839 (x-backspace-delete-keys-p))
840 ;; If the terminal Emacs is running on has erase char
841 ;; set to ^H, use the Backspace key for deleting
842 ;; backward and, and the Delete key for deleting forward.
843 (and (null window-system)
844 (eq tty-erase-char 8)))
845 (setq-default normal-erase-is-backspace t)
846 (normal-erase-is-backspace-mode 1)))
847
848 (when (and (not noninteractive)
849 (display-graphic-p)
850 (fboundp 'x-show-tip))
851 (setq-default tooltip-mode t)
852 (tooltip-mode 1))
853 779
854 ;; Register default TTY colors for the case the terminal hasn't a 780 ;; Register default TTY colors for the case the terminal hasn't a
855 ;; terminal init file. 781 ;; terminal init file.
856 (or (memq window-system '(x w32)) 782 (unless (memq window-system '(x w32 mac))
857 ;; We do this regardles of whether the terminal supports colors 783 ;; We do this regardles of whether the terminal supports colors
858 ;; or not, since they can switch that support on or off in 784 ;; or not, since they can switch that support on or off in
859 ;; mid-session by setting the tty-color-mode frame parameter. 785 ;; mid-session by setting the tty-color-mode frame parameter.
860 (tty-register-default-colors)) 786 (tty-register-default-colors))
861 787
862 ;; Record whether the tool-bar is present before the user and site 788 ;; Record whether the tool-bar is present before the user and site
863 ;; init files are processed. frame-notice-user-settings uses this 789 ;; init files are processed. frame-notice-user-settings uses this
864 ;; to determine if the tool-bar has been disabled by the init files, 790 ;; to determine if the tool-bar has been disabled by the init files,
865 ;; and the frame needs to be resized. 791 ;; and the frame needs to be resized.
866 (when (fboundp 'frame-notice-user-settings) 792 (when (fboundp 'frame-notice-user-settings)
867 (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) 793 (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
868 (assq 'tool-bar-lines default-frame-alist)))) 794 (assq 'tool-bar-lines default-frame-alist))))
869 (setq tool-bar-originally-present 795 (setq tool-bar-originally-present
870 (not (or (null tool-bar-lines) 796 (and tool-bar-lines
871 (null (cdr tool-bar-lines)) 797 (cdr tool-bar-lines)
872 (eq 0 (cdr tool-bar-lines))))))) 798 (not (eq 0 (cdr tool-bar-lines)))))))
873 799
874 (let ((old-scalable-fonts-allowed scalable-fonts-allowed) 800 (let ((old-scalable-fonts-allowed scalable-fonts-allowed)
875 (old-font-list-limit font-list-limit) 801 (old-font-list-limit font-list-limit)
876 (old-face-ignored-fonts face-ignored-fonts)) 802 (old-face-ignored-fonts face-ignored-fonts))
877
878 (run-hooks 'before-init-hook)
879 803
880 ;; Run the site-start library if it exists. The point of this file is 804 ;; Run the site-start library if it exists. The point of this file is
881 ;; that it is run before .emacs. There is no point in doing this after 805 ;; that it is run before .emacs. There is no point in doing this after
882 ;; .emacs; that is useless. 806 ;; .emacs; that is useless.
883 (if site-run-file 807 (if site-run-file
884 (load site-run-file t t)) 808 (load site-run-file t t))
885 809
886 ;; Sites should not disable this. Only individuals should disable 810 ;; Sites should not disable this. Only individuals should disable
887 ;; the startup message. 811 ;; the startup message.
888 (setq inhibit-startup-message nil) 812 (setq inhibit-startup-message nil)
813
814 ;; Warn for invalid user name.
815 (when init-file-user
816 (if (string-match "[~/:\n]" init-file-user)
817 (display-warning 'initialization
818 (format "Invalid user name %s"
819 init-file-user)
820 :error)
821 (if (file-directory-p (expand-file-name (concat "~" init-file-user)))
822 nil
823 (display-warning 'initialization
824 (format "User %s has no home directory"
825 init-file-user)
826 :error))))
889 827
890 ;; Load that user's init file, or the default one, or none. 828 ;; Load that user's init file, or the default one, or none.
891 (let (debug-on-error-from-init-file 829 (let (debug-on-error-from-init-file
892 debug-on-error-should-be-set 830 debug-on-error-should-be-set
893 (debug-on-error-initial 831 (debug-on-error-initial
902 (let ((user-init-file-1 840 (let ((user-init-file-1
903 (cond 841 (cond
904 ((eq system-type 'ms-dos) 842 ((eq system-type 'ms-dos)
905 (concat "~" init-file-user "/_emacs")) 843 (concat "~" init-file-user "/_emacs"))
906 ((eq system-type 'windows-nt) 844 ((eq system-type 'windows-nt)
845 ;; Prefer .emacs on Windows.
907 (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") 846 (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
908 "~/.emacs" 847 "~/.emacs"
909 "~/_emacs")) 848 ;; Also support _emacs for compatibility.
849 (if (directory-files "~" nil "^_emacs\\(\\.elc?\\)?$")
850 "~/_emacs"
851 ;; But default to .emacs if _emacs does not exist.
852 "~/.emacs")))
910 ((eq system-type 'vax-vms) 853 ((eq system-type 'vax-vms)
911 "sys$login:.emacs") 854 "sys$login:.emacs")
912 (t 855 (t
913 (concat "~" init-file-user "/.emacs"))))) 856 (concat "~" init-file-user "/.emacs")))))
914 ;; This tells `load' to store the file name found 857 ;; This tells `load' to store the file name found
916 (setq user-init-file t) 859 (setq user-init-file t)
917 (load user-init-file-1 t t) 860 (load user-init-file-1 t t)
918 861
919 (when (eq user-init-file t) 862 (when (eq user-init-file t)
920 ;; If we did not find ~/.emacs, try 863 ;; If we did not find ~/.emacs, try
921 ;; ~/.emacs.d/.emacs. 864 ;; ~/.emacs.d/init.el.
922 (let ((otherfile 865 (let ((otherfile
923 (expand-file-name 866 (expand-file-name
924 (file-name-nondirectory user-init-file-1) 867 "init"
925 (file-name-as-directory 868 (file-name-as-directory
926 (expand-file-name 869 (concat "~" init-file-user "/.emacs.d")))))
927 ".emacs.d"
928 (file-name-directory user-init-file-1))))))
929 (load otherfile t t) 870 (load otherfile t t)
930 871
931 ;; If we did not find the user's init file, 872 ;; If we did not find the user's init file,
932 ;; set user-init-file conclusively. 873 ;; set user-init-file conclusively.
933 ;; Don't let it be set from default.el. 874 ;; Don't let it be set from default.el.
950 (message "Warning: %s is newer than %s" 891 (message "Warning: %s is newer than %s"
951 source user-init-file) 892 source user-init-file)
952 (sit-for 1)) 893 (sit-for 1))
953 (setq user-init-file source)))) 894 (setq user-init-file source))))
954 895
955 (when (and (stringp custom-file) 896 (unless inhibit-default-init
956 (not (assoc custom-file load-history))) 897 (let ((inhibit-startup-message nil))
957 ;; If the .emacs file has set `custom-file' but hasn't 898 ;; Users are supposed to be told their rights.
958 ;; loaded the file yet, let's load it. 899 ;; (Plus how to get help and how to undo.)
959 (load custom-file t t)) 900 ;; Don't you dare turn this off for anyone
960 901 ;; except yourself.
961 (or inhibit-default-init 902 (load "default" t t)))))))))
962 (let ((inhibit-startup-message nil))
963 ;; Users are supposed to be told their rights.
964 ;; (Plus how to get help and how to undo.)
965 ;; Don't you dare turn this off for anyone
966 ;; except yourself.
967 (load "default" t t)))))))))
968 (if init-file-debug 903 (if init-file-debug
969 ;; Do this without a condition-case if the user wants to debug. 904 ;; Do this without a condition-case if the user wants to debug.
970 (funcall inner) 905 (funcall inner)
971 (condition-case error 906 (condition-case error
972 (progn 907 (progn
980 (format "An error has occurred while loading `%s':\n\n" 915 (format "An error has occurred while loading `%s':\n\n"
981 user-init-file) 916 user-init-file)
982 (format "%s%s%s" 917 (format "%s%s%s"
983 (get (car error) 'error-message) 918 (get (car error) 'error-message)
984 (if (cdr error) ": " "") 919 (if (cdr error) ": " "")
985 (mapconcat 'prin1-to-string (cdr error) ", ")) 920 (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", "))
986 "\n\n" 921 "\n\n"
987 "To ensure normal operation, you should investigate the cause\n" 922 "To ensure normal operation, you should investigate and remove the\n"
988 "of the error in your initialization file and remove it. Start\n" 923 "cause of the error in your initialization file. Start Emacs with\n"
989 "Emacs with the `--debug-init' option to view a complete error\n" 924 "the `--debug-init' option to view a complete error backtrace.\n\n"))
990 "backtrace\n"))
991 (message "Error in init file: %s%s%s" 925 (message "Error in init file: %s%s%s"
992 (get (car error) 'error-message) 926 (get (car error) 'error-message)
993 (if (cdr error) ": " "") 927 (if (cdr error) ": " "")
994 (mapconcat 'prin1-to-string (cdr error) ", ")) 928 (mapconcat 'prin1-to-string (cdr error) ", "))
995 (pop-to-buffer "*Messages*") 929 (let ((pop-up-windows nil))
930 (pop-to-buffer "*Messages*"))
996 (setq init-file-had-error t))))) 931 (setq init-file-had-error t)))))
932
933 (if (and deactivate-mark transient-mark-mode)
934 (with-current-buffer (window-buffer)
935 (deactivate-mark)))
997 936
998 ;; If the user has a file of abbrevs, read it. 937 ;; If the user has a file of abbrevs, read it.
999 (if (file-exists-p abbrev-file-name) 938 (if (file-exists-p abbrev-file-name)
1000 (quietly-read-abbrev-file abbrev-file-name)) 939 (quietly-read-abbrev-file abbrev-file-name))
1001 940
1030 (if (equal user-mail-address "") 969 (if (equal user-mail-address "")
1031 (setq user-mail-address (concat (user-login-name) "@" 970 (setq user-mail-address (concat (user-login-name) "@"
1032 (or mail-host-address 971 (or mail-host-address
1033 (system-name))))) 972 (system-name)))))
1034 973
974 ;; Originally face attributes were specified via
975 ;; `font-lock-face-attributes'. Users then changed the default
976 ;; face attributes by setting that variable. However, we try and
977 ;; be back-compatible and respect its value if set except for
978 ;; faces where M-x customize has been used to save changes for the
979 ;; face.
980 (when (boundp 'font-lock-face-attributes)
981 (let ((face-attributes font-lock-face-attributes))
982 (while face-attributes
983 (let* ((face-attribute (pop face-attributes))
984 (face (car face-attribute)))
985 ;; Rustle up a `defface' SPEC from a
986 ;; `font-lock-face-attributes' entry.
987 (unless (get face 'saved-face)
988 (let ((foreground (nth 1 face-attribute))
989 (background (nth 2 face-attribute))
990 (bold-p (nth 3 face-attribute))
991 (italic-p (nth 4 face-attribute))
992 (underline-p (nth 5 face-attribute))
993 face-spec)
994 (when foreground
995 (setq face-spec (cons ':foreground (cons foreground face-spec))))
996 (when background
997 (setq face-spec (cons ':background (cons background face-spec))))
998 (when bold-p
999 (setq face-spec (append '(:weight bold) face-spec)))
1000 (when italic-p
1001 (setq face-spec (append '(:slant italic) face-spec)))
1002 (when underline-p
1003 (setq face-spec (append '(:underline t) face-spec)))
1004 (face-spec-set face (list (list t face-spec)) nil)))))))
1005
1035 ;; If parameter have been changed in the init file which influence 1006 ;; If parameter have been changed in the init file which influence
1036 ;; face realization, clear the face cache so that new faces will 1007 ;; face realization, clear the face cache so that new faces will
1037 ;; be realized. 1008 ;; be realized.
1038 (unless (and (eq scalable-fonts-allowed old-scalable-fonts-allowed) 1009 (unless (and (eq scalable-fonts-allowed old-scalable-fonts-allowed)
1039 (eq font-list-limit old-font-list-limit) 1010 (eq font-list-limit old-font-list-limit)
1040 (eq face-ignored-fonts old-face-ignored-fonts)) 1011 (eq face-ignored-fonts old-face-ignored-fonts))
1041 (clear-face-cache))) 1012 (clear-face-cache)))
1042 1013
1043 (run-hooks 'after-init-hook) 1014 (run-hooks 'after-init-hook)
1044 1015
1016 ;; Decode all default-directory.
1017 (if (and default-enable-multibyte-characters locale-coding-system)
1018 (save-excursion
1019 (dolist (elt (buffer-list))
1020 (set-buffer elt)
1021 (if default-directory
1022 (setq default-directory
1023 (decode-coding-string default-directory
1024 locale-coding-system t))))
1025 (setq command-line-default-directory
1026 (decode-coding-string command-line-default-directory
1027 locale-coding-system t))))
1028
1045 ;; If *scratch* exists and init file didn't change its mode, initialize it. 1029 ;; If *scratch* exists and init file didn't change its mode, initialize it.
1046 (if (get-buffer "*scratch*") 1030 (if (get-buffer "*scratch*")
1047 (with-current-buffer "*scratch*" 1031 (with-current-buffer "*scratch*"
1048 (if (eq major-mode 'fundamental-mode) 1032 (if (eq major-mode 'fundamental-mode)
1049 (funcall initial-major-mode)))) 1033 (funcall initial-major-mode))))
1050 1034
1051 ;; Load library for our terminal type. 1035 ;; Load library for our terminal type.
1052 ;; User init file can set term-file-prefix to nil to prevent this. 1036 ;; User init file can set term-file-prefix to nil to prevent this.
1053 (and term-file-prefix (not noninteractive) (not window-system) 1037 (unless (or noninteractive
1054 (let ((term (getenv "TERM")) 1038 window-system
1055 hyphend) 1039 (null term-file-prefix))
1056 (while (and term 1040 (let* ((TERM (getenv "TERM"))
1057 (not (load (concat term-file-prefix term) t t))) 1041 (term TERM)
1058 ;; Strip off last hyphen and what follows, then try again 1042 hyphend)
1059 (if (setq hyphend (string-match "[-_][^-_]+$" term)) 1043 (while (and term
1060 (setq term (substring term 0 hyphend)) 1044 (not (load (concat term-file-prefix term) t t)))
1061 (setq term nil))))) 1045 ;; Strip off last hyphen and what follows, then try again
1046 (setq term
1047 (if (setq hyphend (string-match "[-_][^-_]+\\'" term))
1048 (substring term 0 hyphend)
1049 nil)))
1050 (setq term TERM)
1051 ;; The terminal file has been loaded, now call the terminal specific
1052 ;; initialization function.
1053 (while term
1054 (let ((term-init-func (intern-soft (concat "terminal-init-" term))))
1055 (if (not (fboundp term-init-func))
1056 ;; Strip off last hyphen and what follows, then try again
1057 (setq term
1058 (if (setq hyphend (string-match "[-_][^-_]+\\'" term))
1059 (substring term 0 hyphend)
1060 nil))
1061 (setq term nil)
1062 (funcall term-init-func))))))
1062 1063
1063 ;; Update the out-of-memory error message based on user's key bindings 1064 ;; Update the out-of-memory error message based on user's key bindings
1064 ;; for save-some-buffers. 1065 ;; for save-some-buffers.
1065 (setq memory-signal-data 1066 (setq memory-signal-data
1066 (list 'error 1067 (list 'error
1072 ;; If -batch, terminate after processing the command options. 1073 ;; If -batch, terminate after processing the command options.
1073 (if noninteractive (kill-emacs t)) 1074 (if noninteractive (kill-emacs t))
1074 1075
1075 ;; Run emacs-session-restore (session management) if started by 1076 ;; Run emacs-session-restore (session management) if started by
1076 ;; the session manager and we have a session manager connection. 1077 ;; the session manager and we have a session manager connection.
1077 (if (and (boundp 'x-session-previous-id) (stringp x-session-previous-id)) 1078 (if (and (boundp 'x-session-previous-id)
1078 (emacs-session-restore x-session-previous-id))) 1079 (stringp x-session-previous-id))
1080 (with-no-warnings
1081 (emacs-session-restore x-session-previous-id))))
1079 1082
1080 (defcustom initial-scratch-message (purecopy "\ 1083 (defcustom initial-scratch-message (purecopy "\
1081 ;; This buffer is for notes you don't want to save, and for Lisp evaluation. 1084 ;; This buffer is for notes you don't want to save, and for Lisp evaluation.
1082 ;; If you want to create a file, visit that file with C-x C-f, 1085 ;; If you want to create a file, visit that file with C-x C-f,
1083 ;; then enter the text in that file's own buffer. 1086 ;; then enter the text in that file's own buffer.
1098 '((:face variable-pitch 1101 '((:face variable-pitch
1099 "You can do basic editing with the menu bar and scroll bar \ 1102 "You can do basic editing with the menu bar and scroll bar \
1100 using the mouse.\n\n" 1103 using the mouse.\n\n"
1101 :face (variable-pitch :weight bold) 1104 :face (variable-pitch :weight bold)
1102 "Important Help menu items:\n" 1105 "Important Help menu items:\n"
1103 :face variable-pitch "\ 1106 :face variable-pitch
1104 Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently 1107 (lambda ()
1108 (let* ((en "TUTORIAL")
1109 (tut (or (get-language-info current-language-environment
1110 'tutorial)
1111 en))
1112 (title (with-temp-buffer
1113 (insert-file-contents
1114 (expand-file-name tut data-directory)
1115 nil 0 256)
1116 (search-forward ".")
1117 (buffer-substring (point-min) (1- (point))))))
1118 ;; If there is a specific tutorial for the current language
1119 ;; environment and it is not English, append its title.
1120 (concat
1121 "Emacs Tutorial\tLearn how to use Emacs efficiently"
1122 (if (string= en tut)
1123 ""
1124 (concat " (" title ")"))
1125 "\n")))
1126 :face variable-pitch "\
1105 Emacs FAQ\tFrequently asked questions and answers 1127 Emacs FAQ\tFrequently asked questions and answers
1106 Read the Emacs Manual\tView the Emacs manual using Info 1128 Read the Emacs Manual\tView the Emacs manual using Info
1107 \(Non)Warranty\tGNU Emacs comes with " 1129 \(Non)Warranty\tGNU Emacs comes with "
1108 :face (variable-pitch :slant oblique) 1130 :face (variable-pitch :slant oblique)
1109 "ABSOLUTELY NO WARRANTY\n" 1131 "ABSOLUTELY NO WARRANTY\n"
1110 :face variable-pitch 1132 :face variable-pitch
1111 "\ 1133 "\
1112 Copying Conditions\tConditions for redistributing and changing Emacs 1134 Copying Conditions\tConditions for redistributing and changing Emacs
1135 Getting New Versions\tHow to obtain the latest version of Emacs
1113 More Manuals / Ordering Manuals Buying printed manuals from the FSF\n") 1136 More Manuals / Ordering Manuals Buying printed manuals from the FSF\n")
1114 (:face variable-pitch 1137 (:face variable-pitch
1115 "You can do basic editing with the menu bar and scroll bar \ 1138 "You can do basic editing with the menu bar and scroll bar \
1116 using the mouse.\n\n" 1139 using the mouse.\n\n"
1117 :face (variable-pitch :weight bold) 1140 :face (variable-pitch :weight bold)
1118 "Useful File menu items:\n" 1141 "Useful File menu items:\n"
1119 :face variable-pitch "\ 1142 :face variable-pitch "\
1120 Exit Emacs\t(Or type Control-x followed by Control-c) 1143 Exit Emacs\t(Or type Control-x followed by Control-c)
1121 Recover Session\tRecover files you were editing before a crash 1144 Recover Crashed Session\tRecover files you were editing before a crash
1122 1145
1123 1146
1124 1147
1125 1148
1126 " 1149 "
1134 "Fancy splash screen when Emacs starts." 1157 "Fancy splash screen when Emacs starts."
1135 :version "21.1" 1158 :version "21.1"
1136 :group 'initialization) 1159 :group 'initialization)
1137 1160
1138 1161
1139 (defcustom fancy-splash-delay 10 1162 (defcustom fancy-splash-delay 7
1140 "*Delay in seconds between splash screens." 1163 "*Delay in seconds between splash screens."
1141 :group 'fancy-splash-screen 1164 :group 'fancy-splash-screen
1142 :type 'integer) 1165 :type 'integer)
1143 1166
1144 1167
1145 (defcustom fancy-splash-max-time 60 1168 (defcustom fancy-splash-max-time 30
1146 "*Show splash screens for at most this number of seconds. 1169 "*Show splash screens for at most this number of seconds.
1147 Values less than 60 seconds are ignored." 1170 Values less than twice `fancy-splash-delay' are ignored."
1148 :group 'fancy-splash-screen 1171 :group 'fancy-splash-screen
1149 :type 'integer) 1172 :type 'integer)
1150 1173
1151 1174
1152 (defcustom fancy-splash-image nil 1175 (defcustom fancy-splash-image nil
1163 (defvar fancy-splash-stop-time nil) 1186 (defvar fancy-splash-stop-time nil)
1164 (defvar fancy-splash-outer-buffer nil) 1187 (defvar fancy-splash-outer-buffer nil)
1165 1188
1166 (defun fancy-splash-insert (&rest args) 1189 (defun fancy-splash-insert (&rest args)
1167 "Insert text into the current buffer, with faces. 1190 "Insert text into the current buffer, with faces.
1168 Arguments from ARGS should be either strings or pairs `:face FACE', 1191 Arguments from ARGS should be either strings, functions called
1192 with no args that return a string, or pairs `:face FACE',
1169 where FACE is a valid face specification, as it can be used with 1193 where FACE is a valid face specification, as it can be used with
1170 `put-text-properties'." 1194 `put-text-property'."
1171 (let ((current-face nil)) 1195 (let ((current-face nil))
1172 (while args 1196 (while args
1173 (if (eq (car args) :face) 1197 (if (eq (car args) :face)
1174 (setq args (cdr args) current-face (car args)) 1198 (setq args (cdr args) current-face (car args))
1175 (insert (propertize (car args) 1199 (insert (propertize (let ((it (car args)))
1200 (if (functionp it)
1201 (funcall it)
1202 it))
1176 'face current-face 1203 'face current-face
1177 'help-echo fancy-splash-help-echo))) 1204 'help-echo fancy-splash-help-echo)))
1178 (setq args (cdr args))))) 1205 (setq args (cdr args)))))
1179 1206
1180 1207
1193 (image-width (and img (car (image-size img)))) 1220 (image-width (and img (car (image-size img))))
1194 (window-width (window-width (selected-window)))) 1221 (window-width (window-width (selected-window))))
1195 (when img 1222 (when img
1196 (when (> window-width image-width) 1223 (when (> window-width image-width)
1197 ;; Center the image in the window. 1224 ;; Center the image in the window.
1198 (let ((pos (/ (- window-width image-width) 2))) 1225 (insert (propertize " " 'display
1199 (insert (propertize " " 'display `(space :align-to ,pos)))) 1226 `(space :align-to (+ center (-0.5 . ,img)))))
1200 1227
1201 ;; Change the color of the XPM version of the splash image 1228 ;; Change the color of the XPM version of the splash image
1202 ;; so that it is visible with a dark frame background. 1229 ;; so that it is visible with a dark frame background.
1203 (when (and (memq 'xpm img) 1230 (when (and (memq 'xpm img)
1204 (eq (frame-parameter nil 'background-mode) 'dark)) 1231 (eq (frame-parameter nil 'background-mode) 'dark))
1236 (fancy-splash-insert :face `(variable-pitch :foreground ,fg) 1263 (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
1237 "\nThis is " 1264 "\nThis is "
1238 (emacs-version) 1265 (emacs-version)
1239 "\n" 1266 "\n"
1240 :face '(variable-pitch :height 0.5) 1267 :face '(variable-pitch :height 0.5)
1241 "Copyright (C) 2002 Free Software Foundation, Inc.") 1268 "Copyright (C) 2006 Free Software Foundation, Inc.")
1242 (and auto-save-list-file-prefix 1269 (and auto-save-list-file-prefix
1243 ;; Don't signal an error if the 1270 ;; Don't signal an error if the
1244 ;; directory for auto-save-list files 1271 ;; directory for auto-save-list files
1245 ;; does not yet exist. 1272 ;; does not yet exist.
1246 (file-directory-p (file-name-directory 1273 (file-directory-p (file-name-directory
1264 (unless fancy-current-text 1291 (unless fancy-current-text
1265 (setq fancy-current-text fancy-splash-text)) 1292 (setq fancy-current-text fancy-splash-text))
1266 (let ((text (car fancy-current-text))) 1293 (let ((text (car fancy-current-text)))
1267 (set-buffer buffer) 1294 (set-buffer buffer)
1268 (erase-buffer) 1295 (erase-buffer)
1296 (if pure-space-overflow
1297 (insert "Warning Warning Pure space overflow Warning Warning\n"))
1269 (fancy-splash-head) 1298 (fancy-splash-head)
1270 (apply #'fancy-splash-insert text) 1299 (apply #'fancy-splash-insert text)
1271 (fancy-splash-tail) 1300 (fancy-splash-tail)
1272 (unless (current-message) 1301 (unless (current-message)
1273 (message fancy-splash-help-echo)) 1302 (message fancy-splash-help-echo))
1276 (force-mode-line-update) 1305 (force-mode-line-update)
1277 (setq fancy-current-text (cdr fancy-current-text)))) 1306 (setq fancy-current-text (cdr fancy-current-text))))
1278 1307
1279 1308
1280 (defun fancy-splash-default-action () 1309 (defun fancy-splash-default-action ()
1281 "Default action for events in the splash screen buffer." 1310 "Stop displaying the splash screen buffer.
1311 This is an internal function used to turn off the splash screen after
1312 the user caused an input event by hitting a key or clicking with the
1313 mouse."
1282 (interactive) 1314 (interactive)
1283 (push last-command-event unread-command-events) 1315 (if (and (memq 'down (event-modifiers last-command-event))
1316 (eq (posn-window (event-start last-command-event))
1317 (selected-window)))
1318 ;; This is a mouse-down event in the spash screen window.
1319 ;; Ignore it and consume the corresponding mouse-up event.
1320 (read-event)
1321 (push last-command-event unread-command-events))
1284 (throw 'exit nil)) 1322 (throw 'exit nil))
1285 1323
1286 1324
1287 (defun fancy-splash-screens () 1325 (defun fancy-splash-screens ()
1288 "Display fancy splash screens when Emacs starts." 1326 "Display fancy splash screens when Emacs starts."
1311 minor-mode-map-alist nil 1349 minor-mode-map-alist nil
1312 buffer-undo-list t 1350 buffer-undo-list t
1313 mode-line-format (propertize "---- %b %-" 1351 mode-line-format (propertize "---- %b %-"
1314 'face '(:weight bold)) 1352 'face '(:weight bold))
1315 fancy-splash-stop-time (+ (float-time) 1353 fancy-splash-stop-time (+ (float-time)
1316 (max 60 fancy-splash-max-time)) 1354 fancy-splash-max-time)
1317 timer (run-with-timer 0 fancy-splash-delay 1355 timer (run-with-timer 0 fancy-splash-delay
1318 #'fancy-splash-screens-1 1356 #'fancy-splash-screens-1
1319 splash-buffer)) 1357 splash-buffer))
1320 (recursive-edit)) 1358 (recursive-edit))
1321 (cancel-timer timer) 1359 (cancel-timer timer)
1335 (setq chosen-frame frame))) 1373 (setq chosen-frame frame)))
1336 chosen-frame)) 1374 chosen-frame))
1337 1375
1338 (defun use-fancy-splash-screens-p () 1376 (defun use-fancy-splash-screens-p ()
1339 "Return t if fancy splash screens should be used." 1377 "Return t if fancy splash screens should be used."
1340 (when (or (and (display-color-p) 1378 (when (and (display-graphic-p)
1379 (or (and (display-color-p)
1341 (image-type-available-p 'xpm)) 1380 (image-type-available-p 'xpm))
1342 (image-type-available-p 'pbm)) 1381 (image-type-available-p 'pbm)))
1343 (let ((frame (fancy-splash-frame))) 1382 (let ((frame (fancy-splash-frame)))
1344 (when frame 1383 (when frame
1345 (let* ((img (create-image (or fancy-splash-image 1384 (let* ((img (create-image (or fancy-splash-image
1346 (if (and (display-color-p) 1385 (if (and (display-color-p)
1347 (image-type-available-p 'xpm)) 1386 (image-type-available-p 'xpm))
1358 (with-current-buffer (get-buffer-create "GNU Emacs") 1397 (with-current-buffer (get-buffer-create "GNU Emacs")
1359 (let ((tab-width 8) 1398 (let ((tab-width 8)
1360 (mode-line-format (propertize "---- %b %-" 1399 (mode-line-format (propertize "---- %b %-"
1361 'face '(:weight bold)))) 1400 'face '(:weight bold))))
1362 1401
1402 (if pure-space-overflow
1403 (insert "Warning Warning Pure space overflow Warning Warning\n"))
1404
1363 ;; The convention for this piece of code is that 1405 ;; The convention for this piece of code is that
1364 ;; each piece of output starts with one or two newlines 1406 ;; each piece of output starts with one or two newlines
1365 ;; and does not end with any newlines. 1407 ;; and does not end with any newlines.
1366 (insert "Welcome to GNU Emacs") 1408 (insert "Welcome to GNU Emacs")
1367 (insert 1409 (insert
1380 (insert "\ 1422 (insert "\
1381 You can do basic editing with the menu bar and scroll bar using the mouse. 1423 You can do basic editing with the menu bar and scroll bar using the mouse.
1382 1424
1383 Useful File menu items: 1425 Useful File menu items:
1384 Exit Emacs (or type Control-x followed by Control-c) 1426 Exit Emacs (or type Control-x followed by Control-c)
1385 Recover Session recover files you were editing before a crash 1427 Recover Crashed Session Recover files you were editing before a crash
1386 1428
1387 Important Help menu items: 1429 Important Help menu items:
1388 Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently. 1430 Emacs Tutorial Learn how to use Emacs efficiently
1389 Emacs FAQ Frequently asked questions and answers 1431 Emacs FAQ Frequently asked questions and answers
1390 Read the Emacs Manual View the Emacs manual using Info 1432 Read the Emacs Manual View the Emacs manual using Info
1391 \(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY 1433 \(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
1392 Copying Conditions Conditions for redistributing and changing Emacs. 1434 Copying Conditions Conditions for redistributing and changing Emacs
1393 Getting New Versions How to obtain the latest version of Emacs. 1435 Getting New Versions How to obtain the latest version of Emacs
1394 More Manuals / Ordering Manuals How to order printed manuals from the FSF. 1436 More Manuals / Ordering Manuals How to order printed manuals from the FSF
1395 ") 1437 ")
1396 (insert "\n\n" (emacs-version) 1438 (insert "\n\n" (emacs-version)
1397 " 1439 "
1398 Copyright (C) 2002 Free Software Foundation, Inc.")) 1440 Copyright (C) 2006 Free Software Foundation, Inc."))
1399 1441
1400 ;; No mouse menus, so give help using kbd commands. 1442 ;; No mouse menus, so give help using kbd commands.
1401 1443
1402 ;; If keys have their default meanings, 1444 ;; If keys have their default meanings,
1403 ;; use precomputed string to save lots of time. 1445 ;; use precomputed string to save lots of time.
1441 \(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. 1483 \(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
1442 If you have no Meta key, you may instead type ESC followed by the character.)") 1484 If you have no Meta key, you may instead type ESC followed by the character.)")
1443 1485
1444 (insert "\n\n" (emacs-version) 1486 (insert "\n\n" (emacs-version)
1445 " 1487 "
1446 Copyright (C) 2002 Free Software Foundation, Inc.") 1488 Copyright (C) 2006 Free Software Foundation, Inc.")
1447 1489
1448 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) 1490 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
1449 (eq (key-binding "\C-h\C-d") 'describe-distribution) 1491 (eq (key-binding "\C-h\C-d") 'describe-distribution)
1450 (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) 1492 (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
1451 (insert 1493 (insert
1500 \\[describe-project]."))) 1542 \\[describe-project].")))
1501 1543
1502 1544
1503 (defun display-startup-echo-area-message () 1545 (defun display-startup-echo-area-message ()
1504 (let ((resize-mini-windows t)) 1546 (let ((resize-mini-windows t))
1505 (message (startup-echo-area-message)))) 1547 (message "%s" (startup-echo-area-message))))
1506 1548
1507 1549
1508 (defun display-splash-screen () 1550 (defun display-splash-screen ()
1509 "Display splash screen according to display. 1551 "Display splash screen according to display.
1510 Fancy splash screens are used on graphic displays, 1552 Fancy splash screens are used on graphic displays,
1511 normal otherwise." 1553 normal otherwise."
1512 (interactive) 1554 (interactive)
1513 (if (and (display-graphic-p) 1555 (if (use-fancy-splash-screens-p)
1514 (use-fancy-splash-screens-p))
1515 (fancy-splash-screens) 1556 (fancy-splash-screens)
1516 (normal-splash-screen))) 1557 (normal-splash-screen)))
1517 1558
1518 1559
1519 (defun command-line-1 (command-line-args-left) 1560 (defun command-line-1 (command-line-args-left)
1521 ;; t if the init file says to inhibit the echo area startup message. 1562 ;; t if the init file says to inhibit the echo area startup message.
1522 (and inhibit-startup-echo-area-message 1563 (and inhibit-startup-echo-area-message
1523 user-init-file 1564 user-init-file
1524 (or (and (get 'inhibit-startup-echo-area-message 'saved-value) 1565 (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
1525 (equal inhibit-startup-echo-area-message 1566 (equal inhibit-startup-echo-area-message
1526 (if (string= init-file-user "") 1567 (if (equal init-file-user "")
1527 (user-login-name) 1568 (user-login-name)
1528 init-file-user))) 1569 init-file-user)))
1529 ;; Wasn't set with custom; see if .emacs has a setq. 1570 ;; Wasn't set with custom; see if .emacs has a setq.
1530 (let ((buffer (get-buffer-create " *temp*"))) 1571 (let ((buffer (get-buffer-create " *temp*")))
1531 (prog1 1572 (prog1
1537 (concat 1578 (concat
1538 "([ \t\n]*setq[ \t\n]+" 1579 "([ \t\n]*setq[ \t\n]+"
1539 "inhibit-startup-echo-area-message[ \t\n]+" 1580 "inhibit-startup-echo-area-message[ \t\n]+"
1540 (regexp-quote 1581 (regexp-quote
1541 (prin1-to-string 1582 (prin1-to-string
1542 (if (string= init-file-user "") 1583 (if (equal init-file-user "")
1543 (user-login-name) 1584 (user-login-name)
1544 init-file-user))) 1585 init-file-user)))
1545 "[ \t\n]*)") 1586 "[ \t\n]*)")
1546 nil t)) 1587 nil t))
1547 (error nil)) 1588 (error nil))
1548 (kill-buffer buffer))))) 1589 (kill-buffer buffer)))))
1549 (display-startup-echo-area-message)) 1590 ;; display-splash-screen at the end of command-line-1 calls
1591 ;; use-fancy-splash-screens-p. This can cause image.el to be
1592 ;; loaded, putting "Loading image... done" in the echo area.
1593 ;; This hides startup-echo-area-message. So
1594 ;; use-fancy-splash-screens-p is called here simply to get the
1595 ;; loading of image.el (if needed) out of the way before
1596 ;; display-startup-echo-area-message runs.
1597 (progn
1598 (use-fancy-splash-screens-p)
1599 (display-startup-echo-area-message)))
1550 1600
1551 ;; Delay 2 seconds after an init file error message 1601 ;; Delay 2 seconds after an init file error message
1552 ;; was displayed, so user can read it. 1602 ;; was displayed, so user can read it.
1553 (if init-file-had-error 1603 (when init-file-had-error
1554 (sit-for 2)) 1604 (sit-for 2))
1555 1605
1556 (if command-line-args-left 1606 (when command-line-args-left
1557 ;; We have command args; process them. 1607 ;; We have command args; process them.
1558 (let ((dir command-line-default-directory) 1608 (let ((dir command-line-default-directory)
1559 (file-count 0) 1609 (file-count 0)
1560 first-file-buffer 1610 first-file-buffer
1561 tem 1611 tem
1562 just-files ;; t if this follows the magic -- option. 1612 ;; This approach loses for "-batch -L DIR --eval "(require foo)",
1563 ;; This includes our standard options' long versions 1613 ;; if foo is intended to be found in DIR.
1564 ;; and long versions of what's on command-switch-alist. 1614 ;;
1565 (longopts 1615 ;; ;; The directories listed in --directory/-L options will *appear*
1566 (append '(("--funcall") ("--load") ("--insert") ("--kill") 1616 ;; ;; at the front of `load-path' in the order they appear on the
1567 ("--directory") ("--eval") ("--execute") ("--no-splash") 1617 ;; ;; command-line. We cannot do this by *placing* them at the front
1568 ("--find-file") ("--visit") ("--file")) 1618 ;; ;; in the order they appear, so we need this variable to hold them,
1569 (mapcar (lambda (elt) 1619 ;; ;; temporarily.
1570 (list (concat "-" (car elt)))) 1620 ;; extra-load-path
1571 command-switch-alist))) 1621 ;;
1572 (line 0) 1622 ;; To DTRT we keep track of the splice point and modify `load-path'
1573 (column 0)) 1623 ;; straight away upon any --directory/-L option.
1574 1624 splice
1575 ;; Add the long X options to longopts. 1625 just-files ;; t if this follows the magic -- option.
1576 (dolist (tem command-line-x-option-alist) 1626 ;; This includes our standard options' long versions
1577 (if (string-match "^--" (car tem)) 1627 ;; and long versions of what's on command-switch-alist.
1578 (push (list (car tem)) longopts))) 1628 (longopts
1579 1629 (append '(("--funcall") ("--load") ("--insert") ("--kill")
1580 ;; Loop, processing options. 1630 ("--directory") ("--eval") ("--execute") ("--no-splash")
1581 (while (and command-line-args-left) 1631 ("--find-file") ("--visit") ("--file"))
1582 (let* ((argi (car command-line-args-left)) 1632 (mapcar (lambda (elt)
1583 (orig-argi argi) 1633 (list (concat "-" (car elt))))
1584 argval completion 1634 command-switch-alist)))
1585 ;; List of directories specified in -L/--directory, 1635 (line 0)
1586 ;; in reverse of the order specified. 1636 (column 0))
1587 extra-load-path 1637
1588 (initial-load-path load-path)) 1638 ;; Add the long X options to longopts.
1589 (setq command-line-args-left (cdr command-line-args-left)) 1639 (dolist (tem command-line-x-option-alist)
1590 1640 (if (string-match "^--" (car tem))
1591 ;; Do preliminary decoding of the option. 1641 (push (list (car tem)) longopts)))
1592 (if just-files 1642
1593 ;; After --, don't look for options; treat all args as files. 1643 ;; Loop, processing options.
1594 (setq argi "") 1644 (while command-line-args-left
1595 ;; Convert long options to ordinary options 1645 (let* ((argi (car command-line-args-left))
1596 ;; and separate out an attached option argument into argval. 1646 (orig-argi argi)
1597 (if (string-match "^--[^=]*=" argi) 1647 argval completion)
1598 (setq argval (substring argi (match-end 0)) 1648 (setq command-line-args-left (cdr command-line-args-left))
1599 argi (substring argi 0 (1- (match-end 0))))) 1649
1600 (if (equal argi "--") 1650 ;; Do preliminary decoding of the option.
1601 (setq completion nil) 1651 (if just-files
1602 (setq completion (try-completion argi longopts))) 1652 ;; After --, don't look for options; treat all args as files.
1603 (if (eq completion t) 1653 (setq argi "")
1604 (setq argi (substring argi 1)) 1654 ;; Convert long options to ordinary options
1605 (if (stringp completion) 1655 ;; and separate out an attached option argument into argval.
1606 (let ((elt (assoc completion longopts))) 1656 (when (string-match "^\\(--[^=]*\\)=" argi)
1607 (or elt 1657 (setq argval (substring argi (match-end 0))
1608 (error "Option `%s' is ambiguous" argi)) 1658 argi (match-string 1 argi)))
1609 (setq argi (substring (car elt) 1))) 1659 (if (equal argi "--")
1610 (setq argval nil argi orig-argi)))) 1660 (setq completion nil)
1611 1661 (setq completion (try-completion argi longopts)))
1612 ;; Execute the option. 1662 (if (eq completion t)
1613 (cond ((setq tem (assoc argi command-switch-alist)) 1663 (setq argi (substring argi 1))
1614 (if argval 1664 (if (stringp completion)
1615 (let ((command-line-args-left 1665 (let ((elt (assoc completion longopts)))
1616 (cons argval command-line-args-left))) 1666 (or elt
1617 (funcall (cdr tem) argi)) 1667 (error "Option `%s' is ambiguous" argi))
1618 (funcall (cdr tem) argi))) 1668 (setq argi (substring (car elt) 1)))
1619 1669 (setq argval nil
1620 ((string-equal argi "-no-splash") 1670 argi orig-argi))))
1621 (setq inhibit-startup-message t)) 1671
1622 1672 ;; Execute the option.
1623 ((member argi '("-f" ;what the manual claims 1673 (cond ((setq tem (assoc argi command-switch-alist))
1624 "-funcall" 1674 (if argval
1625 "-e")) ; what the source used to say 1675 (let ((command-line-args-left
1626 (if argval 1676 (cons argval command-line-args-left)))
1627 (setq tem (intern argval)) 1677 (funcall (cdr tem) argi))
1628 (setq tem (intern (car command-line-args-left))) 1678 (funcall (cdr tem) argi)))
1629 (setq command-line-args-left (cdr command-line-args-left))) 1679
1630 (if (arrayp (symbol-function tem)) 1680 ((equal argi "-no-splash")
1631 (command-execute tem) 1681 (setq inhibit-startup-message t))
1632 (funcall tem))) 1682
1633 1683 ((member argi '("-f" ; what the manual claims
1634 ((member argi '("-eval" "-execute")) 1684 "-funcall"
1635 (if argval 1685 "-e")) ; what the source used to say
1636 (setq tem argval) 1686 (setq tem (intern (or argval (pop command-line-args-left))))
1637 (setq tem (car command-line-args-left)) 1687 (if (commandp tem)
1638 (setq command-line-args-left (cdr command-line-args-left))) 1688 (command-execute tem)
1639 (eval (read tem))) 1689 (funcall tem)))
1640 ;; Set the default directory as specified in -L. 1690
1641 1691 ((member argi '("-eval" "-execute"))
1642 ((member argi '("-L" "-directory")) 1692 (eval (read (or argval (pop command-line-args-left)))))
1643 (if argval 1693
1644 (setq tem argval) 1694 ((member argi '("-L" "-directory"))
1645 (setq tem (car command-line-args-left) 1695 (setq tem (expand-file-name
1646 command-line-args-left (cdr command-line-args-left))) 1696 (command-line-normalize-file-name
1647 (setq tem (command-line-normalize-file-name tem)) 1697 (or argval (pop command-line-args-left)))))
1648 (setq extra-load-path 1698 (cond (splice (setcdr splice (cons tem (cdr splice)))
1649 (cons (expand-file-name tem) extra-load-path)) 1699 (setq splice (cdr splice)))
1650 (setq load-path (append (nreverse extra-load-path) 1700 (t (setq load-path (cons tem load-path)
1651 initial-load-path))) 1701 splice load-path))))
1652 1702
1653 ((member argi '("-l" "-load")) 1703 ((member argi '("-l" "-load"))
1654 (if argval 1704 (let* ((file (command-line-normalize-file-name
1655 (setq tem argval) 1705 (or argval (pop command-line-args-left))))
1656 (setq tem (car command-line-args-left) 1706 ;; Take file from default dir if it exists there;
1657 command-line-args-left (cdr command-line-args-left))) 1707 ;; otherwise let `load' search for it.
1658 (let ((file (command-line-normalize-file-name tem))) 1708 (file-ex (expand-file-name file)))
1659 ;; Take file from default dir if it exists there; 1709 (when (file-exists-p file-ex)
1660 ;; otherwise let `load' search for it. 1710 (setq file file-ex))
1661 (if (file-exists-p (expand-file-name file)) 1711 (load file nil t)))
1662 (setq file (expand-file-name file))) 1712
1663 (load file nil t))) 1713 ;; This is used to handle -script. It's not clear
1664 1714 ;; we need to document it.
1665 ((string-equal argi "-insert") 1715 ((member argi '("-scriptload"))
1666 (if argval 1716 (let* ((file (command-line-normalize-file-name
1667 (setq tem argval) 1717 (or argval (pop command-line-args-left))))
1668 (setq tem (car command-line-args-left) 1718 ;; Take file from default dir.
1669 command-line-args-left (cdr command-line-args-left))) 1719 (file-ex (expand-file-name file)))
1670 (or (stringp tem) 1720 (load file-ex nil t t)))
1671 (error "File name omitted from `-insert' option")) 1721
1672 (insert-file-contents (command-line-normalize-file-name tem))) 1722 ((equal argi "-insert")
1673 1723 (setq tem (or argval (pop command-line-args-left)))
1674 ((string-equal argi "-kill") 1724 (or (stringp tem)
1675 (kill-emacs t)) 1725 (error "File name omitted from `-insert' option"))
1676 1726 (insert-file-contents (command-line-normalize-file-name tem)))
1677 ((string-match "^\\+[0-9]+\\'" argi) 1727
1678 (setq line (string-to-int argi))) 1728 ((equal argi "-kill")
1679 1729 (kill-emacs t))
1680 ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) 1730
1681 (setq line (string-to-int (match-string 1 argi)) 1731 ((string-match "^\\+[0-9]+\\'" argi)
1682 column (string-to-int (match-string 2 argi)))) 1732 (setq line (string-to-number argi)))
1683 1733
1684 ((setq tem (assoc argi command-line-x-option-alist)) 1734 ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
1685 ;; Ignore X-windows options and their args if not using X. 1735 (setq line (string-to-number (match-string 1 argi))
1686 (setq command-line-args-left 1736 column (string-to-number (match-string 2 argi))))
1687 (nthcdr (nth 1 tem) command-line-args-left))) 1737
1688 1738 ((setq tem (assoc argi command-line-x-option-alist))
1689 ((member argi '("-find-file" "-file" "-visit")) 1739 ;; Ignore X-windows options and their args if not using X.
1690 ;; An explicit option to specify visiting a file. 1740 (setq command-line-args-left
1691 (if argval 1741 (nthcdr (nth 1 tem) command-line-args-left)))
1692 (setq tem argval) 1742
1693 (setq tem (car command-line-args-left) 1743 ((member argi '("-find-file" "-file" "-visit"))
1694 command-line-args-left (cdr command-line-args-left))) 1744 ;; An explicit option to specify visiting a file.
1695 (unless (stringp tem) 1745 (setq tem (or argval (pop command-line-args-left)))
1696 (error "File name omitted from `%s' option" argi)) 1746 (unless (stringp tem)
1697 (setq file-count (1+ file-count)) 1747 (error "File name omitted from `%s' option" argi))
1698 (let ((file (expand-file-name 1748 (setq file-count (1+ file-count))
1699 (command-line-normalize-file-name tem) dir))) 1749 (let ((file (expand-file-name
1700 (if (= file-count 1) 1750 (command-line-normalize-file-name tem) dir)))
1701 (setq first-file-buffer (find-file file)) 1751 (if (= file-count 1)
1702 (find-file-other-window file))) 1752 (setq first-file-buffer (find-file file))
1703 (or (zerop line) 1753 (find-file-other-window file)))
1704 (goto-line line)) 1754 (or (zerop line)
1705 (setq line 0) 1755 (goto-line line))
1706 (unless (< column 1) 1756 (setq line 0)
1707 (move-to-column (1- column))) 1757 (unless (< column 1)
1708 (setq column 0)) 1758 (move-to-column (1- column)))
1709 1759 (setq column 0))
1710 ((equal argi "--") 1760
1711 (setq just-files t)) 1761 ((equal argi "--")
1712 (t 1762 (setq just-files t))
1713 ;; We have almost exhausted our options. See if the 1763 (t
1714 ;; user has made any other command-line options available 1764 ;; We have almost exhausted our options. See if the
1715 (let ((hooks command-line-functions) ;; lrs 7/31/89 1765 ;; user has made any other command-line options available
1716 (did-hook nil)) 1766 (let ((hooks command-line-functions) ;; lrs 7/31/89
1717 (while (and hooks 1767 (did-hook nil))
1718 (not (setq did-hook (funcall (car hooks))))) 1768 (while (and hooks
1719 (setq hooks (cdr hooks))) 1769 (not (setq did-hook (funcall (car hooks)))))
1720 (if (not did-hook) 1770 (setq hooks (cdr hooks)))
1721 ;; Ok, presume that the argument is a file name 1771 (if (not did-hook)
1722 (progn 1772 ;; Presume that the argument is a file name.
1723 (if (string-match "\\`-" argi) 1773 (progn
1724 (error "Unknown option `%s'" argi)) 1774 (if (string-match "\\`-" argi)
1725 (setq file-count (1+ file-count)) 1775 (error "Unknown option `%s'" argi))
1726 (let ((file 1776 (setq file-count (1+ file-count))
1727 (expand-file-name 1777 (let ((file
1728 (command-line-normalize-file-name orig-argi) 1778 (expand-file-name
1729 dir))) 1779 (command-line-normalize-file-name orig-argi)
1730 (if (= file-count 1) 1780 dir)))
1731 (setq first-file-buffer (find-file file)) 1781 (if (= file-count 1)
1732 (find-file-other-window file))) 1782 (setq first-file-buffer (find-file file))
1733 (or (zerop line) 1783 (find-file-other-window file)))
1734 (goto-line line)) 1784 (or (zerop line)
1735 (setq line 0) 1785 (goto-line line))
1736 (unless (< column 1) 1786 (setq line 0)
1737 (move-to-column (1- column))) 1787 (unless (< column 1)
1738 (setq column 0)))))))) 1788 (move-to-column (1- column)))
1739 ;; If 3 or more files visited, and not all visible, 1789 (setq column 0))))))))
1740 ;; show user what they all are. But leave the last one current. 1790
1741 (and (> file-count 2) 1791 ;; If 3 or more files visited, and not all visible,
1742 (not noninteractive) 1792 ;; show user what they all are. But leave the last one current.
1743 (not inhibit-startup-buffer-menu) 1793 (and (> file-count 2)
1744 (or (get-buffer-window first-file-buffer) 1794 (not noninteractive)
1745 (list-buffers))))) 1795 (not inhibit-startup-buffer-menu)
1796 (or (get-buffer-window first-file-buffer)
1797 (list-buffers)))))
1746 1798
1747 ;; Maybe display a startup screen. 1799 ;; Maybe display a startup screen.
1748 (when (and (not inhibit-startup-message) (not noninteractive) 1800 (unless (or inhibit-startup-message
1749 ;; Don't display startup screen if init file 1801 noninteractive
1750 ;; has started some sort of server. 1802 emacs-quick-startup)
1751 (not (and (fboundp 'process-list)
1752 (process-list))))
1753 ;; Display a startup screen, after some preparations. 1803 ;; Display a startup screen, after some preparations.
1754 1804
1755 ;; If there are no switches to process, we might as well 1805 ;; If there are no switches to process, we might as well
1756 ;; run this hook now, and there may be some need to do it 1806 ;; run this hook now, and there may be some need to do it
1757 ;; before doing any output. 1807 ;; before doing any output.
1808 (run-hooks 'emacs-startup-hook)
1758 (and term-setup-hook 1809 (and term-setup-hook
1759 (run-hooks 'term-setup-hook)) 1810 (run-hooks 'term-setup-hook))
1760 ;; Don't let the hook be run twice. 1811 (setq inhibit-startup-hooks t)
1761 (setq term-setup-hook nil)
1762 1812
1763 ;; It's important to notice the user settings before we 1813 ;; It's important to notice the user settings before we
1764 ;; display the startup message; otherwise, the settings 1814 ;; display the startup message; otherwise, the settings
1765 ;; won't take effect until the user gives the first 1815 ;; won't take effect until the user gives the first
1766 ;; keystroke, and that's distracting. 1816 ;; keystroke, and that's distracting.
1777 1827
1778 ;; Do this now to avoid an annoying delay if the user 1828 ;; Do this now to avoid an annoying delay if the user
1779 ;; clicks the menu bar during the sit-for. 1829 ;; clicks the menu bar during the sit-for.
1780 (when (display-popup-menus-p) 1830 (when (display-popup-menus-p)
1781 (precompute-menubar-bindings)) 1831 (precompute-menubar-bindings))
1782 (setq menubar-bindings-done t) 1832 (with-no-warnings
1833 (setq menubar-bindings-done t))
1783 1834
1784 ;; If *scratch* is selected and it is empty, insert an 1835 ;; If *scratch* is selected and it is empty, insert an
1785 ;; initial message saying not to create a file there. 1836 ;; initial message saying not to create a file there.
1786 (when (and initial-scratch-message 1837 (when (and initial-scratch-message
1787 (string= (buffer-name) "*scratch*") 1838 (equal (buffer-name) "*scratch*")
1788 (= 0 (buffer-size))) 1839 (= 0 (buffer-size)))
1789 (insert initial-scratch-message) 1840 (insert initial-scratch-message)
1790 (set-buffer-modified-p nil)) 1841 (set-buffer-modified-p nil))
1791 1842
1792 ;; If user typed input during all that work, 1843 ;; If user typed input during all that work,
1805 (setq file (replace-match "/" t t file))) 1856 (setq file (replace-match "/" t t file)))
1806 (while (string-match "//+" file 1) 1857 (while (string-match "//+" file 1)
1807 (setq file (replace-match "/" t t file))) 1858 (setq file (replace-match "/" t t file)))
1808 file)) 1859 file))
1809 1860
1861 ;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db
1810 ;;; startup.el ends here 1862 ;;; startup.el ends here