comparison lisp/faces.el @ 406:b8cc9ab3f761 r21-2-33

Import from CVS: tag r21-2-33
author cvs
date Mon, 13 Aug 2007 11:17:09 +0200
parents 74fd4e045ea6
children 501cfd01ee6d
comparison
equal deleted inserted replaced
405:0e08f63c74d2 406:b8cc9ab3f761
1587 (face-property-equal 'text-cursor 'default 'foreground device)) 1587 (face-property-equal 'text-cursor 'default 'foreground device))
1588 (set-face-foreground 'text-cursor [default background] 'global 1588 (set-face-foreground 'text-cursor [default background] 'global
1589 nil 'append)) 1589 nil 'append))
1590 ) 1590 )
1591 1591
1592 ;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle Jones. 1592 ;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle
1593 ;; Jones and Hrvoje Niksic.
1593 (defun set-face-stipple (face pixmap &optional frame) 1594 (defun set-face-stipple (face pixmap &optional frame)
1594 "Change the stipple pixmap of FACE to PIXMAP. 1595 "Change the stipple pixmap of FACE to PIXMAP.
1595 This is an Emacs compatibility function; consider using 1596 This is an Emacs compatibility function; consider using
1596 set-face-background-pixmap instead. 1597 set-face-background-pixmap instead.
1597 1598
1598 PIXMAP should be a string, the name of a file of pixmap data. 1599 PIXMAP should be a string, the name of a file of pixmap data.
1599 The directories listed in the `x-bitmap-file-path' variable are searched. 1600 The directories listed in the variables `x-bitmap-file-path' and
1601 `mswindows-bitmap-file-path' under X and MS Windows respectively
1602 are searched.
1600 1603
1601 Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT 1604 Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT
1602 DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is 1605 DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is
1603 a string, containing the raw bits of the bitmap. XBM data is 1606 a string, containing the raw bits of the bitmap. XBM data is
1604 expected in this case, other types of image data will not work. 1607 expected in this case, other types of image data will not work.
1605 1608
1606 If the optional FRAME argument is provided, change only 1609 If the optional FRAME argument is provided, change only
1607 in that frame; otherwise change each frame." 1610 in that frame; otherwise change each frame."
1608 (while (not (find-face face)) 1611 (while (not (find-face face))
1609 (setq face (signal 'wrong-type-argument (list 'facep face)))) 1612 (setq face (signal 'wrong-type-argument (list 'facep face))))
1610 (locate-file pixmap x-bitmap-file-path '(".xbm" "")) 1613 (let ((bitmap-path (ecase (console-type)
1611 (while (cond ((stringp pixmap) 1614 (x x-bitmap-file-path)
1612 (unless (file-readable-p pixmap) 1615 (mswindows mswindows-bitmap-file-path)))
1613 (setq pixmap `[xbm :file ,pixmap])) 1616 instantiator)
1614 nil) 1617 (while
1615 ((and (consp pixmap) (= (length pixmap) 3)) 1618 (null
1616 (setq pixmap `[xbm :data ,pixmap]) 1619 (setq instantiator
1617 nil) 1620 (cond ((stringp pixmap)
1618 (t t)) 1621 (let ((file (if (file-name-absolute-p pixmap)
1619 (setq pixmap (signal 'wrong-type-argument 1622 pixmap
1620 (list 'stipple-pixmap-p pixmap)))) 1623 (locate-file pixmap bitmap-path
1621 (while (and frame (not (framep frame))) 1624 '(".xbm" "")))))
1622 (setq frame (signal 'wrong-type-argument (list 'framep frame)))) 1625 (and file
1623 (set-face-background-pixmap face pixmap frame)) 1626 `[xbm :file ,file])))
1627 ((and (listp pixmap) (= (length pixmap) 3))
1628 `[xbm :data ,pixmap])
1629 (t nil))))
1630 ;; We're signaling a continuable error; let's make sure the
1631 ;; function `stipple-pixmap-p' at least exists.
1632 (flet ((stipple-pixmap-p (pixmap)
1633 (or (stringp pixmap)
1634 (and (listp pixmap) (= (length pixmap) 3)))))
1635 (setq pixmap (signal 'wrong-type-argument
1636 (list 'stipple-pixmap-p pixmap)))))
1637 (while (and frame (not (framep frame)))
1638 (setq frame (signal 'wrong-type-argument (list 'framep frame))))
1639 (set-face-background-pixmap face instantiator frame)))
1624 1640
1625 1641
1626 ;; Create the remaining standard faces now. This way, packages that we dump 1642 ;; Create the remaining standard faces now. This way, packages that we dump
1627 ;; can reference these faces as parents. 1643 ;; can reference these faces as parents.
1628 ;; 1644 ;;