aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2011-07-09 22:04:45 -0400
committerChong Yidong2011-07-09 22:04:45 -0400
commitfa7c3228b5868efb5789ad862ea29a59c265acd4 (patch)
tree4015cc2dee045659ff04a820858f94d880f9288a
parent455e4fa13a50cfd3ad0ca765f1aca3e3d30cca6a (diff)
downloademacs-fa7c3228b5868efb5789ad862ea29a59c265acd4.tar.gz
emacs-fa7c3228b5868efb5789ad862ea29a59c265acd4.zip
Tweak link and startup screen faces.
See http://lists.gnu.org/archive/html/emacs-devel/2011-07/msg00478.html for a discussion of the link face. The changes to the startup faces are so that they can take advantage of the light/dark background settings already defined for those faces. * lisp/faces.el (link): Use a less saturated blue on light backgrounds. * lisp/startup.el (fancy-startup-text, fancy-about-text) (fancy-startup-tail): Use font-lock faces, for background safety.
-rw-r--r--lisp/ChangeLog5
-rw-r--r--lisp/faces.el2
-rw-r--r--lisp/startup.el183
3 files changed, 94 insertions, 96 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 40f96b05637..23aaf167666 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -7,6 +7,11 @@
7 * window.el (display-buffer): Fix arguments to 7 * window.el (display-buffer): Fix arguments to
8 display-buffer-reuse-window in last change. 8 display-buffer-reuse-window in last change.
9 9
10 * faces.el (link): Use a less saturated blue on light backgrounds.
11
12 * startup.el (fancy-startup-text, fancy-about-text)
13 (fancy-startup-tail): Use font-lock faces, for background safety.
14
102011-07-09 Bob Nnamtrop <bobnnamtrop@gmail.com> (tiny change) 152011-07-09 Bob Nnamtrop <bobnnamtrop@gmail.com> (tiny change)
11 16
12 * emulation/viper-cmd.el (viper-change-state-to-vi): Limit 17 * emulation/viper-cmd.el (viper-change-state-to-vi): Limit
diff --git a/lisp/faces.el b/lisp/faces.el
index 34e154314b5..302f8af35ac 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2109,7 +2109,7 @@ terminal type to a different value."
2109 2109
2110(defface link 2110(defface link
2111 '((((class color) (min-colors 88) (background light)) 2111 '((((class color) (min-colors 88) (background light))
2112 :foreground "blue1" :underline t) 2112 :foreground "RoyalBlue3" :underline t)
2113 (((class color) (background light)) 2113 (((class color) (background light))
2114 :foreground "blue" :underline t) 2114 :foreground "blue" :underline t)
2115 (((class color) (min-colors 88) (background dark)) 2115 (((class color) (min-colors 88) (background dark))
diff --git a/lisp/startup.el b/lisp/startup.el
index 26c5a469330..e2d7cf40c89 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1293,7 +1293,7 @@ If this is nil, no message will be displayed."
1293;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1293;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1294 1294
1295(defconst fancy-startup-text 1295(defconst fancy-startup-text
1296 `((:face (variable-pitch (:foreground "red")) 1296 `((:face (variable-pitch font-lock-comment-face)
1297 "Welcome to " 1297 "Welcome to "
1298 :link ("GNU Emacs" 1298 :link ("GNU Emacs"
1299 ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) 1299 ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1350,7 +1350,7 @@ Each element in the list should be a list of strings or pairs
1350`:face FACE', like `fancy-splash-insert' accepts them.") 1350`:face FACE', like `fancy-splash-insert' accepts them.")
1351 1351
1352(defconst fancy-about-text 1352(defconst fancy-about-text
1353 `((:face (variable-pitch (:foreground "red")) 1353 `((:face (:inherit (variable-pitch font-lock-comment-face))
1354 "This is " 1354 "This is "
1355 :link ("GNU Emacs" 1355 :link ("GNU Emacs"
1356 ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) 1356 ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
@@ -1366,11 +1366,7 @@ Each element in the list should be a list of strings or pairs
1366 `("GNU" ,(lambda (_button) (describe-gnu-project)) 1366 `("GNU" ,(lambda (_button) (describe-gnu-project))
1367 "Display info on the GNU project."))) 1367 "Display info on the GNU project.")))
1368 " operating system.\n" 1368 " operating system.\n"
1369 :face ,(lambda () 1369 :face (variable-pitch font-lock-builtin-face)
1370 (list 'variable-pitch
1371 (list :foreground
1372 (if (eq (frame-parameter nil 'background-mode) 'dark)
1373 "cyan" "darkblue"))))
1374 "\n" 1370 "\n"
1375 ,(lambda () (emacs-version)) 1371 ,(lambda () (emacs-version))
1376 "\n" 1372 "\n"
@@ -1426,8 +1422,7 @@ Each element in the list should be a list of strings or pairs
1426 ,(lambda (_button) 1422 ,(lambda (_button)
1427 (browse-url "http://www.gnu.org/software/emacs/tour/")) 1423 (browse-url "http://www.gnu.org/software/emacs/tour/"))
1428 "Browse http://www.gnu.org/software/emacs/tour/") 1424 "Browse http://www.gnu.org/software/emacs/tour/")
1429 "\tSee an overview of Emacs features at gnu.org" 1425 "\tSee an overview of Emacs features at gnu.org"))
1430 ))
1431 "A list of texts to show in the middle part of the About screen. 1426 "A list of texts to show in the middle part of the About screen.
1432Each element in the list should be a list of strings or pairs 1427Each element in the list should be a list of strings or pairs
1433`:face FACE', like `fancy-splash-insert' accepts them.") 1428`:face FACE', like `fancy-splash-insert' accepts them.")
@@ -1537,93 +1532,91 @@ a face or button specification."
1537 1532
1538(defun fancy-startup-tail (&optional concise) 1533(defun fancy-startup-tail (&optional concise)
1539 "Insert the tail part of the splash screen into the current buffer." 1534 "Insert the tail part of the splash screen into the current buffer."
1540 (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark) 1535 (unless concise
1541 "cyan" "darkblue")))
1542 (unless concise
1543 (fancy-splash-insert
1544 :face 'variable-pitch
1545 "\nTo start... "
1546 :link `("Open a File"
1547 ,(lambda (_button) (call-interactively 'find-file))
1548 "Specify a new file's name, to edit the file")
1549 " "
1550 :link `("Open Home Directory"
1551 ,(lambda (_button) (dired "~"))
1552 "Open your home directory, to operate on its files")
1553 " "
1554 :link `("Customize Startup"
1555 ,(lambda (_button) (customize-group 'initialization))
1556 "Change initialization settings including this screen")
1557 "\n"))
1558 (fancy-splash-insert 1536 (fancy-splash-insert
1559 :face 'variable-pitch "To quit a partially entered command, type " 1537 :face 'variable-pitch
1560 :face 'default "Control-g" 1538 "\nTo start... "
1561 :face 'variable-pitch ".\n") 1539 :link `("Open a File"
1562 (fancy-splash-insert :face `(variable-pitch (:foreground ,fg)) 1540 ,(lambda (_button) (call-interactively 'find-file))
1563 "\nThis is " 1541 "Specify a new file's name, to edit the file")
1564 (emacs-version) 1542 " "
1565 "\n" 1543 :link `("Open Home Directory"
1566 :face '(variable-pitch (:height 0.8)) 1544 ,(lambda (_button) (dired "~"))
1567 emacs-copyright 1545 "Open your home directory, to operate on its files")
1568 "\n") 1546 " "
1569 (and auto-save-list-file-prefix 1547 :link `("Customize Startup"
1570 ;; Don't signal an error if the 1548 ,(lambda (_button) (customize-group 'initialization))
1571 ;; directory for auto-save-list files 1549 "Change initialization settings including this screen")
1572 ;; does not yet exist. 1550 "\n"))
1573 (file-directory-p (file-name-directory 1551 (fancy-splash-insert
1574 auto-save-list-file-prefix)) 1552 :face 'variable-pitch "To quit a partially entered command, type "
1575 (directory-files 1553 :face 'default "Control-g"
1576 (file-name-directory auto-save-list-file-prefix) 1554 :face 'variable-pitch ".\n")
1577 nil 1555 (fancy-splash-insert :face `(variable-pitch font-lock-builtin-face)
1578 (concat "\\`" 1556 "\nThis is "
1579 (regexp-quote (file-name-nondirectory 1557 (emacs-version)
1580 auto-save-list-file-prefix))) 1558 "\n"
1581 t) 1559 :face '(variable-pitch (:height 0.8))
1582 (fancy-splash-insert :face '(variable-pitch (:foreground "red")) 1560 emacs-copyright
1583 "\nIf an Emacs session crashed recently, " 1561 "\n")
1584 "type " 1562 (and auto-save-list-file-prefix
1585 :face '(fixed-pitch :foreground "red") 1563 ;; Don't signal an error if the
1586 "Meta-x recover-session RET" 1564 ;; directory for auto-save-list files
1587 :face '(variable-pitch (:foreground "red")) 1565 ;; does not yet exist.
1588 "\nto recover" 1566 (file-directory-p (file-name-directory
1589 " the files you were editing.")) 1567 auto-save-list-file-prefix))
1590 1568 (directory-files
1591 (when concise 1569 (file-name-directory auto-save-list-file-prefix)
1592 (fancy-splash-insert 1570 nil
1593 :face 'variable-pitch "\n" 1571 (concat "\\`"
1594 :link `("Dismiss this startup screen" 1572 (regexp-quote (file-name-nondirectory
1595 ,(lambda (_button) 1573 auto-save-list-file-prefix)))
1596 (when startup-screen-inhibit-startup-screen 1574 t)
1597 (customize-set-variable 'inhibit-startup-screen t) 1575 (fancy-splash-insert :face '(variable-pitch font-lock-comment-face)
1598 (customize-mark-to-save 'inhibit-startup-screen) 1576 "\nIf an Emacs session crashed recently, "
1599 (custom-save-all)) 1577 "type "
1600 (let ((w (get-buffer-window "*GNU Emacs*"))) 1578 :face '(fixed-pitch font-lock-comment-face)
1601 (and w (not (one-window-p)) (delete-window w))) 1579 "Meta-x recover-session RET"
1602 (kill-buffer "*GNU Emacs*"))) 1580 :face '(variable-pitch font-lock-comment-face)
1603 " ") 1581 "\nto recover"
1604 (when (or user-init-file custom-file) 1582 " the files you were editing."))
1605 (let ((checked (create-image "checked.xpm" 1583
1606 nil nil :ascent 'center)) 1584 (when concise
1607 (unchecked (create-image "unchecked.xpm" 1585 (fancy-splash-insert
1608 nil nil :ascent 'center))) 1586 :face 'variable-pitch "\n"
1609 (insert-button 1587 :link `("Dismiss this startup screen"
1610 " " 1588 ,(lambda (_button)
1611 :on-glyph checked 1589 (when startup-screen-inhibit-startup-screen
1612 :off-glyph unchecked 1590 (customize-set-variable 'inhibit-startup-screen t)
1613 'checked nil 'display unchecked 'follow-link t 1591 (customize-mark-to-save 'inhibit-startup-screen)
1614 'action (lambda (button) 1592 (custom-save-all))
1615 (if (overlay-get button 'checked) 1593 (let ((w (get-buffer-window "*GNU Emacs*")))
1616 (progn (overlay-put button 'checked nil) 1594 (and w (not (one-window-p)) (delete-window w)))
1617 (overlay-put button 'display 1595 (kill-buffer "*GNU Emacs*")))
1618 (overlay-get button :off-glyph)) 1596 " ")
1619 (setq startup-screen-inhibit-startup-screen 1597 (when (or user-init-file custom-file)
1620 nil)) 1598 (let ((checked (create-image "checked.xpm"
1621 (overlay-put button 'checked t) 1599 nil nil :ascent 'center))
1622 (overlay-put button 'display 1600 (unchecked (create-image "unchecked.xpm"
1623 (overlay-get button :on-glyph)) 1601 nil nil :ascent 'center)))
1624 (setq startup-screen-inhibit-startup-screen t))))) 1602 (insert-button
1625 (fancy-splash-insert :face '(variable-pitch (:height 0.9)) 1603 " "
1626 " Never show it again."))))) 1604 :on-glyph checked
1605 :off-glyph unchecked
1606 'checked nil 'display unchecked 'follow-link t
1607 'action (lambda (button)
1608 (if (overlay-get button 'checked)
1609 (progn (overlay-put button 'checked nil)
1610 (overlay-put button 'display
1611 (overlay-get button :off-glyph))
1612 (setq startup-screen-inhibit-startup-screen
1613 nil))
1614 (overlay-put button 'checked t)
1615 (overlay-put button 'display
1616 (overlay-get button :on-glyph))
1617 (setq startup-screen-inhibit-startup-screen t)))))
1618 (fancy-splash-insert :face '(variable-pitch (:height 0.9))
1619 " Never show it again."))))
1627 1620
1628(defun exit-splash-screen () 1621(defun exit-splash-screen ()
1629 "Stop displaying the splash screen buffer." 1622 "Stop displaying the splash screen buffer."