Mercurial > hg > xemacs-beta

comparison lisp/faces.el @ 462:0784d089fdc9 r21-2-46

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-46
author cvs
date Mon, 13 Aug 2007 11:44:37 +0200
parents 3d3049ae1304
children 029314e67086
comparison
equal deleted inserted replaced
461:120ed4009e51 462:0784d089fdc9
759 ;; x and tty devices. Then, check those properties specific to 759 ;; x and tty devices. Then, check those properties specific to
760 ;; the particular device type. 760 ;; the particular device type.
761 (and (face-equal-loop common-props face1 face2 domain) 761 (and (face-equal-loop common-props face1 face2 domain)
762 (cond ((eq 'tty (device-type device)) 762 (cond ((eq 'tty (device-type device))
763 (face-equal-loop tty-props face1 face2 domain)) 763 (face-equal-loop tty-props face1 face2 domain))
764 ;; #### Why isn't this (console-on-window-system-p (device-console device))?
765 ;; #### FIXME!
764 ((or (eq 'x (device-type device)) 766 ((or (eq 'x (device-type device))
767 (eq 'gtk (device-type device))
765 (eq 'mswindows (device-type device))) 768 (eq 'mswindows (device-type device)))
766 (face-equal-loop win-props face1 face2 domain)) 769 (face-equal-loop win-props face1 face2 domain))
767 (t t))))) 770 (t t)))))
768 771
769 (defun face-differs-from-default-p (face &optional domain) 772 (defun face-differs-from-default-p (face &optional domain)
1016 (lambda () 1019 (lambda ()
1017 ;; handle TTY specific entries 1020 ;; handle TTY specific entries
1018 (when (featurep 'tty) 1021 (when (featurep 'tty)
1019 (set-face-highlight-p face t locale (cons 'tty tags)))) 1022 (set-face-highlight-p face t locale (cons 'tty tags))))
1020 (lambda () 1023 (lambda ()
1021 ;; handle X/MS Windows specific entries 1024 ;; handle window-system specific entries
1025 (when (featurep 'gtk)
1026 (frob-face-property face 'font 'gtk-make-font-bold
1027 '(gtk) locale tags))
1022 (when (featurep 'x) 1028 (when (featurep 'x)
1023 (frob-face-property face 'font 'x-make-font-bold 1029 (frob-face-property face 'font 'x-make-font-bold
1024 '(x) locale tags)) 1030 '(x) locale tags))
1025 (when (featurep 'mswindows) 1031 (when (featurep 'mswindows)
1026 (frob-face-property face 'font 'mswindows-make-font-bold 1032 (frob-face-property face 'font 'mswindows-make-font-bold
1043 (lambda () 1049 (lambda ()
1044 ;; handle TTY specific entries 1050 ;; handle TTY specific entries
1045 (when (featurep 'tty) 1051 (when (featurep 'tty)
1046 (set-face-underline-p face t locale (cons 'tty tags)))) 1052 (set-face-underline-p face t locale (cons 'tty tags))))
1047 (lambda () 1053 (lambda ()
1048 ;; handle X specific entries 1054 ;; handle window-system specific entries
1055 (when (featurep 'gtk)
1056 (frob-face-property face 'font 'gtk-make-font-italic
1057 '(gtk) locale tags))
1049 (when (featurep 'x) 1058 (when (featurep 'x)
1050 (frob-face-property face 'font 'x-make-font-italic 1059 (frob-face-property face 'font 'x-make-font-italic
1051 '(x) locale tags)) 1060 '(x) locale tags))
1052 (when (featurep 'mswindows) 1061 (when (featurep 'mswindows)
1053 (frob-face-property face 'font 'mswindows-make-font-italic 1062 (frob-face-property face 'font 'mswindows-make-font-italic
1071 ;; handle TTY specific entries 1080 ;; handle TTY specific entries
1072 (when (featurep 'tty) 1081 (when (featurep 'tty)
1073 (set-face-highlight-p face t locale (cons 'tty tags)) 1082 (set-face-highlight-p face t locale (cons 'tty tags))
1074 (set-face-underline-p face t locale (cons 'tty tags)))) 1083 (set-face-underline-p face t locale (cons 'tty tags))))
1075 (lambda () 1084 (lambda ()
1076 ;; handle X specific entries 1085 ;; handle window-system specific entries
1086 (when (featurep 'gtk)
1087 (frob-face-property face 'font 'gtk-make-font-bold-italic
1088 '(gtk) locale tags))
1077 (when (featurep 'x) 1089 (when (featurep 'x)
1078 (frob-face-property face 'font 'x-make-font-bold-italic 1090 (frob-face-property face 'font 'x-make-font-bold-italic
1079 '(x) locale tags)) 1091 '(x) locale tags))
1080 (when (featurep 'mswindows) 1092 (when (featurep 'mswindows)
1081 (frob-face-property face 'font 'mswindows-make-font-bold-italic 1093 (frob-face-property face 'font 'mswindows-make-font-bold-italic
1098 (lambda () 1110 (lambda ()
1099 ;; handle TTY specific entries 1111 ;; handle TTY specific entries
1100 (when (featurep 'tty) 1112 (when (featurep 'tty)
1101 (set-face-highlight-p face nil locale (cons 'tty tags)))) 1113 (set-face-highlight-p face nil locale (cons 'tty tags))))
1102 (lambda () 1114 (lambda ()
1103 ;; handle X specific entries 1115 ;; handle window-system specific entries
1116 (when (featurep 'gtk)
1117 (frob-face-property face 'font 'gtk-make-font-unbold
1118 '(gtk) locale tags))
1104 (when (featurep 'x) 1119 (when (featurep 'x)
1105 (frob-face-property face 'font 'x-make-font-unbold 1120 (frob-face-property face 'font 'x-make-font-unbold
1106 '(x) locale tags)) 1121 '(x) locale tags))
1107 (when (featurep 'mswindows) 1122 (when (featurep 'mswindows)
1108 (frob-face-property face 'font 'mswindows-make-font-unbold 1123 (frob-face-property face 'font 'mswindows-make-font-unbold
1125 (lambda () 1140 (lambda ()
1126 ;; handle TTY specific entries 1141 ;; handle TTY specific entries
1127 (when (featurep 'tty) 1142 (when (featurep 'tty)
1128 (set-face-underline-p face nil locale (cons 'tty tags)))) 1143 (set-face-underline-p face nil locale (cons 'tty tags))))
1129 (lambda () 1144 (lambda ()
1130 ;; handle X specific entries 1145 ;; handle window-system specific entries
1146 (when (featurep 'gtk)
1147 (frob-face-property face 'font 'gtk-make-font-unitalic
1148 '(gtk) locale tags))
1131 (when (featurep 'x) 1149 (when (featurep 'x)
1132 (frob-face-property face 'font 'x-make-font-unitalic 1150 (frob-face-property face 'font 'x-make-font-unitalic
1133 '(x) locale tags)) 1151 '(x) locale tags))
1134 (when (featurep 'mswindows) 1152 (when (featurep 'mswindows)
1135 (frob-face-property face 'font 'mswindows-make-font-unitalic 1153 (frob-face-property face 'font 'mswindows-make-font-unitalic
1475 (loop for face in (face-list) do 1493 (loop for face in (face-list) do
1476 (init-face-from-resources face device)) 1494 (init-face-from-resources face device))
1477 ;; Then do any device-specific initialization. 1495 ;; Then do any device-specific initialization.
1478 (cond ((eq 'x (device-type device)) 1496 (cond ((eq 'x (device-type device))
1479 (x-init-device-faces device)) 1497 (x-init-device-faces device))
1498 ((eq 'gtk (device-type device))
1499 (gtk-init-device-faces device))
1480 ((eq 'mswindows (device-type device)) 1500 ((eq 'mswindows (device-type device))
1481 (mswindows-init-device-faces device)) 1501 (mswindows-init-device-faces device))
1482 ;; Nothing to do for TTYs? 1502 ;; Nothing to do for TTYs?
1483 ) 1503 )
1484 (or (eq 'stream (device-type device)) 1504 (or (eq 'stream (device-type device))
1490 (loop for face in (face-list) do 1510 (loop for face in (face-list) do
1491 (init-face-from-resources face frame)) 1511 (init-face-from-resources face frame))
1492 ;; Then do any frame-specific initialization. 1512 ;; Then do any frame-specific initialization.
1493 (cond ((eq 'x (frame-type frame)) 1513 (cond ((eq 'x (frame-type frame))
1494 (x-init-frame-faces frame)) 1514 (x-init-frame-faces frame))
1515 ((eq 'gtk (frame-type frame))
1516 (gtk-init-frame-faces frame))
1495 ((eq 'mswindows (frame-type frame)) 1517 ((eq 'mswindows (frame-type frame))
1496 (mswindows-init-frame-faces frame)) 1518 (mswindows-init-frame-faces frame))
1497 ;; Is there anything which should be done for TTY's? 1519 ;; Is there anything which should be done for TTY's?
1498 ))) 1520 )))
1499 1521
1506 (defun init-global-faces () 1528 (defun init-global-faces ()
1507 ;; Look for global face resources. 1529 ;; Look for global face resources.
1508 (loop for face in (face-list) do 1530 (loop for face in (face-list) do
1509 (init-face-from-resources face 'global)) 1531 (init-face-from-resources face 'global))
1510 ;; Further X frobbing. 1532 ;; Further X frobbing.
1511 (x-init-global-faces) 1533 (and (featurep 'x) (x-init-global-faces))
1534 (and (featurep 'gtk) (gtk-init-global-faces))
1535
1512 ;; for bold and the like, make the global specification be bold etc. 1536 ;; for bold and the like, make the global specification be bold etc.
1513 ;; if the user didn't already specify a value. These will also be 1537 ;; if the user didn't already specify a value. These will also be
1514 ;; frobbed further in init-other-random-faces. 1538 ;; frobbed further in init-other-random-faces.
1515 (unless (face-font 'bold 'global) 1539 (unless (face-font 'bold 'global)
1516 (make-face-bold 'bold 'global)) 1540 (make-face-bold 'bold 'global))
1735 ((mswindows default color) . "green") 1759 ((mswindows default color) . "green")
1736 ((mswindows default grayscale) . "gray53")) 1760 ((mswindows default grayscale) . "gray53"))
1737 'global) 1761 'global)
1738 (set-face-background-pixmap 'highlight 1762 (set-face-background-pixmap 'highlight
1739 '(((x default mono) . "gray1") 1763 '(((x default mono) . "gray1")
1764 ;; ((gtk default mono) . "gray1")
1740 ((mswindows default mono) . "gray1")) 1765 ((mswindows default mono) . "gray1"))
1741 'global) 1766 'global)
1742 1767
1743 (set-face-background 'zmacs-region 1768 (set-face-background 'zmacs-region
1744 '(((x default color) . "gray65") 1769 '(((x default color) . "gray65")
1746 ((mswindows default color) . "gray65") 1771 ((mswindows default color) . "gray65")
1747 ((mswindows default grayscale) . "gray65")) 1772 ((mswindows default grayscale) . "gray65"))
1748 'global) 1773 'global)
1749 (set-face-background-pixmap 'zmacs-region 1774 (set-face-background-pixmap 'zmacs-region
1750 '(((x default mono) . "gray3") 1775 '(((x default mono) . "gray3")
1776 ;; ((gtk default mono) . "gray3")
1751 ((mswindows default mono) . "gray3")) 1777 ((mswindows default mono) . "gray3"))
1752 'global) 1778 'global)
1753 1779
1754 (set-face-background 'list-mode-item-selected 1780 (set-face-background 'list-mode-item-selected
1755 '(((x default color) . "gray68") 1781 '(((x default color) . "gray68")
1756 ((x default grayscale) . "gray68") 1782 ((x default grayscale) . "gray68")
1757 ((x default mono) . [default foreground]) 1783 ((x default mono) . [default foreground])
1784 ;; ((gtk default color) . "gray68")
1785 ;; ((gtk default grayscale) . "gray68")
1786 ;; ((gtk default mono) . [default foreground])
1758 ((mswindows default color) . "gray68") 1787 ((mswindows default color) . "gray68")
1759 ((mswindows default grayscale) . "gray68") 1788 ((mswindows default grayscale) . "gray68")
1760 ((mswindows default mono) . [default foreground])) 1789 ((mswindows default mono) . [default foreground]))
1761 'global) 1790 'global)
1762 (set-face-foreground 'list-mode-item-selected 1791 (set-face-foreground 'list-mode-item-selected
1770 ((mswindows default color) . "gray65") 1799 ((mswindows default color) . "gray65")
1771 ((mswindows default grayscale) . "gray65")) 1800 ((mswindows default grayscale) . "gray65"))
1772 'global) 1801 'global)
1773 (set-face-background-pixmap 'primary-selection 1802 (set-face-background-pixmap 'primary-selection
1774 '(((x default mono) . "gray3") 1803 '(((x default mono) . "gray3")
1804 ;;((gtk default mono) . "gray3")
1775 ((mswindows default mono) . "gray3")) 1805 ((mswindows default mono) . "gray3"))
1776 'global) 1806 'global)
1777 1807
1778 (set-face-background 'secondary-selection 1808 (set-face-background 'secondary-selection
1779 '(((x default color) . "paleturquoise") 1809 '(((x default color) . "paleturquoise")
1780 ((x default color) . "green") 1810 ((x default color) . "green")
1781 ((x default grayscale) . "gray53") 1811 ((x default grayscale) . "gray53")
1812 ;;((gtk default color) . "paleturquoise")
1813 ;;((gtk default color) . "green")
1814 ;;((gtk default grayscale) . "gray53")
1782 ((mswindows default color) . "paleturquoise") 1815 ((mswindows default color) . "paleturquoise")
1783 ((mswindows default color) . "green") 1816 ((mswindows default color) . "green")
1784 ((mswindows default grayscale) . "gray53")) 1817 ((mswindows default grayscale) . "gray53"))
1785 'global) 1818 'global)
1786 (set-face-background-pixmap 'secondary-selection 1819 (set-face-background-pixmap 'secondary-selection
1787 '(((x default mono) . "gray1") 1820 '(((x default mono) . "gray1")
1821 ;;((gtk default mono) . "gray1")
1788 ((mswindows default mono) . "gray1")) 1822 ((mswindows default mono) . "gray1"))
1789 'global) 1823 'global)
1790 1824
1791 (set-face-background 'isearch 1825 (set-face-background 'isearch
1792 '(((x default color) . "paleturquoise") 1826 '(((x default color) . "paleturquoise")
1793 ((x default color) . "green") 1827 ((x default color) . "green")
1828 ;;((gtk default color) . "paleturquoise")
1829 ;;((gtk default color) . "green")
1794 ((mswindows default color) . "paleturquoise") 1830 ((mswindows default color) . "paleturquoise")
1795 ((mswindows default color) . "green")) 1831 ((mswindows default color) . "green"))
1796 'global) 1832 'global)
1797 1833
1798 ;; #### This should really, I mean *really*, be converted to some form 1834 ;; #### This should really, I mean *really*, be converted to some form