Mercurial > emacs
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 |