Mercurial > emacs
comparison lisp/startup.el @ 40675:b6dfe21c4299
(fancy-splash-tail): Explain how to recover
from a crash, if there was a crash.
(command-line-1): Reorganize display of startup screen,
to simplify the logic. Use a temp buffer for it.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 03 Nov 2001 16:14:48 +0000 |
parents | 1c821a940597 |
children | 74d51420aa46 |
comparison
equal
deleted
inserted
replaced
40674:b9566416afd6 | 40675:b6dfe21c4299 |
---|---|
1160 (fancy-splash-insert :face `(variable-pitch :foreground ,fg) | 1160 (fancy-splash-insert :face `(variable-pitch :foreground ,fg) |
1161 "\nThis is " | 1161 "\nThis is " |
1162 (emacs-version) | 1162 (emacs-version) |
1163 "\n" | 1163 "\n" |
1164 :face '(variable-pitch :height 0.5) | 1164 :face '(variable-pitch :height 0.5) |
1165 "Copyright (C) 2001 Free Software Foundation, Inc."))) | 1165 "Copyright (C) 2001 Free Software Foundation, Inc.") |
1166 | 1166 (and auto-save-list-file-prefix |
1167 ;; Don't signal an error if the | |
1168 ;; directory for auto-save-list files | |
1169 ;; does not yet exist. | |
1170 (file-directory-p (file-name-directory | |
1171 auto-save-list-file-prefix)) | |
1172 (directory-files | |
1173 (file-name-directory auto-save-list-file-prefix) | |
1174 nil | |
1175 (concat "\\`" | |
1176 (regexp-quote (file-name-nondirectory | |
1177 auto-save-list-file-prefix))) | |
1178 t) | |
1179 (fancy-splash-insert :face '(variable-pitch :foreground "red") | |
1180 "\n\nIf an Emacs session crashed recently, " | |
1181 "type M-x recover-session RET\nto recover" | |
1182 " the files you were editing.")))) | |
1167 | 1183 |
1168 (defun fancy-splash-screens-1 (buffer) | 1184 (defun fancy-splash-screens-1 (buffer) |
1169 "Timer function displaying a splash screen." | 1185 "Timer function displaying a splash screen." |
1170 (when (> (float-time) fancy-splash-stop-time) | 1186 (when (> (float-time) fancy-splash-stop-time) |
1171 (throw 'stop-splashing nil)) | 1187 (throw 'stop-splashing nil)) |
1253 (message (startup-echo-area-message)))) | 1269 (message (startup-echo-area-message)))) |
1254 | 1270 |
1255 | 1271 |
1256 (defun command-line-1 (command-line-args-left) | 1272 (defun command-line-1 (command-line-args-left) |
1257 (or noninteractive (input-pending-p) init-file-had-error | 1273 (or noninteractive (input-pending-p) init-file-had-error |
1258 (and inhibit-startup-echo-area-message | 1274 ;; t if the init file says to inhibit the echo area startup message. |
1259 user-init-file | 1275 (and inhibit-startup-echo-area-message |
1260 (or (and (get 'inhibit-startup-echo-area-message 'saved-value) | 1276 user-init-file |
1261 (equal inhibit-startup-echo-area-message | 1277 (or (and (get 'inhibit-startup-echo-area-message 'saved-value) |
1262 (if (string= init-file-user "") | 1278 (equal inhibit-startup-echo-area-message |
1263 (user-login-name) | 1279 (if (string= init-file-user "") |
1264 init-file-user))) | 1280 (user-login-name) |
1265 ;; Wasn't set with custom; see if .emacs has a setq. | 1281 init-file-user))) |
1266 (let ((buffer (get-buffer-create " *temp*"))) | 1282 ;; Wasn't set with custom; see if .emacs has a setq. |
1267 (prog1 | 1283 (let ((buffer (get-buffer-create " *temp*"))) |
1268 (condition-case nil | 1284 (prog1 |
1269 (save-excursion | 1285 (condition-case nil |
1270 (set-buffer buffer) | 1286 (save-excursion |
1271 (insert-file-contents user-init-file) | 1287 (set-buffer buffer) |
1272 (re-search-forward | 1288 (insert-file-contents user-init-file) |
1273 (concat | 1289 (re-search-forward |
1274 "([ \t\n]*setq[ \t\n]+" | 1290 (concat |
1275 "inhibit-startup-echo-area-message[ \t\n]+" | 1291 "([ \t\n]*setq[ \t\n]+" |
1276 (regexp-quote | 1292 "inhibit-startup-echo-area-message[ \t\n]+" |
1277 (prin1-to-string | 1293 (regexp-quote |
1278 (if (string= init-file-user "") | 1294 (prin1-to-string |
1279 (user-login-name) | 1295 (if (string= init-file-user "") |
1280 init-file-user))) | 1296 (user-login-name) |
1281 "[ \t\n]*)") | 1297 init-file-user))) |
1282 nil t)) | 1298 "[ \t\n]*)") |
1283 (error nil)) | 1299 nil t)) |
1284 (kill-buffer buffer))))) | 1300 (error nil)) |
1285 (display-startup-echo-area-message)) | 1301 (kill-buffer buffer))))) |
1286 (if (null command-line-args-left) | 1302 (display-startup-echo-area-message)) |
1287 (cond ((and (not inhibit-startup-message) (not noninteractive) | 1303 |
1288 ;; Don't clobber a non-scratch buffer if init file | 1304 ;; Delay 2 seconds after an init file error message |
1289 ;; has selected it. | 1305 ;; was displayed, so user can read it. |
1290 (string= (buffer-name) "*scratch*")) | 1306 (if init-file-had-error |
1291 ;; If there are no switches to process, we might as well | 1307 (sit-for 2)) |
1292 ;; run this hook now, and there may be some need to do it | 1308 |
1293 ;; before doing any output. | 1309 (if command-line-args-left |
1294 (and term-setup-hook | 1310 ;; We have command args; process them. |
1295 (run-hooks 'term-setup-hook)) | 1311 (let ((dir command-line-default-directory) |
1296 ;; Don't let the hook be run twice. | 1312 (file-count 0) |
1297 (setq term-setup-hook nil) | 1313 first-file-buffer |
1298 | 1314 tem |
1299 ;; It's important to notice the user settings before we | 1315 just-files ;; t if this follows the magic -- option. |
1300 ;; display the startup message; otherwise, the settings | 1316 ;; This includes our standard options' long versions |
1301 ;; won't take effect until the user gives the first | 1317 ;; and long versions of what's on command-switch-alist. |
1302 ;; keystroke, and that's distracting. | 1318 (longopts |
1303 (when (fboundp 'frame-notice-user-settings) | 1319 (append '(("--funcall") ("--load") ("--insert") ("--kill") |
1304 (frame-notice-user-settings)) | 1320 ("--directory") ("--eval") ("--execute") |
1305 | 1321 ("--find-file") ("--visit") ("--file")) |
1306 (when window-setup-hook | 1322 (mapcar (lambda (elt) |
1307 (run-hooks 'window-setup-hook) | 1323 (list (concat "-" (car elt)))) |
1308 (setq window-setup-hook nil)) | 1324 command-switch-alist))) |
1309 | 1325 (line 0) |
1310 (when (display-popup-menus-p) | 1326 (column 0)) |
1311 (precompute-menubar-bindings)) | 1327 |
1312 (setq menubar-bindings-done t) | 1328 ;; Add the long X options to longopts. |
1313 | 1329 (setq tem command-line-x-option-alist) |
1314 ;; Do this now to avoid an annoying delay if the user | 1330 (while tem |
1315 ;; clicks the menu bar during the sit-for. | 1331 (if (string-match "^--" (car (car tem))) |
1316 (when (= (buffer-size) 0) | 1332 (setq longopts (cons (list (car (car tem))) longopts))) |
1317 (let ((buffer-undo-list t) | 1333 (setq tem (cdr tem))) |
1318 (tab-width 8) | 1334 |
1319 (wait-for-input t)) | 1335 ;; Loop, processing options. |
1320 (unwind-protect | 1336 (while (and command-line-args-left) |
1321 (when (not (input-pending-p)) | 1337 (let* ((argi (car command-line-args-left)) |
1322 (goto-char (point-max)) | 1338 (orig-argi argi) |
1323 ;; The convention for this piece of code is that | 1339 argval completion |
1324 ;; each piece of output starts with one or two newlines | 1340 ;; List of directories specified in -L/--directory, |
1325 ;; and does not end with any newlines. | 1341 ;; in reverse of the order specified. |
1326 (insert "Welcome to GNU Emacs") | 1342 extra-load-path |
1327 (if (eq system-type 'gnu/linux) | 1343 (initial-load-path load-path)) |
1328 (insert ", one component of a Linux-based GNU system.")) | 1344 (setq command-line-args-left (cdr command-line-args-left)) |
1329 (insert "\n") | 1345 |
1330 | 1346 ;; Do preliminary decoding of the option. |
1331 (if (assq 'display (frame-parameters)) | 1347 (if just-files |
1332 | 1348 ;; After --, don't look for options; treat all args as files. |
1333 (if (use-fancy-splash-screens-p) | 1349 (setq argi "") |
1334 (progn | 1350 ;; Convert long options to ordinary options |
1335 (setq wait-for-input nil) | 1351 ;; and separate out an attached option argument into argval. |
1336 (fancy-splash-screens)) | 1352 (if (string-match "^--[^=]*=" argi) |
1337 (progn | 1353 (setq argval (substring argi (match-end 0)) |
1338 (insert "\ | 1354 argi (substring argi 0 (1- (match-end 0))))) |
1355 (if (equal argi "--") | |
1356 (setq completion nil) | |
1357 (setq completion (try-completion argi longopts))) | |
1358 (if (eq completion t) | |
1359 (setq argi (substring argi 1)) | |
1360 (if (stringp completion) | |
1361 (let ((elt (assoc completion longopts))) | |
1362 (or elt | |
1363 (error "Option `%s' is ambiguous" argi)) | |
1364 (setq argi (substring (car elt) 1))) | |
1365 (setq argval nil argi orig-argi)))) | |
1366 | |
1367 ;; Execute the option. | |
1368 (cond ((setq tem (assoc argi command-switch-alist)) | |
1369 (if argval | |
1370 (let ((command-line-args-left | |
1371 (cons argval command-line-args-left))) | |
1372 (funcall (cdr tem) argi)) | |
1373 (funcall (cdr tem) argi))) | |
1374 | |
1375 ((or (string-equal argi "-f") ;what the manual claims | |
1376 (string-equal argi "-funcall") | |
1377 (string-equal argi "-e")) ; what the source used to say | |
1378 (if argval | |
1379 (setq tem (intern argval)) | |
1380 (setq tem (intern (car command-line-args-left))) | |
1381 (setq command-line-args-left (cdr command-line-args-left))) | |
1382 (if (arrayp (symbol-function tem)) | |
1383 (command-execute tem) | |
1384 (funcall tem))) | |
1385 | |
1386 ((or (string-equal argi "-eval") | |
1387 (string-equal argi "-execute")) | |
1388 (if argval | |
1389 (setq tem argval) | |
1390 (setq tem (car command-line-args-left)) | |
1391 (setq command-line-args-left (cdr command-line-args-left))) | |
1392 (eval (read tem))) | |
1393 ;; Set the default directory as specified in -L. | |
1394 | |
1395 ((or (string-equal argi "-L") | |
1396 (string-equal argi "-directory")) | |
1397 (if argval | |
1398 (setq tem argval) | |
1399 (setq tem (car command-line-args-left) | |
1400 command-line-args-left (cdr command-line-args-left))) | |
1401 (setq tem (command-line-normalize-file-name tem)) | |
1402 (setq extra-load-path | |
1403 (cons (expand-file-name tem) extra-load-path)) | |
1404 (setq load-path (append (nreverse extra-load-path) | |
1405 initial-load-path))) | |
1406 | |
1407 ((or (string-equal argi "-l") | |
1408 (string-equal argi "-load")) | |
1409 (if argval | |
1410 (setq tem argval) | |
1411 (setq tem (car command-line-args-left) | |
1412 command-line-args-left (cdr command-line-args-left))) | |
1413 (let ((file (command-line-normalize-file-name tem))) | |
1414 ;; Take file from default dir if it exists there; | |
1415 ;; otherwise let `load' search for it. | |
1416 (if (file-exists-p (expand-file-name file)) | |
1417 (setq file (expand-file-name file))) | |
1418 (load file nil t))) | |
1419 | |
1420 ((string-equal argi "-insert") | |
1421 (if argval | |
1422 (setq tem argval) | |
1423 (setq tem (car command-line-args-left) | |
1424 command-line-args-left (cdr command-line-args-left))) | |
1425 (or (stringp tem) | |
1426 (error "File name omitted from `-insert' option")) | |
1427 (insert-file-contents (command-line-normalize-file-name tem))) | |
1428 | |
1429 ((string-equal argi "-kill") | |
1430 (kill-emacs t)) | |
1431 | |
1432 ((string-match "^\\+[0-9]+\\'" argi) | |
1433 (setq line (string-to-int argi))) | |
1434 | |
1435 ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) | |
1436 (setq line (string-to-int (match-string 1 argi)) | |
1437 column (string-to-int (match-string 2 argi)))) | |
1438 | |
1439 ((setq tem (assoc argi command-line-x-option-alist)) | |
1440 ;; Ignore X-windows options and their args if not using X. | |
1441 (setq command-line-args-left | |
1442 (nthcdr (nth 1 tem) command-line-args-left))) | |
1443 | |
1444 ((or (string-equal argi "-find-file") | |
1445 (string-equal argi "-file") | |
1446 (string-equal argi "-visit")) | |
1447 ;; An explicit option to specify visiting a file. | |
1448 (if argval | |
1449 (setq tem argval) | |
1450 (setq tem (car command-line-args-left) | |
1451 command-line-args-left (cdr command-line-args-left))) | |
1452 (unless (stringp tem) | |
1453 (error "File name omitted from `%s' option" argi)) | |
1454 (setq file-count (1+ file-count)) | |
1455 (let ((file (expand-file-name | |
1456 (command-line-normalize-file-name tem) dir))) | |
1457 (if (= file-count 1) | |
1458 (setq first-file-buffer (find-file file)) | |
1459 (find-file-other-window file))) | |
1460 (or (zerop line) | |
1461 (goto-line line)) | |
1462 (setq line 0) | |
1463 (unless (< column 1) | |
1464 (move-to-column (1- column))) | |
1465 (setq column 0)) | |
1466 | |
1467 ((equal argi "--") | |
1468 (setq just-files t)) | |
1469 (t | |
1470 ;; We have almost exhausted our options. See if the | |
1471 ;; user has made any other command-line options available | |
1472 (let ((hooks command-line-functions) ;; lrs 7/31/89 | |
1473 (did-hook nil)) | |
1474 (while (and hooks | |
1475 (not (setq did-hook (funcall (car hooks))))) | |
1476 (setq hooks (cdr hooks))) | |
1477 (if (not did-hook) | |
1478 ;; Ok, presume that the argument is a file name | |
1479 (progn | |
1480 (if (string-match "\\`-" argi) | |
1481 (error "Unknown option `%s'" argi)) | |
1482 (setq file-count (1+ file-count)) | |
1483 (let ((file | |
1484 (expand-file-name | |
1485 (command-line-normalize-file-name orig-argi) | |
1486 dir))) | |
1487 (if (= file-count 1) | |
1488 (setq first-file-buffer (find-file file)) | |
1489 (find-file-other-window file))) | |
1490 (or (zerop line) | |
1491 (goto-line line)) | |
1492 (setq line 0) | |
1493 (unless (< column 1) | |
1494 (move-to-column (1- column))) | |
1495 (setq column 0)))))))) | |
1496 ;; If 3 or more files visited, and not all visible, | |
1497 ;; show user what they all are. But leave the last one current. | |
1498 (and (> file-count 2) | |
1499 (not noninteractive) | |
1500 (not inhibit-startup-buffer-menu) | |
1501 (or (get-buffer-window first-file-buffer) | |
1502 (list-buffers)))) | |
1503 | |
1504 ;; No command args: maybe display a startup screen. | |
1505 (when (and (not inhibit-startup-message) (not noninteractive) | |
1506 ;; Don't display startup screen if init file | |
1507 ;; has selected another buffer. | |
1508 (string= (buffer-name) "*scratch*") | |
1509 ;; Don't display startup screen if init file | |
1510 ;; has inserted some text in *scratch*. | |
1511 (= 0 (buffer-size))) | |
1512 ;; Display a startup screen, after some preparations. | |
1513 | |
1514 ;; If there are no switches to process, we might as well | |
1515 ;; run this hook now, and there may be some need to do it | |
1516 ;; before doing any output. | |
1517 (and term-setup-hook | |
1518 (run-hooks 'term-setup-hook)) | |
1519 ;; Don't let the hook be run twice. | |
1520 (setq term-setup-hook nil) | |
1521 | |
1522 ;; It's important to notice the user settings before we | |
1523 ;; display the startup message; otherwise, the settings | |
1524 ;; won't take effect until the user gives the first | |
1525 ;; keystroke, and that's distracting. | |
1526 (when (fboundp 'frame-notice-user-settings) | |
1527 (frame-notice-user-settings)) | |
1528 | |
1529 ;; If there are no switches to process, we might as well | |
1530 ;; run this hook now, and there may be some need to do it | |
1531 ;; before doing any output. | |
1532 (when window-setup-hook | |
1533 (run-hooks 'window-setup-hook) | |
1534 ;; Don't let the hook be run twice. | |
1535 (setq window-setup-hook nil)) | |
1536 | |
1537 ;; Do this now to avoid an annoying delay if the user | |
1538 ;; clicks the menu bar during the sit-for. | |
1539 (when (display-popup-menus-p) | |
1540 (precompute-menubar-bindings)) | |
1541 (setq menubar-bindings-done t) | |
1542 | |
1543 (when initial-scratch-message | |
1544 (insert initial-scratch-message)) | |
1545 (set-buffer-modified-p nil) | |
1546 | |
1547 ;; If user typed input during all that work, | |
1548 ;; abort the startup screen. Otherwise, display it now. | |
1549 (when (not (input-pending-p)) | |
1550 (with-temp-buffer | |
1551 (if (and (display-graphic-p) | |
1552 (use-fancy-splash-screens-p)) | |
1553 (fancy-splash-screens) | |
1554 (let ((tab-width 8)) | |
1555 ;; The convention for this piece of code is that | |
1556 ;; each piece of output starts with one or two newlines | |
1557 ;; and does not end with any newlines. | |
1558 (insert "Welcome to GNU Emacs") | |
1559 (if (eq system-type 'gnu/linux) | |
1560 (insert ", one component of a Linux-based GNU system.")) | |
1561 (insert "\n") | |
1562 | |
1563 (if (display-mouse-p) | |
1564 ;; The user can use the mouse to activate menus | |
1565 ;; so give help in terms of menu items. | |
1566 (progn | |
1567 (insert "\ | |
1339 You can do basic editing with the menu bar and scroll bar using the mouse. | 1568 You can do basic editing with the menu bar and scroll bar using the mouse. |
1340 | 1569 |
1341 Useful File menu items: | 1570 Useful File menu items: |
1342 Exit Emacs (or type Control-x followed by Control-c) | 1571 Exit Emacs (or type Control-x followed by Control-c) |
1343 Recover Session recover files you were editing before a crash | 1572 Recover Session recover files you were editing before a crash |
1348 \(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY | 1577 \(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY |
1349 Copying Conditions Conditions for redistributing and changing Emacs. | 1578 Copying Conditions Conditions for redistributing and changing Emacs. |
1350 Getting New Versions How to obtain the latest version of Emacs. | 1579 Getting New Versions How to obtain the latest version of Emacs. |
1351 Ordering Manuals How to order manuals from the FSF. | 1580 Ordering Manuals How to order manuals from the FSF. |
1352 ") | 1581 ") |
1353 (insert "\n\n" (emacs-version) | 1582 (insert "\n\n" (emacs-version) |
1354 " | 1583 " |
1355 Copyright (C) 2001 Free Software Foundation, Inc."))) | 1584 Copyright (C) 2001 Free Software Foundation, Inc.")) |
1356 | 1585 |
1357 ;; If keys have their default meanings, | 1586 ;; No mouse menus, so give help using kbd commands. |
1358 ;; use precomputed string to save lots of time. | 1587 |
1359 (if (and (eq (key-binding "\C-h") 'help-command) | 1588 ;; If keys have their default meanings, |
1360 (eq (key-binding "\C-xu") 'advertised-undo) | 1589 ;; use precomputed string to save lots of time. |
1361 (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs) | 1590 (if (and (eq (key-binding "\C-h") 'help-command) |
1362 (eq (key-binding "\C-ht") 'help-with-tutorial) | 1591 (eq (key-binding "\C-xu") 'advertised-undo) |
1363 (eq (key-binding "\C-hi") 'info) | 1592 (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs) |
1364 (eq (key-binding "\C-h\C-n") 'view-emacs-news)) | 1593 (eq (key-binding "\C-ht") 'help-with-tutorial) |
1365 (insert " | 1594 (eq (key-binding "\C-hi") 'info) |
1595 (eq (key-binding "\C-h\C-n") 'view-emacs-news)) | |
1596 (insert " | |
1366 Get help C-h (Hold down CTRL and press h) | 1597 Get help C-h (Hold down CTRL and press h) |
1367 Undo changes C-x u Exit Emacs C-x C-c | 1598 Undo changes C-x u Exit Emacs C-x C-c |
1368 Get a tutorial C-h t Use Info to read docs C-h i | 1599 Get a tutorial C-h t Use Info to read docs C-h i |
1369 Ordering manuals C-h RET") | 1600 Ordering manuals C-h RET") |
1370 (insert (substitute-command-keys | 1601 (insert (substitute-command-keys |
1371 (format "\n | 1602 (format "\n |
1372 Get help %s | 1603 Get help %s |
1373 Undo changes \\[advertised-undo] | 1604 Undo changes \\[advertised-undo] |
1374 Exit Emacs \\[save-buffers-kill-emacs] | 1605 Exit Emacs \\[save-buffers-kill-emacs] |
1375 Get a tutorial \\[help-with-tutorial] | 1606 Get a tutorial \\[help-with-tutorial] |
1376 Use Info to read docs \\[info] | 1607 Use Info to read docs \\[info] |
1377 Ordering manuals \\[view-order-manuals]" | 1608 Ordering manuals \\[view-order-manuals]" |
1378 (let ((where (where-is-internal | 1609 (let ((where (where-is-internal |
1379 'help-command nil t))) | 1610 'help-command nil t))) |
1380 (if where | 1611 (if where |
1381 (key-description where) | 1612 (key-description where) |
1382 "M-x help")))))) | 1613 "M-x help")))))) |
1383 ;; Say how to use the menu bar | 1614 |
1384 ;; if that is not with the mouse. | 1615 ;; Say how to use the menu bar with the keyboard. |
1385 (if (and (eq (key-binding "\M-`") 'tmm-menubar) | 1616 (if (and (eq (key-binding "\M-`") 'tmm-menubar) |
1386 (eq (key-binding [f10]) 'tmm-menubar)) | 1617 (eq (key-binding [f10]) 'tmm-menubar)) |
1387 (insert " | 1618 (insert " |
1388 Activate menubar F10 or ESC ` or M-`") | 1619 Activate menubar F10 or ESC ` or M-`") |
1389 (insert (substitute-command-keys " | 1620 (insert (substitute-command-keys " |
1390 Activate menubar \\[tmm-menubar]"))) | 1621 Activate menubar \\[tmm-menubar]"))) |
1391 | 1622 |
1392 (if (display-mouse-p) | 1623 ;; Many users seem to have problems with these. |
1393 (insert " | 1624 (insert " |
1394 Mode-specific menu C-mouse-3 (third button, with CTRL)")) | |
1395 ;; Many users seem to have problems with these. | |
1396 (insert " | |
1397 \(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. | 1625 \(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. |
1398 If you have no Meta key, you may instead type ESC followed by the character.)") | 1626 If you have no Meta key, you may instead type ESC followed by the character.)") |
1399 (and auto-save-list-file-prefix | 1627 |
1400 ;; Don't signal an error if the | 1628 (insert "\n\n" (emacs-version) |
1401 ;; directory for auto-save-list files | 1629 " |
1402 ;; does not yet exist. | |
1403 (file-directory-p (file-name-directory | |
1404 auto-save-list-file-prefix)) | |
1405 (directory-files | |
1406 (file-name-directory auto-save-list-file-prefix) | |
1407 nil | |
1408 (concat "\\`" | |
1409 (regexp-quote (file-name-nondirectory | |
1410 auto-save-list-file-prefix))) | |
1411 t) | |
1412 (insert "\n\nIf an Emacs session crashed recently, " | |
1413 "type M-x recover-session RET\nto recover" | |
1414 " the files you were editing.")) | |
1415 | |
1416 (insert "\n\n" (emacs-version) | |
1417 " | |
1418 Copyright (C) 2001 Free Software Foundation, Inc.") | 1630 Copyright (C) 2001 Free Software Foundation, Inc.") |
1419 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) | 1631 |
1420 (eq (key-binding "\C-h\C-d") 'describe-distribution) | 1632 (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) |
1421 (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) | 1633 (eq (key-binding "\C-h\C-d") 'describe-distribution) |
1422 (insert | 1634 (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) |
1423 "\n | 1635 (insert |
1636 "\n | |
1424 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details. | 1637 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details. |
1425 Emacs is Free Software--Free as in Freedom--so you can redistribute copies | 1638 Emacs is Free Software--Free as in Freedom--so you can redistribute copies |
1426 of Emacs and modify it; type C-h C-c to see the conditions. | 1639 of Emacs and modify it; type C-h C-c to see the conditions. |
1427 Type C-h C-d for information on getting the latest version.") | 1640 Type C-h C-d for information on getting the latest version.") |
1428 (insert (substitute-command-keys | 1641 (insert (substitute-command-keys |
1429 "\n | 1642 "\n |
1430 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details. | 1643 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details. |
1431 Emacs is Free Software--Free as in Freedom--so you can redistribute copies | 1644 Emacs is Free Software--Free as in Freedom--so you can redistribute copies |
1432 of Emacs and modify it; type \\[describe-copying] to see the conditions. | 1645 of Emacs and modify it; type \\[describe-copying] to see the conditions. |
1433 Type \\[describe-distribution] for information on getting the latest version.")))) | 1646 Type \\[describe-distribution] for information on getting the latest version.")))) |
1434 (goto-char (point-min)) | 1647 |
1435 | 1648 ;; The rest of the startup screen is the same on all |
1436 (set-buffer-modified-p nil) | 1649 ;; kinds of terminals. |
1437 (when wait-for-input | 1650 |
1438 (sit-for 120))) | 1651 ;; Give information on recovering, if there was a crash. |
1439 | 1652 (and auto-save-list-file-prefix |
1440 (with-current-buffer (get-buffer "*scratch*") | 1653 ;; Don't signal an error if the |
1441 (erase-buffer) | 1654 ;; directory for auto-save-list files |
1442 (when initial-scratch-message | 1655 ;; does not yet exist. |
1443 (insert initial-scratch-message)) | 1656 (file-directory-p (file-name-directory |
1444 (set-buffer-modified-p nil))))))) | 1657 auto-save-list-file-prefix)) |
1445 | 1658 (directory-files |
1446 ;; Delay 2 seconds after the init file error message | 1659 (file-name-directory auto-save-list-file-prefix) |
1447 ;; was displayed, so user can read it. | 1660 nil |
1448 (if init-file-had-error | 1661 (concat "\\`" |
1449 (sit-for 2)) | 1662 (regexp-quote (file-name-nondirectory |
1450 (let ((dir command-line-default-directory) | 1663 auto-save-list-file-prefix))) |
1451 (file-count 0) | 1664 t) |
1452 first-file-buffer | 1665 (insert "\n\nIf an Emacs session crashed recently, " |
1453 tem | 1666 "type M-x recover-session RET\nto recover" |
1454 just-files;; t if this follows the magic -- option. | 1667 " the files you were editing.")) |
1455 ;; This includes our standard options' long versions | 1668 |
1456 ;; and long versions of what's on command-switch-alist. | 1669 ;; Display the input that we set up in the buffer. |
1457 (longopts | 1670 (set-buffer-modified-p nil) |
1458 (append '(("--funcall") ("--load") ("--insert") ("--kill") | 1671 (goto-char (point-min)) |
1459 ("--directory") ("--eval") ("--execute") | 1672 (save-window-excursion |
1460 ("--find-file") ("--visit") ("--file")) | 1673 (switch-to-buffer (current-buffer)) |
1461 (mapcar (lambda (elt) | 1674 (sit-for 120))))))))) |
1462 (list (concat "-" (car elt)))) | |
1463 command-switch-alist))) | |
1464 (line 0) | |
1465 (column 0)) | |
1466 | |
1467 ;; Add the long X options to longopts. | |
1468 (setq tem command-line-x-option-alist) | |
1469 (while tem | |
1470 (if (string-match "^--" (car (car tem))) | |
1471 (setq longopts (cons (list (car (car tem))) longopts))) | |
1472 (setq tem (cdr tem))) | |
1473 | |
1474 ;; Loop, processing options. | |
1475 (while (and command-line-args-left) | |
1476 (let* ((argi (car command-line-args-left)) | |
1477 (orig-argi argi) | |
1478 argval completion | |
1479 ;; List of directories specified in -L/--directory, | |
1480 ;; in reverse of the order specified. | |
1481 extra-load-path | |
1482 (initial-load-path load-path)) | |
1483 (setq command-line-args-left (cdr command-line-args-left)) | |
1484 | |
1485 ;; Do preliminary decoding of the option. | |
1486 (if just-files | |
1487 ;; After --, don't look for options; treat all args as files. | |
1488 (setq argi "") | |
1489 ;; Convert long options to ordinary options | |
1490 ;; and separate out an attached option argument into argval. | |
1491 (if (string-match "^--[^=]*=" argi) | |
1492 (setq argval (substring argi (match-end 0)) | |
1493 argi (substring argi 0 (1- (match-end 0))))) | |
1494 (if (equal argi "--") | |
1495 (setq completion nil) | |
1496 (setq completion (try-completion argi longopts))) | |
1497 (if (eq completion t) | |
1498 (setq argi (substring argi 1)) | |
1499 (if (stringp completion) | |
1500 (let ((elt (assoc completion longopts))) | |
1501 (or elt | |
1502 (error "Option `%s' is ambiguous" argi)) | |
1503 (setq argi (substring (car elt) 1))) | |
1504 (setq argval nil argi orig-argi)))) | |
1505 | |
1506 ;; Execute the option. | |
1507 (cond ((setq tem (assoc argi command-switch-alist)) | |
1508 (if argval | |
1509 (let ((command-line-args-left | |
1510 (cons argval command-line-args-left))) | |
1511 (funcall (cdr tem) argi)) | |
1512 (funcall (cdr tem) argi))) | |
1513 | |
1514 ((or (string-equal argi "-f") ;what the manual claims | |
1515 (string-equal argi "-funcall") | |
1516 (string-equal argi "-e")) ; what the source used to say | |
1517 (if argval | |
1518 (setq tem (intern argval)) | |
1519 (setq tem (intern (car command-line-args-left))) | |
1520 (setq command-line-args-left (cdr command-line-args-left))) | |
1521 (if (arrayp (symbol-function tem)) | |
1522 (command-execute tem) | |
1523 (funcall tem))) | |
1524 | |
1525 ((or (string-equal argi "-eval") | |
1526 (string-equal argi "-execute")) | |
1527 (if argval | |
1528 (setq tem argval) | |
1529 (setq tem (car command-line-args-left)) | |
1530 (setq command-line-args-left (cdr command-line-args-left))) | |
1531 (eval (read tem))) | |
1532 ;; Set the default directory as specified in -L. | |
1533 | |
1534 ((or (string-equal argi "-L") | |
1535 (string-equal argi "-directory")) | |
1536 (if argval | |
1537 (setq tem argval) | |
1538 (setq tem (car command-line-args-left) | |
1539 command-line-args-left (cdr command-line-args-left))) | |
1540 (setq tem (command-line-normalize-file-name tem)) | |
1541 (setq extra-load-path | |
1542 (cons (expand-file-name tem) extra-load-path)) | |
1543 (setq load-path (append (nreverse extra-load-path) | |
1544 initial-load-path))) | |
1545 | |
1546 ((or (string-equal argi "-l") | |
1547 (string-equal argi "-load")) | |
1548 (if argval | |
1549 (setq tem argval) | |
1550 (setq tem (car command-line-args-left) | |
1551 command-line-args-left (cdr command-line-args-left))) | |
1552 (let ((file (command-line-normalize-file-name tem))) | |
1553 ;; Take file from default dir if it exists there; | |
1554 ;; otherwise let `load' search for it. | |
1555 (if (file-exists-p (expand-file-name file)) | |
1556 (setq file (expand-file-name file))) | |
1557 (load file nil t))) | |
1558 | |
1559 ((string-equal argi "-insert") | |
1560 (if argval | |
1561 (setq tem argval) | |
1562 (setq tem (car command-line-args-left) | |
1563 command-line-args-left (cdr command-line-args-left))) | |
1564 (or (stringp tem) | |
1565 (error "File name omitted from `-insert' option")) | |
1566 (insert-file-contents (command-line-normalize-file-name tem))) | |
1567 | |
1568 ((string-equal argi "-kill") | |
1569 (kill-emacs t)) | |
1570 | |
1571 ((string-match "^\\+[0-9]+\\'" argi) | |
1572 (setq line (string-to-int argi))) | |
1573 | |
1574 ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) | |
1575 (setq line (string-to-int (match-string 1 argi)) | |
1576 column (string-to-int (match-string 2 argi)))) | |
1577 | |
1578 ((setq tem (assoc argi command-line-x-option-alist)) | |
1579 ;; Ignore X-windows options and their args if not using X. | |
1580 (setq command-line-args-left | |
1581 (nthcdr (nth 1 tem) command-line-args-left))) | |
1582 | |
1583 ((or (string-equal argi "-find-file") | |
1584 (string-equal argi "-file") | |
1585 (string-equal argi "-visit")) | |
1586 ;; An explicit option to specify visiting a file. | |
1587 (if argval | |
1588 (setq tem argval) | |
1589 (setq tem (car command-line-args-left) | |
1590 command-line-args-left (cdr command-line-args-left))) | |
1591 (unless (stringp tem) | |
1592 (error "File name omitted from `%s' option" argi)) | |
1593 (setq file-count (1+ file-count)) | |
1594 (let ((file (expand-file-name | |
1595 (command-line-normalize-file-name tem) dir))) | |
1596 (if (= file-count 1) | |
1597 (setq first-file-buffer (find-file file)) | |
1598 (find-file-other-window file))) | |
1599 (or (zerop line) | |
1600 (goto-line line)) | |
1601 (setq line 0) | |
1602 (unless (< column 1) | |
1603 (move-to-column (1- column))) | |
1604 (setq column 0)) | |
1605 | |
1606 ((equal argi "--") | |
1607 (setq just-files t)) | |
1608 (t | |
1609 ;; We have almost exhausted our options. See if the | |
1610 ;; user has made any other command-line options available | |
1611 (let ((hooks command-line-functions);; lrs 7/31/89 | |
1612 (did-hook nil)) | |
1613 (while (and hooks | |
1614 (not (setq did-hook (funcall (car hooks))))) | |
1615 (setq hooks (cdr hooks))) | |
1616 (if (not did-hook) | |
1617 ;; Ok, presume that the argument is a file name | |
1618 (progn | |
1619 (if (string-match "\\`-" argi) | |
1620 (error "Unknown option `%s'" argi)) | |
1621 (setq file-count (1+ file-count)) | |
1622 (let ((file | |
1623 (expand-file-name | |
1624 (command-line-normalize-file-name orig-argi) | |
1625 dir))) | |
1626 (if (= file-count 1) | |
1627 (setq first-file-buffer (find-file file)) | |
1628 (find-file-other-window file))) | |
1629 (or (zerop line) | |
1630 (goto-line line)) | |
1631 (setq line 0) | |
1632 (unless (< column 1) | |
1633 (move-to-column (1- column))) | |
1634 (setq column 0)))))))) | |
1635 ;; If 3 or more files visited, and not all visible, | |
1636 ;; show user what they all are. But leave the last one current. | |
1637 (and (> file-count 2) | |
1638 (not noninteractive) | |
1639 (not inhibit-startup-buffer-menu) | |
1640 (or (get-buffer-window first-file-buffer) | |
1641 (list-buffers)))))) | |
1642 | 1675 |
1643 | 1676 |
1644 (defun command-line-normalize-file-name (file) | 1677 (defun command-line-normalize-file-name (file) |
1645 "Collapse multiple slashes to one, to handle non-Emacs file names." | 1678 "Collapse multiple slashes to one, to handle non-Emacs file names." |
1646 (save-match-data | 1679 (save-match-data |