Mercurial > hg > xemacs-beta

comparison lisp/faces.el @ 5128:7be849cb8828 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Sun, 07 Mar 2010 02:09:59 -0600
parents 5502045ec510
children d27c1ee1943b 308d34e9f07d
comparison
equal deleted inserted replaced
5127:a9c41067dd88 5128:7be849cb8828
1 ;;; faces.el --- Lisp interface to the C "face" structure 1 ;;; faces.el --- Lisp interface to the C "face" structure
2 2
3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Board of Trustees, University of Illinois 4 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
5 ;; Copyright (C) 1995, 1996, 2002, 2005 Ben Wing 5 ;; Copyright (C) 1995, 1996, 2002, 2005 Ben Wing
6 ;; Copyright (C) 2010 Didier Verna
6 7
7 ;; Author: Ben Wing <ben@xemacs.org> 8 ;; Author: Ben Wing <ben@xemacs.org>
8 ;; Keywords: faces, internal, dumped 9 ;; Keywords: faces, internal, dumped
9 10
10 ;; This file is part of XEmacs. 11 ;; This file is part of XEmacs.
85 (font-instance-name default)) 86 (font-instance-name default))
86 ((color-instance-p default) 87 ((color-instance-p default)
87 (color-instance-name default)) 88 (color-instance-name default))
88 ((image-instance-p default) 89 ((image-instance-p default)
89 (image-instance-file-name default)) 90 (image-instance-file-name default))
91 ((face-background-placement-instance-p default)
92 (symbol-name default))
90 (t default)))))) 93 (t default))))))
91 (list face (if (equal value "") nil value)))) 94 (list face (if (equal value "") nil value))))
92 95
93 (defconst built-in-face-specifiers 96 (defconst built-in-face-specifiers
94 (built-in-face-specifiers) 97 (built-in-face-specifiers)
331 334
332 background-pixmap The pixmap displayed in the background of the face. 335 background-pixmap The pixmap displayed in the background of the face.
333 Only used by faces on X and MS Windows devices. 336 Only used by faces on X and MS Windows devices.
334 For valid instantiators, see `make-image-specifier'. 337 For valid instantiators, see `make-image-specifier'.
335 338
339 background-placement The placement of the face's background pixmap.
340 Only used by faces on X devices.
341 For valid instantiators,
342 see `make-face-background-placement-specifier'.
343
336 underline Underline all text covered by this face. 344 underline Underline all text covered by this face.
337 For valid instantiators, see `make-face-boolean-specifier'. 345 For valid instantiators, see `make-face-boolean-specifier'.
338 346
339 strikethru Draw a line through all text covered by this face. 347 strikethru Draw a line through all text covered by this face.
340 For valid instantiators, see `make-face-boolean-specifier'. 348 For valid instantiators, see `make-face-boolean-specifier'.
714 nil default t nil 722 nil default t nil
715 'background-pixmap-file-history))) 723 'background-pixmap-file-history)))
716 (list face (if (equal file "") nil file)))) 724 (list face (if (equal file "") nil file))))
717 (set-face-property face 'background-pixmap file)) 725 (set-face-property face 'background-pixmap file))
718 726
727 (defun face-background-placement (face &optional domain default no-fallback)
728 "Return FACE's background placement in DOMAIN.
729 See `face-property-instance' for the semantics of the DOMAIN argument."
730 (face-property face 'background-placement domain default no-fallback))
731
732 (defun set-face-background-placement (face placement &optional locale tag-set
733 how-to-add)
734 "Change the background-placement property of FACE to PLACEMENT.
735 PLACEMENT is normally a background-placement instantiator; see
736 `make-face-background-placement-specifier'.
737 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
738 HOW-TO-ADD arguments."
739 (interactive (face-interactive "background placement"))
740 ;; When called non-interactively (for example via custom), PLACEMENT is
741 ;; expected to be a symbol. -- dvl
742 (unless (symbolp placement)
743 (setq placement (intern placement)))
744 (set-face-property face 'background-placement placement locale tag-set
745 how-to-add))
746
747 (defun face-background-placement-instance (face &optional domain default
748 no-fallback)
749 "Return FACE's background-placement instance in DOMAIN.
750 Return value will be a background-placement instance object.
751
752 FACE may be either a face object or a symbol representing a face.
753
754 Normally DOMAIN will be a window or nil (meaning the selected window),
755 and an instance object describing the background placement in that particular
756 window and buffer will be returned.
757
758 See `face-property-instance' for more information."
759 (face-property-instance face 'background-placement domain default
760 no-fallback))
761
762 (defun face-background-placement-instance-p (object)
763 "Return t if OBJECT is a face-background-placement instance."
764 (or (eq object 'absolute) (eq object 'relative)))
765
719 (defun face-display-table (face &optional locale tag-set exact-p) 766 (defun face-display-table (face &optional locale tag-set exact-p)
720 "Return the display table spec of FACE in LOCALE, or nil if unspecified.. 767 "Return the display table spec of FACE in LOCALE, or nil if unspecified..
721 768
722 NOTE: This returns a locale-specific specification, not any sort of value 769 NOTE: This returns a locale-specific specification, not any sort of value
723 corresponding to the actual display table being used. If you want to 770 corresponding to the actual display table being used. If you want to
869 (if (not (valid-specifier-domain-p domain)) 916 (if (not (valid-specifier-domain-p domain))
870 (error "Invalid specifier domain")) 917 (error "Invalid specifier domain"))
871 (let ((device (dfw-device domain)) 918 (let ((device (dfw-device domain))
872 (common-props '(foreground background font display-table underline 919 (common-props '(foreground background font display-table underline
873 dim inherit)) 920 dim inherit))
874 (win-props '(background-pixmap strikethru)) 921 (win-props '(background-pixmap background-placement strikethru))
875 (tty-props '(highlight blinking reverse))) 922 (tty-props '(highlight blinking reverse)))
876 923
877 ;; First check the properties which are used in common between the 924 ;; First check the properties which are used in common between the
878 ;; x and tty devices. Then, check those properties specific to 925 ;; x and tty devices. Then, check those properties specific to
879 ;; the particular device type. 926 ;; the particular device type.
1941 ;; specified, that it not use fallbacks, otherwise *they* use the general 1988 ;; specified, that it not use fallbacks, otherwise *they* use the general
1942 ;; fallback of the default face instead, which clashes with the gui 1989 ;; fallback of the default face instead, which clashes with the gui
1943 ;; element faces. So take the modeline face information from its 1990 ;; element faces. So take the modeline face information from its
1944 ;; fallbacks, themselves ultimately set up in faces.c: 1991 ;; fallbacks, themselves ultimately set up in faces.c:
1945 (loop 1992 (loop
1946 for face-property in '(foreground background background-pixmap) 1993 for face-property in '(foreground background
1994 background-pixmap background-placement)
1947 do (when (and (setq face-property (face-property 'modeline face-property)) 1995 do (when (and (setq face-property (face-property 'modeline face-property))
1948 (null (specifier-instance face-property device nil t)) 1996 (null (specifier-instance face-property device nil t))
1949 (specifier-instance face-property device)) 1997 (specifier-instance face-property device))
1950 (set-specifier face-property 1998 (set-specifier face-property
1951 (or (specifier-specs (specifier-fallback 1999 (or (specifier-specs (specifier-fallback