Mercurial > emacs

comparison lisp/startup.el @ 83541:694bbb62a75d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged from emacs@sv.gnu.org Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-371 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-372 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-373 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-374 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-375 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-376 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-377 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-378 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-379 Merge from erc--emacs--21 * emacs@sv.gnu.org/emacs--devo--0--patch-380 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-381 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-382 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-383 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-384 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-385 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-386 Update from erc--emacs--22 * emacs@sv.gnu.org/emacs--devo--0--patch-387 Fix ERC bug introduced in last patch * emacs@sv.gnu.org/emacs--devo--0--patch-388 Update from erc--emacs--22 * emacs@sv.gnu.org/emacs--devo--0--patch-389 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-390 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-391 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-392 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-393 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-394 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-395 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-396 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-397 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-398 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-399 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-400 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-401 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-402 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-403 Rcirc update from Ryan Yeske * emacs@sv.gnu.org/emacs--devo--0--patch-404 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-405 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-406 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-407 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-408 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-409 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-410 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-411 Miscellaneous tq-related fixes. * emacs@sv.gnu.org/emacs--devo--0--patch-412 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-121 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-122 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-123 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-124 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-125 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-126 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-127 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-581
author Karoly Lorentey <lorentey@elte.hu>
date Sat, 14 Oct 2006 16:56:21 +0000
parents 02e39decdc84 6cc945ca398a
children 2d56e13fd23d
comparison
equal deleted inserted replaced
83540:0c89a85addc3 83541:694bbb62a75d
1247 :face '(variable-pitch :foreground "red") 1247 :face '(variable-pitch :foreground "red")
1248 (if (eq system-type 'gnu/linux) 1248 (if (eq system-type 'gnu/linux)
1249 "GNU Emacs is one component of the GNU/Linux operating system." 1249 "GNU Emacs is one component of the GNU/Linux operating system."
1250 "GNU Emacs is one component of the GNU operating system.")) 1250 "GNU Emacs is one component of the GNU operating system."))
1251 (insert "\n") 1251 (insert "\n")
1252 (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*") 1252 (if fancy-splash-outer-buffer
1253 (fancy-splash-insert :face 'variable-pitch 1253 (fancy-splash-insert
1254 (substitute-command-keys 1254 :face 'variable-pitch
1255 "Type \\[recenter] to begin editing your file.\n")))) 1255 (substitute-command-keys
1256 1256 (concat
1257 "Type \\[recenter] to begin editing"
1258 (if (equal (buffer-name fancy-splash-outer-buffer)
1259 "*scratch*")
1260 ".\n"
1261 " your file.\n"))))))
1257 1262
1258 (defun fancy-splash-tail () 1263 (defun fancy-splash-tail ()
1259 "Insert the tail part of the splash screen into the current buffer." 1264 "Insert the tail part of the splash screen into the current buffer."
1260 (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark) 1265 (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
1261 "cyan" "darkblue"))) 1266 "cyan" "darkblue")))
1331 ;; We can not throw from `delete-frame-events', so we set up a timer 1336 ;; We can not throw from `delete-frame-events', so we set up a timer
1332 ;; to exit the recursive edit as soon as Emacs is idle again. 1337 ;; to exit the recursive edit as soon as Emacs is idle again.
1333 (if (frame-live-p frame) 1338 (if (frame-live-p frame)
1334 (run-at-time 0 nil 'fancy-splash-exit))) 1339 (run-at-time 0 nil 'fancy-splash-exit)))
1335 1340
1336 (defun fancy-splash-screens () 1341 (defun fancy-splash-screens (&optional hide-on-input)
1337 "Display fancy splash screens when Emacs starts." 1342 "Display fancy splash screens when Emacs starts."
1338 (setq fancy-splash-help-echo (startup-echo-area-message)) 1343 (setq fancy-splash-help-echo (startup-echo-area-message))
1339 (let ((old-hourglass display-hourglass) 1344 (if hide-on-input
1340 (fancy-splash-outer-buffer (current-buffer)) 1345 (let ((old-hourglass display-hourglass)
1341 splash-buffer 1346 (fancy-splash-outer-buffer (current-buffer))
1342 (old-minor-mode-map-alist minor-mode-map-alist) 1347 splash-buffer
1343 (old-emulation-mode-map-alists emulation-mode-map-alists) 1348 (old-minor-mode-map-alist minor-mode-map-alist)
1344 (frame (fancy-splash-frame)) 1349 (old-emulation-mode-map-alists emulation-mode-map-alists)
1345 timer) 1350 (frame (fancy-splash-frame))
1346 (save-selected-window 1351 timer)
1347 (select-frame frame) 1352 (save-selected-window
1348 (switch-to-buffer "GNU Emacs") 1353 (select-frame frame)
1349 (setq tab-width 20) 1354 (switch-to-buffer "GNU Emacs")
1350 (setq splash-buffer (current-buffer)) 1355 (setq tab-width 20)
1351 (catch 'stop-splashing 1356 (setq splash-buffer (current-buffer))
1352 (unwind-protect 1357 (catch 'stop-splashing
1353 (let* ((map (make-sparse-keymap)) 1358 (unwind-protect
1354 (overriding-local-map map) 1359 (let* ((map (make-sparse-keymap))
1355 ;; Catch if our frame is deleted; the delete-frame 1360 (overriding-local-map map)
1356 ;; event is unreliable and is handled by 1361 ;; Catch if our frame is deleted; the delete-frame
1357 ;; `special-event-map' anyway. 1362 ;; event is unreliable and is handled by
1358 (delete-frame-functions (cons 'fancy-splash-delete-frame 1363 ;; `special-event-map' anyway.
1359 delete-frame-functions))) 1364 (delete-frame-functions (cons 'fancy-splash-delete-frame
1360 (define-key map [t] 'fancy-splash-default-action) 1365 delete-frame-functions)))
1361 (define-key map [mouse-movement] 'ignore) 1366 (define-key map [t] 'fancy-splash-default-action)
1362 (define-key map [mode-line t] 'ignore) 1367 (define-key map [mouse-movement] 'ignore)
1363 (define-key map [select-window] 'ignore) 1368 (define-key map [mode-line t] 'ignore)
1364 (setq cursor-type nil 1369 (define-key map [select-window] 'ignore)
1365 display-hourglass nil 1370 (setq cursor-type nil
1366 minor-mode-map-alist nil 1371 display-hourglass nil
1367 emulation-mode-map-alists nil 1372 minor-mode-map-alist nil
1368 buffer-undo-list t 1373 emulation-mode-map-alists nil
1369 mode-line-format (propertize "---- %b %-" 1374 buffer-undo-list t
1370 'face 'mode-line-buffer-id) 1375 mode-line-format (propertize "---- %b %-"
1371 fancy-splash-stop-time (+ (float-time) 1376 'face 'mode-line-buffer-id)
1372 fancy-splash-max-time) 1377 fancy-splash-stop-time (+ (float-time)
1373 timer (run-with-timer 0 fancy-splash-delay 1378 fancy-splash-max-time)
1374 #'fancy-splash-screens-1 1379 timer (run-with-timer 0 fancy-splash-delay
1375 splash-buffer)) 1380 #'fancy-splash-screens-1
1376 (recursive-edit)) 1381 splash-buffer))
1377 (cancel-timer timer) 1382 (recursive-edit))
1378 (setq display-hourglass old-hourglass 1383 (cancel-timer timer)
1379 minor-mode-map-alist old-minor-mode-map-alist 1384 (setq display-hourglass old-hourglass
1380 emulation-mode-map-alists old-emulation-mode-map-alists) 1385 minor-mode-map-alist old-minor-mode-map-alist
1381 (kill-buffer splash-buffer) 1386 emulation-mode-map-alists old-emulation-mode-map-alists)
1382 (when (frame-live-p frame) 1387 (kill-buffer splash-buffer)
1383 (select-frame frame) 1388 (when (frame-live-p frame)
1384 (switch-to-buffer fancy-splash-outer-buffer))))))) 1389 (select-frame frame)
1390 (switch-to-buffer fancy-splash-outer-buffer))))))
1391 ;; If hide-on-input is non-nil, don't hide the buffer on input.
1392 (if (or (window-minibuffer-p)
1393 (window-dedicated-p (selected-window)))
1394 (pop-to-buffer (current-buffer))
1395 (switch-to-buffer "GNU Emacs"))
1396 (erase-buffer)
1397 (if pure-space-overflow
1398 (insert "\
1399 Warning Warning!!! Pure space overflow !!!Warning Warning
1400 \(See the node Pure Storage in the Lisp manual for details.)\n"))
1401 (let (fancy-splash-outer-buffer)
1402 (fancy-splash-head)
1403 (dolist (text fancy-splash-text)
1404 (apply #'fancy-splash-insert text))
1405 (fancy-splash-tail)
1406 (set-buffer-modified-p nil)
1407 (goto-char (point-min)))))
1408
1385 1409
1386 (defun fancy-splash-frame () 1410 (defun fancy-splash-frame ()
1387 "Return the frame to use for the fancy splash screen. 1411 "Return the frame to use for the fancy splash screen.
1388 Returning non-nil does not mean we should necessarily 1412 Returning non-nil does not mean we should necessarily
1389 use the fancy splash screen, but if we do use it, 1413 use the fancy splash screen, but if we do use it,
1410 (image-height (and img (cdr (image-size img)))) 1434 (image-height (and img (cdr (image-size img))))
1411 (window-height (1- (window-height (frame-selected-window frame))))) 1435 (window-height (1- (window-height (frame-selected-window frame)))))
1412 (> window-height (+ image-height 19))))))) 1436 (> window-height (+ image-height 19)))))))
1413 1437
1414 1438
1415 (defun normal-splash-screen () 1439 (defun normal-splash-screen (&optional hide-on-input)
1416 "Display splash screen when Emacs starts." 1440 "Display splash screen when Emacs starts."
1417 (let ((prev-buffer (current-buffer))) 1441 (let ((prev-buffer (current-buffer)))
1418 (unwind-protect 1442 (unwind-protect
1419 (with-current-buffer (get-buffer-create "GNU Emacs") 1443 (with-current-buffer (get-buffer-create "GNU Emacs")
1444 (erase-buffer)
1420 (set (make-local-variable 'tab-width) 8) 1445 (set (make-local-variable 'tab-width) 8)
1421 (set (make-local-variable 'mode-line-format) 1446 (if hide-on-input
1422 (propertize "---- %b %-" 'face 'mode-line-buffer-id)) 1447 (set (make-local-variable 'mode-line-format)
1448 (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
1423 1449
1424 (if pure-space-overflow 1450 (if pure-space-overflow
1425 (insert "\ 1451 (insert "\
1426 Warning Warning!!! Pure space overflow !!!Warning Warning 1452 Warning Warning!!! Pure space overflow !!!Warning Warning
1427 \(See the node Pure Storage in the Lisp manual for details.)\n")) 1453 \(See the node Pure Storage in the Lisp manual for details.)\n"))
1433 (insert 1459 (insert
1434 (if (eq system-type 'gnu/linux) 1460 (if (eq system-type 'gnu/linux)
1435 ", one component of the GNU/Linux operating system.\n" 1461 ", one component of the GNU/Linux operating system.\n"
1436 ", a part of the GNU operating system.\n")) 1462 ", a part of the GNU operating system.\n"))
1437 1463
1438 (unless (equal (buffer-name prev-buffer) "*scratch*") 1464 (if hide-on-input
1439 (insert (substitute-command-keys 1465 (insert (substitute-command-keys
1440 "\nType \\[recenter] to begin editing your file.\n"))) 1466 (concat
1467 "\nType \\[recenter] to begin editing"
1468 (if (equal (buffer-name prev-buffer) "*scratch*")
1469 ".\n"
1470 " your file.\n")))))
1441 1471
1442 (if (display-mouse-p) 1472 (if (display-mouse-p)
1443 ;; The user can use the mouse to activate menus 1473 ;; The user can use the mouse to activate menus
1444 ;; so give help in terms of menu items. 1474 ;; so give help in terms of menu items.
1445 (progn 1475 (progn
1546 t) 1576 t)
1547 (insert "\n\nIf an Emacs session crashed recently, " 1577 (insert "\n\nIf an Emacs session crashed recently, "
1548 "type M-x recover-session RET\nto recover" 1578 "type M-x recover-session RET\nto recover"
1549 " the files you were editing.")) 1579 " the files you were editing."))
1550 1580
1551 ;; Display the input that we set up in the buffer. 1581 ;; Display the input that we set up in the buffer.
1552 (set-buffer-modified-p nil) 1582 (set-buffer-modified-p nil)
1553 (goto-char (point-min)) 1583 (goto-char (point-min))
1554 (if (or (window-minibuffer-p) 1584 (if (or (window-minibuffer-p)
1555 (window-dedicated-p (selected-window))) 1585 (window-dedicated-p (selected-window)))
1556 ;; There's no point is using pop-to-buffer since creating 1586 ;; If hide-on-input is nil, creating a new frame will
1557 ;; a new frame will generate enough events that the 1587 ;; generate enough events that the subsequent `sit-for'
1558 ;; subsequent `sit-for' will immediately return anyway. 1588 ;; will immediately return anyway.
1559 nil ;; (pop-to-buffer (current-buffer)) 1589 (pop-to-buffer (current-buffer))
1560 (save-window-excursion 1590 (if hide-on-input
1561 (switch-to-buffer (current-buffer)) 1591 (save-window-excursion
1562 (sit-for 120)))) 1592 (switch-to-buffer (current-buffer))
1563 ;; Unwind ... ensure splash buffer is killed 1593 (sit-for 120))
1564 (kill-buffer "GNU Emacs")))) 1594 (switch-to-buffer (current-buffer)))))
1595 ;; Unwind ... ensure splash buffer is killed
1596 (if hide-on-input
1597 (kill-buffer "GNU Emacs")))))
1565 1598
1566 1599
1567 (defun startup-echo-area-message () 1600 (defun startup-echo-area-message ()
1568 (if (eq (key-binding "\C-h\C-p") 'describe-project) 1601 (if (eq (key-binding "\C-h\C-p") 'describe-project)
1569 "For information about the GNU Project and its goals, type C-h C-p." 1602 "For information about the GNU Project and its goals, type C-h C-p."
1613 (progn 1646 (progn
1614 (use-fancy-splash-screens-p) 1647 (use-fancy-splash-screens-p)
1615 (message "%s" (startup-echo-area-message)))))) 1648 (message "%s" (startup-echo-area-message))))))
1616 1649
1617 1650
1618 (defun display-splash-screen () 1651 (defun display-splash-screen (&optional hide-on-input)
1619 "Display splash screen according to display. 1652 "Display splash screen according to display.
1620 Fancy splash screens are used on graphic displays, 1653 Fancy splash screens are used on graphic displays,
1621 normal otherwise." 1654 normal otherwise."
1622 (interactive) 1655 (interactive)
1623 ;; Prevent recursive calls from server-process-filter. 1656 ;; Prevent recursive calls from server-process-filter.
1624 (if (not (get-buffer "GNU Emacs")) 1657 (if (not (get-buffer "GNU Emacs"))
1625 (if (use-fancy-splash-screens-p) 1658 (if (use-fancy-splash-screens-p)
1626 (fancy-splash-screens) 1659 (fancy-splash-screens hide-on-input)
1627 (normal-splash-screen)))) 1660 (normal-splash-screen hide-on-input))))
1628 1661
1629 (defun command-line-1 (command-line-args-left) 1662 (defun command-line-1 (command-line-args-left)
1630 (display-startup-echo-area-message) 1663 (display-startup-echo-area-message)
1631 1664
1632 ;; Delay 2 seconds after an init file error message 1665 ;; Delay 2 seconds after an init file error message
1886 (set-buffer-modified-p nil)) 1919 (set-buffer-modified-p nil))
1887 1920
1888 ;; If user typed input during all that work, 1921 ;; If user typed input during all that work,
1889 ;; abort the startup screen. Otherwise, display it now. 1922 ;; abort the startup screen. Otherwise, display it now.
1890 (unless (input-pending-p) 1923 (unless (input-pending-p)
1891 (display-splash-screen)))) 1924 (display-splash-screen t))))
1892 1925
1893 1926
1894 (defun command-line-normalize-file-name (file) 1927 (defun command-line-normalize-file-name (file)
1895 "Collapse multiple slashes to one, to handle non-Emacs file names." 1928 "Collapse multiple slashes to one, to handle non-Emacs file names."
1896 (save-match-data 1929 (save-match-data