Mercurial > hg > xemacs-beta
diff lisp/prim/faces.el @ 118:7d55a9ba150c r20-1b11
Import from CVS: tag r20-1b11
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:24:17 +0200 |
parents | 360340f9fd5f |
children | 6075d714658b |
line wrap: on
line diff
--- a/lisp/prim/faces.el Mon Aug 13 09:23:08 2007 +0200 +++ b/lisp/prim/faces.el Mon Aug 13 09:24:17 2007 +0200 @@ -1391,6 +1391,39 @@ nil nil 'append) ) +;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle Jones. +(defun set-face-stipple (face pixmap &optional frame) + "Change the stipple pixmap of face FACE to PIXMAP. +This is an Emacs compatibility function; consider using +set-face-background-pixmap instead. + +PIXMAP should be a string, the name of a file of pixmap data. +The directories listed in the `x-bitmap-file-path' variable are searched. +Any kind of image file for which XEmacs has builtin support can be used. + +Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT +DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is +a string, containing the raw bits of the bitmap. XBM data is +expected in this case, other types of image data will not work. + +If the optional FRAME argument is provided, change only +in that frame; otherwise change each frame." + (while (not (find-face face)) + (setq face (signal 'wrong-type-argument (list 'facep face)))) + (while (cond ((stringp pixmap) + (unless (file-readable-p pixmap) + (setq pixmap (vector 'xbm ':file pixmap))) + nil) + ((and (consp pixmap) (= (length pixmap) 3)) + (setq pixmap (vector 'xbm ':data pixmap)) + nil) + (t t)) + (setq pixmap (signal 'wrong-type-argument + (list 'stipple-pixmap-p pixmap)))) + (while (and frame (not (framep frame))) + (setq frame (signal 'wrong-type-argument (list 'framep frame)))) + (set-face-background-pixmap face pixmap frame)) + ;; Create the remaining standard faces now. This way, packages that we dump ;; can reference these faces as parents. @@ -1436,3 +1469,5 @@ (set-face-reverse-p 'list-mode-item-selected t 'global 'tty) (set-face-reverse-p 'isearch t 'global 'tty) ) + +;;; faces.el ends here