Mercurial > hg > xemacs-beta

comparison lisp/faces.el @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 1ccc32a20af4
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
840 ;; inherits its font from 'default. 840 ;; inherits its font from 'default.
841 ;; (2) if we're frobbing a particular locale, nothing would 841 ;; (2) if we're frobbing a particular locale, nothing would
842 ;; happen if that locale has no instantiators. So signal 842 ;; happen if that locale has no instantiators. So signal
843 ;; an error to indicate this. 843 ;; an error to indicate this.
844 844
845 845
846 (setq temp-sp (copy-specifier sp)) 846 (setq temp-sp (copy-specifier sp))
847 (if (and (or (eq locale 'global) (eq locale 'all) (not locale)) 847 (if (and (or (eq locale 'global) (eq locale 'all) (not locale))
848 (not (face-property face property 'global))) 848 (not (face-property face property 'global)))
849 (copy-specifier (face-property 'default property) 849 (copy-specifier (face-property 'default property)
850 temp-sp 'global)) 850 temp-sp 'global))
851 (if (and (valid-specifier-locale-p locale) 851 (if (and (valid-specifier-locale-p locale)
852 (not (specifier-specs temp-sp locale))) 852 (not (specifier-specs temp-sp locale)))
853 (error "Property must have a specification in locale %S" locale)) 853 (error "Property must have a specification in locale %S" locale))
854 (map-specifier 854 (map-specifier
855 temp-sp 855 temp-sp
1296 (setq default-custom-frame-properties 1296 (setq default-custom-frame-properties
1297 (extract-custom-frame-properties (selected-frame)))))) 1297 (extract-custom-frame-properties (selected-frame))))))
1298 1298
1299 (defun face-spec-update-all-matching (spec display plist) 1299 (defun face-spec-update-all-matching (spec display plist)
1300 "Update all entries in the face spec that could match display to 1300 "Update all entries in the face spec that could match display to
1301 have the entries from the new plist and return the new spec" 1301 have the entries from the new plist and return the new spec."
1302 (mapcar 1302 (mapcar
1303 (lambda (e) 1303 (lambda (e)
1304 (let ((entries (car e)) 1304 (let ((entries (car e))
1305 (options (cadr e)) 1305 (options (cadr e))
1306 (match t) 1306 (match t)
1324 (setq options 1324 (setq options
1325 (plist-put options (car new-options) (cadr new-options))) 1325 (plist-put options (car new-options) (cadr new-options)))
1326 (setq new-options (cddr new-options))) 1326 (setq new-options (cddr new-options)))
1327 (list entries options)))) 1327 (list entries options))))
1328 (copy-sequence spec))) 1328 (copy-sequence spec)))
1329 1329
1330 1330
1331 1331
1332 (defun face-spec-set-match-display (display &optional frame) 1332 (defun face-spec-set-match-display (display &optional frame)
1333 "Return non-nil if DISPLAY matches FRAME. 1333 "Return non-nil if DISPLAY matches FRAME.
1334 DISPLAY is part of a spec such as can be used in `defface'. 1334 DISPLAY is part of a spec such as can be used in `defface'.
1335 If FRAME is nil or omitted, the selected frame is used." 1335 If FRAME is nil or omitted, the selected frame is used."
1779 1779
1780 ;; Define some logical color names to be used when reading the pixmap files. 1780 ;; Define some logical color names to be used when reading the pixmap files.
1781 (if (featurep 'xpm) 1781 (if (featurep 'xpm)
1782 (setq xpm-color-symbols 1782 (setq xpm-color-symbols
1783 (list 1783 (list
1784 (purecopy '("foreground" (face-foreground 'default))) 1784 '("foreground" (face-foreground 'default))
1785 (purecopy '("background" (face-background 'default))) 1785 '("background" (face-background 'default))
1786 (purecopy '("backgroundToolBarColor" 1786 '("backgroundToolBarColor"
1787 (or 1787 (or
1788 (and 1788 (and
1789 (featurep 'x) 1789 (featurep 'x)
1790 (x-get-resource "backgroundToolBarColor" 1790 (x-get-resource "backgroundToolBarColor"
1791 "BackgroundToolBarColor" 'string 1791 "BackgroundToolBarColor" 'string
1792 nil nil 'warn)) 1792 nil nil 'warn))
1793 1793
1794 (face-background 'toolbar)))) 1794 (face-background 'toolbar)))
1795 (purecopy '("foregroundToolBarColor" 1795 '("foregroundToolBarColor"
1796 (or 1796 (or
1797 (and 1797 (and
1798 (featurep 'x) 1798 (featurep 'x)
1799 (x-get-resource "foregroundToolBarColor" 1799 (x-get-resource "foregroundToolBarColor"
1800 "ForegroundToolBarColor" 'string 1800 "ForegroundToolBarColor" 'string
1801 nil nil 'warn)) 1801 nil nil 'warn))
1802 (face-foreground 'toolbar)))) 1802 (face-foreground 'toolbar)))
1803 ))) 1803 )))
1804 1804
1805 (when (featurep 'tty) 1805 (when (featurep 'tty)
1806 (set-face-highlight-p 'bold t 'global '(default tty)) 1806 (set-face-highlight-p 'bold t 'global '(default tty))
1807 (set-face-underline-p 'italic t 'global '(default tty)) 1807 (set-face-underline-p 'italic t 'global '(default tty))