Mercurial > hg > xemacs-beta

comparison lisp/faces.el @ 5473:ac37a5f7e5be

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Thu, 17 Mar 2011 23:42:59 +0100
parents 0af042a0c116 b6e59ea11533
children 4dee0387b9de
comparison
equal deleted inserted replaced
5472:e79980ee5efe 5473:ac37a5f7e5be
55 :group 'emacs) 55 :group 'emacs)
56 56
57 57
58 (defun read-face-name (prompt) 58 (defun read-face-name (prompt)
59 (let (face) 59 (let (face)
60 (while (= (length face) 0) ; nil or "" 60 (while (eql (length face) 0) ; nil or ""
61 (setq face (completing-read prompt 61 (setq face (completing-read prompt
62 (mapcar (lambda (x) (list (symbol-name x))) 62 (mapcar (lambda (x) (list (symbol-name x)))
63 (face-list)) 63 (face-list))
64 nil t))) 64 nil t)))
65 (intern face))) 65 (intern face)))
474 (if (null charset) 474 (if (null charset)
475 (face-property-instance face 'font domain) 475 (face-property-instance face 'font domain)
476 (let (matchspec) 476 (let (matchspec)
477 ;; get-charset signals an error if its argument doesn't have an 477 ;; get-charset signals an error if its argument doesn't have an
478 ;; associated charset. 478 ;; associated charset.
479 (setq charset (if-fboundp #'get-charset 479 (setq charset (if-fboundp 'get-charset
480 (get-charset charset) 480 (get-charset charset)
481 (error 'unimplemented "Charset support not available")) 481 (error 'unimplemented "Charset support not available"))
482 matchspec (cons charset nil)) 482 matchspec (cons charset nil))
483 (or (null (setcdr matchspec 'initial)) 483 (or (null (setcdr matchspec 'initial))
484 (face-property-matching-instance 484 (face-property-matching-instance
1698 t 1698 t
1699 (let* ((props (get-custom-frame-properties frame)) 1699 (let* ((props (get-custom-frame-properties frame))
1700 (type (plist-get props 'type)) 1700 (type (plist-get props 'type))
1701 (class (plist-get props 'class)) 1701 (class (plist-get props 'class))
1702 (background (plist-get props 'background)) 1702 (background (plist-get props 'background))
1703 (min-colors (plist-get props 'min-colors))
1703 (match t) 1704 (match t)
1704 (entries display) 1705 (entries display)
1705 entry req options) 1706 entry req options)
1706 (while (and entries match) 1707 (while (and entries match)
1707 (setq entry (car entries) 1708 (setq entry (car entries)
1710 options (cdr entry) 1711 options (cdr entry)
1711 match (case req 1712 match (case req
1712 (type (memq type options)) 1713 (type (memq type options))
1713 (class (memq class options)) 1714 (class (memq class options))
1714 (background (memq background options)) 1715 (background (memq background options))
1716 (min-colors (>= (display-color-cells frame)
1717 (car options)))
1715 (t (warn "Unknown req `%S' with options `%S'" 1718 (t (warn "Unknown req `%S' with options `%S'"
1716 req options) 1719 req options)
1717 nil)))) 1720 nil))))
1718 match))) 1721 match)))
1719 1722
2035 pixmap 2038 pixmap
2036 (locate-file pixmap bitmap-path 2039 (locate-file pixmap bitmap-path
2037 '(".xbm" ""))))) 2040 '(".xbm" "")))))
2038 (and file 2041 (and file
2039 `[xbm :file ,file]))) 2042 `[xbm :file ,file])))
2040 ((and (listp pixmap) (= (length pixmap) 3)) 2043 ((and (listp pixmap) (eql (length pixmap) 3))
2041 `[xbm :data ,pixmap]) 2044 `[xbm :data ,pixmap])
2042 (t nil)))) 2045 (t nil))))
2043 ;; We're signaling a continuable error; let's make sure the 2046 ;; We're signaling a continuable error; let's make sure the
2044 ;; function `stipple-pixmap-p' at least exists. 2047 ;; function `stipple-pixmap-p' at least exists.
2045 (flet ((stipple-pixmap-p (pixmap) 2048 (flet ((stipple-pixmap-p (pixmap)
2046 (or (stringp pixmap) 2049 (or (stringp pixmap)
2047 (and (listp pixmap) (= (length pixmap) 3))))) 2050 (and (listp pixmap) (eql (length pixmap) 3)))))
2048 (setq pixmap (signal 'wrong-type-argument 2051 (setq pixmap (signal 'wrong-type-argument
2049 (list 'stipple-pixmap-p pixmap))))) 2052 (list 'stipple-pixmap-p pixmap)))))
2050 (check-type frame (or null frame)) 2053 (check-type frame (or null frame))
2051 (set-face-background-pixmap face instantiator frame))) 2054 (set-face-background-pixmap face instantiator frame)))
2052 2055