Mercurial > hg > xemacs-beta
comparison lisp/faces.el @ 872:79c6ff3eef26
[xemacs-hg @ 2002-06-20 21:18:01 by ben]
font changes etc.; some 21.4 changes
mule/mule-msw-init-late.el: Specify charset->windows-registry conversion.
mule/mule-x-init.el: Delete extra mule font additions here. Put them in faces.c.
cl-macs.el: Document better.
font-lock.el: Move Lisp function regexp to lisp-mode.el.
lisp-mode.el: Various indentation fixes:
Handle flet functions better.
Handle argument lists in defuns and flets.
Handle quoted lists, e.g. property lists -- don't indent like
function calls. Distinguish between lambdas and other lists.
lisp-mode.el: Handle this form.
faces.el, font-menu.el, font.el, gtk-faces.el, msw-faces.el, msw-font-menu.el, x-faces.el, x-init.el: Major overhaul of face-handling code:
-- Fix lots of bogus code in msw-faces.el, msw-font-menu.el,
font-menu.el that was "truenaming" font specs -- i.e. in the
process of frobbing a particular field in a general user-specified
font spec with wildcarded fields, sticking in particular values
for all the remaining wildcarded fields. This bug was rampant
everywhere except in x-faces.el (the oldest and only correctly
written code). This also means that we need to work with font
names at all times and not font instances, because a font instance
is essentially a truenamed font.
-- Total rewrite of extremely junky code in msw-faces.el. Work
with names as well as font instances, and return names; stop
truenaming when canonicalizing and frobbing; fix handling of the
combined style field, i.e. weight/slant (also fixed in font.el).
-- Totally rewrite the frobbing functions in faces.el. This time,
we frob all the instantiators rather than just computing a single
instance value and working backwards. That way, e.g., `bold' will
work for all charsets that have bold available, rather than only
for whatever charset was part of the computed font instance
(another example of the truename virus). Also fix up code to look
at the fallbacks (all of them) when no global value present, so we
don't need to put something in the global value. Intelligently
handle a request to frob a buffer locale, rather than signalling
an error. When frobbing instantiators, try hard to figure out
what device type is associated with them, and frob each according
to its own proper device type. Correctly handle inheritance
vectors given as instantiators. Preserve existing tags when
putting back frobbed instantiators. Extract out general
specifier-frobbing code into specifier.el. Document everything
cleanly. Do lots of other things better, etc.
-- Don't duplicatively set a global specification for the default
font -- it's already in the fallback and we no longer need a
default global specification present. Delete various code in
x-faces.el and msw-faces.el that duplicated the lists of fonts in
faces.c.
-- init-global-faces was not being called at all under MS Windows!
Major bogosity. That caused device-specific values to get stuck
into all the fonts, making it very hard to change them -- setting
global specs caused nothing to happen.
-- Correct weight names in font.el.
-- Lots more font fixups in objects*.c.
Printer.el: Warning fix.
specifier.el: Add more args to map-specifier.
Add various "heuristic" specifier functions to aid in creation of
specifier-munging code such as in faces.el.
subr.el: New functions.
lwlib.c: Fix warning.
config.inc.samp: Clean up, add args to control fastcall (not yet supported! the
changes needed are in another ws of mine), profile support, vc6
support, union-type.
xemacs.dsp, xemacs.mak: Semi-major overhaul.
Fix bug where dump-id was always getting recomputed, forcing a
redump even when nothing changed.
Add support for fastcall. Support edit-and-continue (on by
default) with vc6. Use incremental linking when doing a debug
compilation. Add support for profiling.
Consolidate the various debug flags.
Partial support for "batch-compiling" -- compiling many files on a
single invocation of the compiler. Doesn't seem to help that much
for me, so it's not finished or enabled by default.
Remove HAVE_MSW_C_DIRED, we always do.
Correct some sloppy use of directories.
s/cygwin32.h: Allow pdump to work under Cygwin (mmap is broken, so need to undefine
HAVE_MMAP).
s/win32-common.h, s/windowsnt.h: Support for fastcall. Add WIN32_ANY for identifying all Win32
variants (Cygwin, native, MinGW). Both of these are properly used
in another ws.
alloc.c, balloon-x.c, buffer.c, bytecode.c, callint.c, cm.c, cmdloop.c, cmds.c, console-gtk.c, console-gtk.h, console-msw.c, console-msw.h, console-stream.c, console-stream.h, console-tty.c, console-tty.h, console-x.c, console-x.h, console.c, console.h, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, device.h, devslots.h, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, editfns.c, emacs.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, extents.c, extents.h, faces.c, fileio.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gui-gtk.c, gui-msw.c, gui-x.c, gui.c, gutter.c, input-method-xlib.c, intl-encap-win32.c, intl-win32.c, keymap.c, lisp.h, macros.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, menubar.h, minibuf.c, mule-charset.c, nt.c, objects-gtk.c, objects-gtk.h, objects-msw.c, objects-msw.h, objects-tty.c, objects-tty.h, objects-x.c, objects-x.h, objects.c, objects.h, postgresql.c, print.c, process.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, redisplay.h, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, select-gtk.c, select-msw.c, select-x.c, select.c, signal.c, sound.c, specifier.c, symbols.c, syntax.c, sysdep.c, syssignal.h, syswindows.h, toolbar-common.c, toolbar-gtk.c, toolbar-msw.c, toolbar-x.c, toolbar.c, unicode.c, window.c, window.h: The following are the major changes made:
(1) Separation of various header files into an external and an
internal version, similar to the existing separation of process.h
and procimpl.h. Eventually this should be done for all Lisp
objects. The external version has the same name as currently; the
internal adds -impl. The external file has XFOO() macros for
objects, but the structure is opaque and defined only in the
internal file. It's now reasonable to move all prototypes in
lisp.h into the appropriate external file, and this should be
done. Currently, separation has been done on extents.h,
objects*.h, console.h, device.h, frame.h, and window.h.
For c/d/f/w, the most basic properties are available in the
external header file, with the macros resolving to functions. In
the internal header file, the macros are redefined to directly
access the structure. Also, the global MARK_FOO_CHANGED macros
have been made into functions so that they can be accessed without
needing to include lots of -impl headers -- they are used in
almost exclusively in non-time-critical functions, and take up
enough time that the function overhead will be negligible.
Similarly, the function overhead from making the basic properties
mentioned above into functions is negligible, and code that does
heavy accessing of c/d/f/w structures inevitably ends up needing
the internal header files, anyway.
(2) More face changes.
-- Major rewrite of objects-msw.c. Now handles wildcard specs
properly, rather than "truenaming" (or even worse, signalling an
error, which previously happened with some of the fallbacks if you
tried to use them in make-font-instance!).
-- Split charset matching of fonts into two stages -- one to find
a font specifically designed for a particular charset (by
examining its registry), the second to find a Unicode font that
can support the charset. This needs to proceed as two complete,
separate instantiations in order to work properly (otherwise many
of the fonts in the HELLO page look wrong). This should also make
it easy to support iso10646 (Unicode) fonts under X.
-- All default values for fonts are now completely specified in
the fallbacks. Stuff from mule-x-init.el has all been moved here,
merged with the existing specs, and totally rethought so you get
sensible results. (HELLO now looks much better!).
-- Generalize the "default X/GTK device" stuff into a
per-device-type "default device".
-- Add mswindows-{set-}charset-registry. In time,
charset<->code-page conversion functions will be removed.
-- Wrap protective code around calls to compute device specifier tags,
and do this computation before calling the face initialization code
because the latter may need these tags to be correctly updated.
(3) Other changes.
EmacsFrame.c, glyphs-msw.c, eval.c, gui-x.c, intl-encap-win32.c, search.c, signal.c, toolbar-msw.c, unicode.c: Warning fixes.
config.h.in: #undefs meant to be frobbed by configure *MUST* go inside of
#ifndef WIN32_NO_CONFIGURE, and everything else *MUST* go outside!
eval.c: Let detailed backtraces be detailed.
specifier.c: Don't override user's print-string-length/print-length settings.
glyphs.c: New function image-instance-instantiator.
config.h.in, sysdep.c: Changes for fastcall.
sysdep.c, nt.c: Fix up a previous botched patch that tried to add support for both
EEXIST and EACCES. IF THE BOTCHED PATCH WENT INTO 21.4, THIS FIXUP
NEEDS TO GO IN, TOO.
search.c: Fix *evil* crash due to incorrect synching of syntax-cache code
with 21.1. THIS SHOULD GO INTO 21.4.
author | ben |
---|---|
date | Thu, 20 Jun 2002 21:19:10 +0000 |
parents | 2b6fa2618f76 |
children | c6facab13185 |
comparison
equal
deleted
inserted
replaced
871:732270854293 | 872:79c6ff3eef26 |
---|---|
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 Ben Wing | 5 ;; Copyright (C) 1995, 1996, 2002 Ben Wing |
6 | 6 |
7 ;; Author: Ben Wing <ben@xemacs.org> | 7 ;; Author: Ben Wing <ben@xemacs.org> |
8 ;; Keywords: faces, internal, dumped | 8 ;; Keywords: faces, internal, dumped |
9 | 9 |
10 ;; This file is part of XEmacs. | 10 ;; This file is part of XEmacs. |
164 (add-spec-to-specifier new-specifier specifier)) | 164 (add-spec-to-specifier new-specifier specifier)) |
165 (setq specifier new-specifier) | 165 (setq specifier new-specifier) |
166 (put face property specifier))))) | 166 (put face property specifier))))) |
167 | 167 |
168 (defun face-property-instance (face property | 168 (defun face-property-instance (face property |
169 &optional domain default no-fallback) | 169 &optional domain default no-fallback) |
170 "Return the instance of FACE's PROPERTY in the specified DOMAIN. | 170 "Return the instance of FACE's PROPERTY in the specified DOMAIN. |
171 | 171 |
172 Under most circumstances, DOMAIN will be a particular window, | 172 Under most circumstances, DOMAIN will be a particular window, |
173 and the returned instance describes how the specified property | 173 and the returned instance describes how the specified property |
174 actually is displayed for that window and the particular buffer | 174 actually is displayed for that window and the particular buffer |
214 (if (specifierp value) | 214 (if (specifierp value) |
215 (setq value (specifier-instance value domain default no-fallback))) | 215 (setq value (specifier-instance value domain default no-fallback))) |
216 value)) | 216 value)) |
217 | 217 |
218 (defun face-property-matching-instance (face property matchspec | 218 (defun face-property-matching-instance (face property matchspec |
219 &optional domain default | 219 &optional domain default |
220 no-fallback) | 220 no-fallback) |
221 "Return the instance of FACE's PROPERTY matching MATCHSPEC in DOMAIN. | 221 "Return the instance of FACE's PROPERTY matching MATCHSPEC in DOMAIN. |
222 Currently the only useful value for MATCHSPEC is a charset, when used | 222 Currently the only useful value for MATCHSPEC is a charset, when used |
223 in conjunction with the face's font; this allows you to retrieve a | 223 in conjunction with the face's font; this allows you to retrieve a |
224 font that can be used to display a particular charset, rather than just | 224 font that can be used to display a particular charset, rather than just |
225 any font. | 225 any font. |
229 matching process." | 229 matching process." |
230 | 230 |
231 (setq face (get-face face)) | 231 (setq face (get-face face)) |
232 (let ((value (get face property))) | 232 (let ((value (get face property))) |
233 (if (specifierp value) | 233 (if (specifierp value) |
234 (setq value (specifier-matching-instance value matchspec domain | 234 (setq value (if (or (charsetp matchspec) |
235 default no-fallback))) | 235 (and (symbolp matchspec) |
236 (find-charset matchspec))) | |
237 (or | |
238 (specifier-matching-instance | |
239 value (cons matchspec nil) domain default | |
240 no-fallback) | |
241 (specifier-matching-instance | |
242 value (cons matchspec t) domain default | |
243 no-fallback)) | |
244 (specifier-matching-instance value matchspec domain | |
245 default no-fallback)))) | |
236 value)) | 246 value)) |
237 | 247 |
238 (defun set-face-property (face property value &optional locale tag-set | 248 (defun set-face-property (face property value &optional locale tag-set |
239 how-to-add) | 249 how-to-add) |
240 "Change a property of FACE. | 250 "Change a property of FACE. |
241 | 251 |
242 NOTE: If you want to remove a property from a face, use `remove-face-property' | 252 NOTE: If you want to remove a property from a face, use `remove-face-property' |
243 rather than attempting to set a value of nil for the property. | 253 rather than attempting to set a value of nil for the property. |
244 | 254 |
634 | 644 |
635 See `face-property-instance' for the semantics of the DOMAIN argument." | 645 See `face-property-instance' for the semantics of the DOMAIN argument." |
636 (face-property-instance face 'display-table domain default no-fallback)) | 646 (face-property-instance face 'display-table domain default no-fallback)) |
637 | 647 |
638 (defun set-face-display-table (face display-table &optional locale tag-set | 648 (defun set-face-display-table (face display-table &optional locale tag-set |
639 how-to-add) | 649 how-to-add) |
640 "Change the display table of FACE to DISPLAY-TABLE in LOCALE. | 650 "Change the display table of FACE to DISPLAY-TABLE in LOCALE. |
641 DISPLAY-TABLE should be a vector as returned by `make-display-table'. | 651 DISPLAY-TABLE should be a vector as returned by `make-display-table'. |
642 | 652 |
643 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and | 653 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
644 HOW-TO-ADD arguments." | 654 HOW-TO-ADD arguments." |
653 "Return t if FACE is underlined in DOMAIN. | 663 "Return t if FACE is underlined in DOMAIN. |
654 See `face-property-instance' for the semantics of the DOMAIN argument." | 664 See `face-property-instance' for the semantics of the DOMAIN argument." |
655 (face-property-instance face 'underline domain default no-fallback)) | 665 (face-property-instance face 'underline domain default no-fallback)) |
656 | 666 |
657 (defun set-face-underline-p (face underline-p &optional locale tag-set | 667 (defun set-face-underline-p (face underline-p &optional locale tag-set |
658 how-to-add) | 668 how-to-add) |
659 "Change the underline property of FACE to UNDERLINE-P. | 669 "Change the underline property of FACE to UNDERLINE-P. |
660 UNDERLINE-P is normally a face-boolean instantiator; see | 670 UNDERLINE-P is normally a face-boolean instantiator; see |
661 `make-face-boolean-specifier'. | 671 `make-face-boolean-specifier'. |
662 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and | 672 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
663 HOW-TO-ADD arguments." | 673 HOW-TO-ADD arguments." |
668 "Return t if FACE is strikethru-d (i.e. struck through) in DOMAIN. | 678 "Return t if FACE is strikethru-d (i.e. struck through) in DOMAIN. |
669 See `face-property-instance' for the semantics of the DOMAIN argument." | 679 See `face-property-instance' for the semantics of the DOMAIN argument." |
670 (face-property-instance face 'strikethru domain default no-fallback)) | 680 (face-property-instance face 'strikethru domain default no-fallback)) |
671 | 681 |
672 (defun set-face-strikethru-p (face strikethru-p &optional locale tag-set | 682 (defun set-face-strikethru-p (face strikethru-p &optional locale tag-set |
673 how-to-add) | 683 how-to-add) |
674 "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE. | 684 "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE. |
675 STRIKETHRU-P is normally a face-boolean instantiator; see | 685 STRIKETHRU-P is normally a face-boolean instantiator; see |
676 `make-face-boolean-specifier'. | 686 `make-face-boolean-specifier'. |
677 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and | 687 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
678 HOW-TO-ADD arguments." | 688 HOW-TO-ADD arguments." |
683 "Return t if FACE is highlighted in DOMAIN (TTY domains only). | 693 "Return t if FACE is highlighted in DOMAIN (TTY domains only). |
684 See `face-property-instance' for the semantics of the DOMAIN argument." | 694 See `face-property-instance' for the semantics of the DOMAIN argument." |
685 (face-property-instance face 'highlight domain default no-fallback)) | 695 (face-property-instance face 'highlight domain default no-fallback)) |
686 | 696 |
687 (defun set-face-highlight-p (face highlight-p &optional locale tag-set | 697 (defun set-face-highlight-p (face highlight-p &optional locale tag-set |
688 how-to-add) | 698 how-to-add) |
689 "Change whether FACE is highlighted in LOCALE (TTY locales only). | 699 "Change whether FACE is highlighted in LOCALE (TTY locales only). |
690 HIGHLIGHT-P is normally a face-boolean instantiator; see | 700 HIGHLIGHT-P is normally a face-boolean instantiator; see |
691 `make-face-boolean-specifier'. | 701 `make-face-boolean-specifier'. |
692 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and | 702 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
693 HOW-TO-ADD arguments." | 703 HOW-TO-ADD arguments." |
712 "Return t if FACE is blinking in DOMAIN (TTY domains only). | 722 "Return t if FACE is blinking in DOMAIN (TTY domains only). |
713 See `face-property-instance' for the semantics of the DOMAIN argument." | 723 See `face-property-instance' for the semantics of the DOMAIN argument." |
714 (face-property-instance face 'blinking domain default no-fallback)) | 724 (face-property-instance face 'blinking domain default no-fallback)) |
715 | 725 |
716 (defun set-face-blinking-p (face blinking-p &optional locale tag-set | 726 (defun set-face-blinking-p (face blinking-p &optional locale tag-set |
717 how-to-add) | 727 how-to-add) |
718 "Change whether FACE is blinking in LOCALE (TTY locales only). | 728 "Change whether FACE is blinking in LOCALE (TTY locales only). |
719 BLINKING-P is normally a face-boolean instantiator; see | 729 BLINKING-P is normally a face-boolean instantiator; see |
720 `make-face-boolean-specifier'. | 730 `make-face-boolean-specifier'. |
721 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and | 731 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
722 HOW-TO-ADD arguments." | 732 HOW-TO-ADD arguments." |
764 ;; x and tty devices. Then, check those properties specific to | 774 ;; x and tty devices. Then, check those properties specific to |
765 ;; the particular device type. | 775 ;; the particular device type. |
766 (and (face-equal-loop common-props face1 face2 domain) | 776 (and (face-equal-loop common-props face1 face2 domain) |
767 (cond ((eq 'tty (device-type device)) | 777 (cond ((eq 'tty (device-type device)) |
768 (face-equal-loop tty-props face1 face2 domain)) | 778 (face-equal-loop tty-props face1 face2 domain)) |
769 ;; #### Why isn't this (console-on-window-system-p (device-console device))? | 779 ((console-on-window-system-p (device-console device)) |
770 ;; #### FIXME! | |
771 ((or (eq 'x (device-type device)) | |
772 (eq 'gtk (device-type device)) | |
773 (eq 'mswindows (device-type device))) | |
774 (face-equal-loop win-props face1 face2 domain)) | 780 (face-equal-loop win-props face1 face2 domain)) |
775 (t t))))) | 781 (t t))))) |
776 | 782 |
777 (defun face-differs-from-default-p (face &optional domain) | 783 (defun face-differs-from-default-p (face &optional domain) |
778 "Return t if FACE will display differently from the default face in DOMAIN. | 784 "Return t if FACE will display differently from the default face in DOMAIN. |
779 See `face-property-instance' for the semantics of the DOMAIN argument." | 785 See `face-property-instance' for the semantics of the DOMAIN argument." |
780 (not (face-equal face 'default domain))) | 786 (not (face-equal face 'default domain))) |
781 | 787 |
782 ; moved from x-faces.el | |
783 (defun try-font-name (name &optional device) | 788 (defun try-font-name (name &optional device) |
789 "Return NAME if it's a valid font name on DEVICE, else nil." | |
784 ;; yes, name really should be here twice. | 790 ;; yes, name really should be here twice. |
785 (and name (make-font-instance name device t) name)) | 791 (and name (make-font-instance name device t) name)) |
786 | 792 |
787 | 793 |
794 | |
795 (defcustom face-frob-from-locale-first nil | |
796 "*If non nil, use kludgy way of frobbing fonts suitable for non-mule | |
797 multi-charset environments." | |
798 :group 'faces | |
799 :type 'boolean) | |
800 | |
788 ;; This function is a terrible, disgusting hack!!!! Need to | 801 ;; This function is a terrible, disgusting hack!!!! Need to |
789 ;; separate out the font elements as separate face properties! | 802 ;; separate out the font elements as separate face properties! |
790 | 803 |
791 ;; WE DEMAND LEXICAL SCOPING!!! | 804 ;; WE DEMAND LEXICAL SCOPING!!! |
792 ;; WE DEMAND LEXICAL SCOPING!!! | 805 ;; WE DEMAND LEXICAL SCOPING!!! |
801 ;; WE DEMAND LEXICAL SCOPING!!! | 814 ;; WE DEMAND LEXICAL SCOPING!!! |
802 ;; WE DEMAND LEXICAL SCOPING!!! | 815 ;; WE DEMAND LEXICAL SCOPING!!! |
803 ;; WE DEMAND LEXICAL SCOPING!!! | 816 ;; WE DEMAND LEXICAL SCOPING!!! |
804 ;; WE DEMAND LEXICAL SCOPING!!! | 817 ;; WE DEMAND LEXICAL SCOPING!!! |
805 ;; WE DEMAND LEXICAL SCOPING!!! | 818 ;; WE DEMAND LEXICAL SCOPING!!! |
806 (defun frob-face-property (face property func device-tags &optional | 819 |
807 locale tags) | 820 ;; When we are initializing a device, it won't be selected; we communicate |
808 "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE. | 821 ;; the device to consider as selected using this variable. |
809 This function is ugly and messy and is primarily used as an internal | 822 (defvar Face-frob-property-device-considered-current nil) |
810 helper function for `make-face-bold' et al., so you probably don't | 823 |
811 want to use it or read the rest of the documentation. But if you do ... | 824 (defun Face-frob-property (face locale tag-set exact-p |
812 | 825 unfrobbed-face frobbed-face |
813 FUNC should be a function of two arguments (an instance and a device) | 826 win-prop tty-props |
814 that returns a modified name that is valid for the given device. | 827 frob-mapping standard-face-mapping) |
815 If LOCALE specifies a valid domain (i.e. a window, frame, or device), | 828 ;; implement the semantics of `make-face-bold' et al. FACE, LOCALE, TAG-SET |
816 this function instantiates the specifier over that domain, applies FUNC | 829 ;; and EXACT-P are as in that call. UNFROBBED-FACE and FROBBED-FACE are |
817 to the resulting instance, and adds the result back as an instantiator | 830 ;; what we expect the original face and the result to look like, |
818 for that locale. Otherwise, LOCALE should be a locale, locale type, or | 831 ;; respectively. TTY-PROPS is a list of face properties to frob in place |
819 'all (defaults to 'all if omitted). For each specification thusly | 832 ;; of `font' for TTY's. FROB-MAPPING is either a plist mapping device |
820 included: if the locale given is a valid domain, FUNC will be | 833 ;; types to functions of two args (NAME DEVICE) that will frob the |
821 iterated over all valid instantiators for the device of the domain | 834 ;; instantiator as appropriate for the device type (this includes TTY's), |
822 until a non-nil result is found (if there is no such result, the | 835 ;; or a function to handle the mapping for all device types. |
823 first valid instantiator is used), and that result substituted for | 836 ;; STANDARD-FACE-MAPPING is an alist of mappings of inheritance |
824 the specification; otherwise, the process just outlined is | 837 ;; instantiators to be replaced with other inheritance instantiators, meant |
825 iterated over each existing device and the concatenated results | 838 ;; for e.g. converting [bold] into [bold-italic]. |
826 substituted for the specification. | 839 |
827 | 840 ;; #### it would be nice if this function could be generalized to be |
828 DEVICE-TAGS is a list of tags that each device must match in order for | 841 ;; a general specifier frobber. but so much of what it does is specific |
829 the function to be called on it." | 842 ;; to faces -- e.g. handling of inheritance, standard faces, |
830 (let ((sp (face-property face property)) | 843 ;; special-casing in various ways for tty's, etc. i've already extracted |
831 temp-sp) | 844 ;; as much of the functionality as i can into subfunctions in the |
832 (if (valid-specifier-domain-p locale) | 845 ;; heuristic section of specifier.el. |
833 ;; this is easy. | 846 |
834 (let* ((inst (face-property-instance face property locale)) | 847 ;; #### Note: The old code was totally different (and there was much less |
835 (name (and inst | 848 ;; of it). It didn't bother with trying to frob all the instantiators, |
836 (device-matches-specifier-tag-set-p | 849 ;; or handle inheritance vectors as instantiators, or do something |
837 (dfw-device locale) device-tags) | 850 ;; sensible with buffer locales, or many other things. (It always, or |
838 (funcall func inst (dfw-device locale))))) | 851 ;; usually, did a specifier-instance and frobbed the result.) But it did |
839 (when name | 852 ;; do three things we don't: |
840 (add-spec-to-specifier sp name locale tags))) | 853 ;; |
841 ;; otherwise, map over all specifications ... | 854 ;; (1) Map over all devices when processing global or buffer locales. |
842 ;; but first, some further kludging: | 855 ;; Should we be doing this in stages 2 and/or 3? The fact that we |
843 ;; (1) if we're frobbing the global property, make sure | 856 ;; now process all fallback instantiators seems to make this less |
844 ;; that something is there (copy from the default face, | 857 ;; necessary, at least for global locales. |
845 ;; if necessary). Otherwise, something like | 858 ;; |
846 ;; (make-face-larger 'modeline) | 859 ;; (2) Remove all instantiators tagged with `default' when putting the |
847 ;; won't do anything at all if the modeline simply | 860 ;; instantiators back. I don't see why this is necessary, but maybe |
848 ;; inherits its font from 'default. | 861 ;; it is. |
849 ;; (2) if we're frobbing a particular locale, nothing would | 862 ;; |
850 ;; happen if that locale has no instantiators. So signal | 863 ;; (3) Pay attention to the face-frob-from-locale-first variable. #### |
851 ;; an error to indicate this. | 864 ;; I don't understand its purpose. Undocumented hacks like this, |
852 | 865 ;; clearly added after-the-fact, don't deserve to live. DOCUMENT |
853 | 866 ;; THIS SHIT! |
854 (setq temp-sp (copy-specifier sp)) | 867 |
855 (if (or (eq locale 'global) (eq locale 'all) (not locale)) | 868 (flet |
856 (when (not (specifier-specs temp-sp 'global)) | 869 ( |
857 ;; Try fallback via the official ways and then do it "by hand" | 870 |
858 (let* ((fallback (specifier-fallback sp)) | 871 ;; non-nil if either instantiator non-nil, or nil instantiators allowed. |
859 (fallback-sp | 872 (nil-instantiator-ok (inst devtype-spec) |
860 (cond ((specifierp fallback) fallback) | 873 (or inst (eq devtype-spec 'tty))) |
861 ;; just an inst list | 874 |
862 (fallback | 875 ;; if LOCALE is a global locale (all, nil, global), return 'global, |
863 (make-specifier-and-init (specifier-type sp) | 876 ;; else nil. |
864 fallback)) | 877 (global-locale (locale) |
865 ((eq (get-face face) (get-face 'default)) | 878 (and (memq locale '(all nil global)) 'global)) |
866 (error "Unable to find global specification")) | 879 |
867 ;; If no fallback we snoop from default | 880 ;; Given a locale and the inst-list from that locale, frob the |
868 (t (face-property 'default property))))) | 881 ;; instantiators according to FROB-MAPPING, a plist mapping device |
869 (copy-specifier fallback-sp temp-sp 'global)))) | 882 ;; types to functions that frob instantiators of that device type. |
870 (if (and (valid-specifier-locale-p locale) | 883 ;; NOTE: TAG-SET and FROB-MAPPING from environment. |
871 (not (specifier-specs temp-sp locale))) | 884 (frob-face-inst-list (locale inst-list prop devtype-spec) |
872 (error "Property must have a specification in locale %S" locale)) | 885 (let* ((ffpdev Face-frob-property-device-considered-current) |
873 (map-specifier | 886 (results |
874 temp-sp | 887 ;; for each inst-pair, frob it (the result will be 0 or |
875 (lambda (sp-arg locale inst-list func) | 888 ;; more inst-pairs; we may get more than one if, e.g. the |
876 (let* ((device (dfw-device locale)) | 889 ;; instantiator specifies inheritance and we expand the |
877 ;; if a device can be derived from the locale, | 890 ;; inheritance); then nconc the results together |
878 ;; call frob-face-property-1 for that device. | 891 (loop for (tag-set . x) in inst-list |
879 ;; Otherwise map frob-face-property-1 over each device. | 892 for devtype = (derive-device-type-from-locale-and-tag-set |
880 (result | 893 locale tag-set devtype-spec ffpdev) |
881 (if device | 894 ;; devtype may be nil if it fails to match DEVTYPE-SPEC |
882 (list (and (device-matches-specifier-tag-set-p | 895 if devtype |
883 device device-tags) | 896 if (let* ((mapper (if (functionp frob-mapping) frob-mapping |
884 (frob-face-property-1 sp-arg device inst-list | 897 (plist-get frob-mapping devtype))) |
885 func))) | 898 (result |
886 (mapcar (lambda (device) | 899 (cond |
887 (and (device-matches-specifier-tag-set-p | 900 ;; if a vector ... |
888 device device-tags) | 901 ((vectorp x) |
889 (frob-face-property-1 sp-arg device | 902 (let ((change-to |
890 inst-list func))) | 903 (cdr (assoc x standard-face-mapping)))) |
891 (device-list)))) | 904 (cond |
892 new-result) | 905 ;; (1) handle standard mappings/null vectors |
893 ;; remove duplicates and nils from the obtained list of | 906 ((or change-to (null (length x))) |
894 ;; instantiators. Also add tags amd remove 'defaults'. | 907 (list (cons tag-set |
895 (mapcar (lambda (arg) | 908 (cond ((eq change-to t) x) |
896 (when arg | 909 (change-to) |
897 (if (not (consp arg)) | 910 (t x))))) |
898 (setq arg (cons tags arg)) | 911 ;; (2) inheritance vectors. retrieve the |
899 (setcar arg (append tags (delete 'default | 912 ;; inherited value and recursively frob. |
900 (car arg)))))) | 913 ;; stick the tag-set into the result. |
901 (when (and arg (not (member arg new-result))) | 914 (t (let* |
902 (setq new-result (cons arg new-result)))) | 915 ((subprop |
903 result) | 916 (if (> (length x) 1) (elt x 1) |
904 ;; add back in. | 917 prop)) |
905 (add-spec-list-to-specifier sp (list (cons locale new-result))) | 918 (subinsts |
906 ;; tell map-specifier to keep going. | 919 (frob-face-inst-list |
907 nil)) | 920 locale |
908 locale | 921 (cdar |
909 func)))) | 922 (specifier-spec-list |
910 | 923 (face-property (elt x 0) |
911 (defun frob-face-property-1 (sp device inst-list func) | 924 subprop))) |
912 (let | 925 subprop devtype-spec))) |
913 (first-valid result) | 926 ;; #### we don't currently handle |
914 (while (and inst-list (not result)) | 927 ;; the "reverse the sense" flag on |
915 (let* ((inst-pair (car inst-list)) | 928 ;; tty inheritance vectors. |
916 (tag-set (car inst-pair)) | 929 (add-tag-to-inst-list subinsts |
917 (sp-inst (specifier-instance-from-inst-list | 930 tag-set)))))) |
918 sp device (list inst-pair)))) | 931 ;; (3) not a vector. just process it. |
919 (if sp-inst | 932 (t |
920 (progn | 933 (let ((value |
921 (if (not first-valid) | 934 (if (eq devtype-spec 'tty) |
922 (setq first-valid inst-pair)) | 935 (funcall mapper x) |
923 (setq result (funcall func sp-inst device)) | 936 (funcall mapper x |
924 (if result | 937 (derive-domain-from-locale |
925 (setq result (cons tag-set result)))))) | 938 locale devtype-spec |
926 (setq inst-list (cdr inst-list))) | 939 ffpdev))))) |
927 (or result first-valid))) | 940 (and (nil-instantiator-ok value devtype-spec) |
928 | 941 (list (cons tag-set value)))))))) |
929 (defcustom face-frob-from-locale-first nil | 942 ;; if we're adding to a tty, we need to tag our |
930 "*If non nil, use kludgy way of frobbing fonts suitable for non-mule | 943 ;; additions with `tty'; see [note 1] below. we leave |
931 multi-charset environments." | 944 ;; the old spec in place, however -- if e.g. we're |
932 :group 'faces | 945 ;; italicizing a font that was always set to be |
933 :type 'boolean) | 946 ;; underlined, even on window systems, then we still |
934 | 947 ;; want the underline there. unless we put the old |
935 (defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face | 948 ;; spec back, the underline will disappear, since |
936 tty-thunk ws-thunk standard-face-mapping) | 949 ;; the new specs are all tagged with `tty'. this |
937 ;; another kludge to make things more intuitive. If we're | 950 ;; doesn't apply to the [note 1] situations below |
938 ;; inheriting from a standard face in this locale, frob the | 951 ;; because there we're just adding, not substituting. |
939 ;; inheritance as appropriate. Else, if, after the first | 952 (if (and (eq 'tty devtype-spec) |
940 ;; window-system frobbing pass, the face hasn't changed and still | 953 (not (or (eq 'tty tag-set) |
941 ;; looks like the standard unfrobbed face (e.g. 'default), make it | 954 (memq 'tty tag-set)))) |
942 ;; inherit from the standard frobbed face (e.g. 'bold). Regardless | 955 (nconc (add-tag-to-inst-list result 'tty) |
943 ;; of things, do the TTY frobbing. | 956 (list (cons tag-set x))) |
944 | 957 result)) |
945 ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale, | 958 nconc it))) |
946 ;; but is a "locale, locale-type, or nil for all". So ... do our extra | 959 (delete-duplicates results :test #'equal))) |
947 ;; frobbing only if it's actually a locale; or for nil, do the frobbing | 960 |
948 ;; on 'global. This specifier stuff needs some rethinking. | 961 ;; Frob INST-LIST, which came from LOCALE, and put the new value back |
949 (let* ((the-locale (cond ((null locale) 'global) | 962 ;; into SP at LOCALE. THUNK is a cons of (PROP . DEVTYPE-SPEC), the |
950 ((valid-specifier-locale-p locale) locale) | 963 ;; property being processed and whether this is a TTY property or a |
951 (t nil))) | 964 ;; win property. |
952 (spec-list | 965 (frob-locale (sp locale inst-list thunk) |
953 (and | 966 (let ((newinst (frob-face-inst-list locale inst-list |
954 the-locale | 967 (car thunk) (cdr thunk)))) |
955 (specifier-spec-list (get (get-face face) 'font) the-locale tags t))) | 968 (remove-specifier sp locale tag-set exact-p) |
956 (change-it | 969 (add-spec-list-to-specifier sp (list (cons locale newinst)))) |
957 (and | 970 ;; map-specifier should keep going |
958 spec-list | 971 nil) |
959 (cdr (assoc (cdadar spec-list) standard-face-mapping))))) | 972 |
960 (if (and change-it | 973 ;; map over all specified locales in LOCALE; for each locale, |
961 (not (memq (face-name (find-face face)) | 974 ;; frob the instantiators in that locale in the specifier in both |
962 '(default bold italic bold-italic)))) | 975 ;; WIN-PROP and TTY-PROPS in FACE. Takes values from environment. |
963 (progn | 976 (map-over-locales (locale) |
964 (or (equal change-it t) | 977 (map-specifier (get face win-prop) #'frob-locale locale |
965 (set-face-property face 'font change-it the-locale tags)) | 978 (cons win-prop 'window-system) |
966 (funcall tty-thunk)) | 979 tag-set exact-p) |
967 (let* ((domain (cond ((null the-locale) nil) | 980 (loop for prop in tty-props do |
968 ((valid-specifier-domain-p the-locale) the-locale) | 981 (map-specifier (get face prop) #'frob-locale locale |
969 ;; OK, this next one is truly a kludge, but | 982 (cons prop 'tty) |
970 ;; it results in more intuitive behavior most | 983 tag-set exact-p))) |
971 ;; of the time. (really!) | 984 |
972 ((or (eq the-locale 'global) (eq the-locale 'all)) | 985 ;; end of flets |
973 (selected-device)) | 986 ) |
974 (t nil))) | 987 |
975 (inst (and domain (face-property-instance face 'font domain)))) | 988 ;; the function itself |
976 ;; If it's reasonable to do the inherit-from-standard-face trick, | 989 |
977 ;; and it's called for, then do it now. | 990 (let* ((ffpdev Face-frob-property-device-considered-current) |
978 (if (and | 991 (do-later-stages |
979 face-frob-from-locale-first | 992 (or (global-locale locale) |
980 (eq the-locale 'global) | 993 (valid-specifier-domain-p locale) |
981 domain | 994 (bufferp locale))) |
982 (equal inst (face-property-instance face 'font domain)) | 995 (domain (and do-later-stages |
983 ;; don't do it for standard faces, or you'll get inheritance loops. | 996 (derive-domain-from-locale locale 'window-system |
984 ;; #### This makes XEmacs seg fault! fix this bug. | 997 ffpdev))) |
985 (not (memq (face-name (find-face face)) | 998 (check-differences |
986 '(default bold italic bold-italic))) | 999 (and unfrobbed-face frobbed-face domain |
987 (equal (face-property-instance face 'font domain) | 1000 (not (memq (face-name face) |
988 (face-property-instance unfrobbed-face 'font domain))) | 1001 '(default bold italic bold-italic))))) |
989 (set-face-property face 'font (vector frobbed-face) | 1002 (orig-instance |
990 the-locale tags) | 1003 (and check-differences |
991 ;; and only otherwise try to build new property value artificially | 1004 (face-property-instance face win-prop domain)))) |
992 (funcall tty-thunk) | 1005 |
993 (funcall ws-thunk) | 1006 ;; first do the frobbing |
994 (and | 1007 (setq face (get-face face)) |
995 domain | 1008 (map-over-locales locale) |
996 (equal inst (face-property-instance face 'font domain)) | 1009 |
997 ;; don't do it for standard faces, or you'll get inheritance loops. | 1010 (when do-later-stages |
998 ;; #### This makes XEmacs seg fault! fix this bug. | 1011 |
999 (not (memq (face-name (find-face face)) | 1012 (if (global-locale locale) (setq locale 'global)) |
1000 '(default bold italic bold-italic))) | 1013 |
1001 (equal (face-property-instance face 'font domain) | 1014 ;; now do the second stage -- if there's nothing there, try |
1002 (face-property-instance unfrobbed-face 'font domain)) | 1015 ;; harder to find an instantiator, and frob it. |
1003 (set-face-property face 'font (vector frobbed-face) the-locale tags))))))) | 1016 (let (do-something) |
1017 (loop for prop in (cons win-prop tty-props) | |
1018 for propspec = (get face prop) | |
1019 for devtype-spec = (if (eq prop win-prop) 'window-system 'tty) | |
1020 if propspec | |
1021 do | |
1022 (or (specifier-spec-list propspec locale) | |
1023 (let ((doit (derive-specifier-specs-from-locale | |
1024 propspec locale devtype-spec ffpdev | |
1025 ;; #### does this make sense? When no tags | |
1026 ;; given, frob the whole list of fallbacks when | |
1027 ;; global, else just retrieve a current-device | |
1028 ;; value. this tries to mirror normal practices, | |
1029 ;; where with no tags you want everything frobbed, | |
1030 ;; but with a tag you want only the tag frobbed | |
1031 ;; and hence you probably don't want lots and lots | |
1032 ;; of items there. (#### Perhaps the best way -- | |
1033 ;; or at least a way with some theoretical | |
1034 ;; justifiability -- is to fetch the fallbacks | |
1035 ;; that match the TAG-SET/EXACT-P, and if none, | |
1036 ;; fall back onto doing the selected-device | |
1037 ;; trick.) | |
1038 (and (not tag-set) (not exact-p))))) | |
1039 (if (and (not doit) (eq locale 'global)) | |
1040 (error | |
1041 "No fallback for specifier property %s in face %s???" | |
1042 prop face)) | |
1043 ;; [note 1] whenever we add to a tty property, | |
1044 ;; make sure we tag our additions with `tty' to | |
1045 ;; avoid accidentally messing things up on window | |
1046 ;; systems (e.g. when making things italic we | |
1047 ;; don't want to set the underline property on | |
1048 ;; window systems) | |
1049 (when doit | |
1050 (add-spec-list-to-specifier | |
1051 propspec | |
1052 (list (cons locale | |
1053 (add-tag-to-inst-list | |
1054 doit | |
1055 (append (if (listp tag-set) tag-set | |
1056 (list tag-set)) | |
1057 (if (eq devtype-spec 'tty) '(tty))) | |
1058 )))) | |
1059 (setq do-something t))))) | |
1060 (when do-something | |
1061 (map-over-locales (or (global-locale locale) locale)))) | |
1062 | |
1063 ;; then do the third stage -- check for whether we have to do | |
1064 ;; the inheritance trick. | |
1065 | |
1066 (when (and check-differences | |
1067 (let ((new-instance | |
1068 (face-property-instance face win-prop domain))) | |
1069 (and | |
1070 (equal orig-instance new-instance) | |
1071 (equal orig-instance | |
1072 (face-property-instance unfrobbed-face win-prop | |
1073 domain))))) | |
1074 (set-face-property face win-prop (vector frobbed-face) | |
1075 (or (global-locale locale) locale) tag-set)))))) | |
1004 | 1076 |
1005 ;; WE DEMAND FOUNDRY FROBBING! | 1077 ;; WE DEMAND FOUNDRY FROBBING! |
1006 | 1078 |
1007 ;; Family frobbing | 1079 ;; Family frobbing |
1008 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> | 1080 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> |
1009 ;; Brainlessly derived from make-face-size by Stephen; don't blame Jan. | 1081 ;; Brainlessly derived from make-face-size by Stephen; don't blame Jan. |
1010 ;; I'm long since flown to Rio, it does you little good to blame me, either. | 1082 ;; I'm long since flown to Rio, it does you little good to blame me, either. |
1011 (defun make-face-family (face family &optional locale tags) | 1083 (defun make-face-family (face family &optional locale tags exact-p) |
1012 "Set FACE's family to FAMILY in LOCALE, if possible. | 1084 "Set FACE's family to FAMILY in LOCALE, if possible." |
1013 | 1085 (interactive (list (read-face-name "Set family of which face: ") |
1014 Add/replace settings specified by TAGS only." | 1086 (read-string "Family to set: "))) |
1015 (frob-face-property face 'font | 1087 |
1016 ;; uses dynamic scope of family | 1088 (Face-frob-property face locale tags exact-p |
1017 #'(lambda (f d) | 1089 nil nil 'font nil |
1090 `(lambda (f d) | |
1018 ;; keep the dependency on font.el for now | 1091 ;; keep the dependency on font.el for now |
1019 (let ((fo (font-create-object (font-instance-name f) | 1092 (let ((fo (font-create-object f d))) |
1020 d))) | 1093 (set-font-family fo ,family) |
1021 (set-font-family fo family) | |
1022 (font-create-name fo d))) | 1094 (font-create-name fo d))) |
1023 nil locale tags)) | 1095 nil)) |
1024 | 1096 |
1025 ;; Style (ie, typographical face) frobbing | 1097 ;; Style (ie, typographical face) frobbing |
1026 (defun make-face-bold (face &optional locale tags) | 1098 (defun make-face-bold (face &optional locale tags exact-p) |
1027 "Make FACE bold in LOCALE, if possible. | 1099 "Make FACE bold in LOCALE, if possible. |
1028 This will attempt to make the font bold for X/MSW locales and will set the | 1100 This will attempt to make the font bold for window-system locales and will |
1029 highlight flag for TTY locales. | 1101 set the highlight flag for TTY locales. |
1030 | 1102 |
1031 If LOCALE is nil, omitted, or `all', this will attempt to frob all | 1103 The actual behavior of this function is somewhat messy, in an attempt to |
1032 font specifications for FACE to make them appear bold. Similarly, if | 1104 get more intuitive behavior in quite a lot of different circumstances. (You |
1033 LOCALE is a locale type, this frobs all font specifications for locales | 1105 might view this as indicative of design failures with specifiers, but in |
1034 of that type. If LOCALE is a particular locale, what happens depends on | 1106 fact almost all code that attempts to interface to humans and produce |
1035 what sort of locale is given. If you gave a device, frame, or window, | 1107 \"intuitive\" results gets messy, particularly with a system as complicated |
1036 then it's always possible to determine what the font actually will be, | 1108 as specifiers, whose complexity results from an attempt to work well in |
1037 so this is determined and the resulting font is frobbed and added back as a | 1109 many different circumstances.) |
1038 specification for this locale. If LOCALE is a buffer, however, you can't | 1110 |
1039 determine what the font will actually be unless there's actually a | 1111 The meaning of LOCALE is the same as for `specifier-spec-list', i.e.: |
1040 specification given for that particular buffer (otherwise, it depends | 1112 |
1041 on what window and frame the buffer appears in, and might not even be | 1113 -- If LOCALE is nil, omitted, or `all', this will attempt to \"frob\" all |
1042 well-defined if the buffer appears multiple times in different places); | 1114 font specifications for FACE to make them appear bold (i.e. the |
1043 therefore you will get an error unless there's a specification for the | 1115 specifications are replaced with equivalent specifications, where the |
1044 buffer. | 1116 font names have been changed to the closest bold font). |
1045 | 1117 |
1046 Finally, in some cases (specifically, when LOCALE is not a locale type), | 1118 -- If LOCALE is a locale type \(`buffer', `window', etc.), this frobs all |
1047 if the frobbing didn't actually make the font look any different | 1119 font specifications for locales of that type. |
1048 \(this happens, for example, if your font specification is already bold | 1120 |
1049 or has no bold equivalent), and currently looks like the font of the | 1121 -- If LOCALE is a particular locale, this frobs all font specifications for |
1050 'default face, it is set to inherit from the 'bold face. This is kludgy | 1122 that locale. |
1051 but it makes `make-face-bold' have more intuitive behavior in many | 1123 |
1052 circumstances." | 1124 If TAGS is given, this only processes instantiators whose tag set includes |
1125 all tags mentioned in TAGS. In addition, if EXACT-P is non-nil, only | |
1126 instantiators whose tag set exactly matches TAGS are processed; otherwise, | |
1127 additional tags may be present in the instantiator's tag set. | |
1128 | |
1129 This function proceeeds in three stages. | |
1130 | |
1131 STAGE 1: Frob the settings that are already present. | |
1132 STAGE 2: (if called for) Ensure that *some* setting exists in the locale | |
1133 that was given, finding it in various ways and frobbing it as in | |
1134 stage 1. This ensures that there is an actual setting for | |
1135 the locale, so you will get the expected buffer-local/frame-local | |
1136 behavior -- changes to the global value, to other locales, won't | |
1137 affect this locale, (b) the face will actually look bold in | |
1138 the locale. | |
1139 STAGE 3: (if called for) | |
1140 | |
1141 The way the frobbing works depends on the device type -- first on whether | |
1142 or not it's TTY, and second, if it's a window-system device type, on which | |
1143 particular window-system device type. For locales with a specific device | |
1144 type, we do the frobbing in the context of that device type -- this means | |
1145 that for TTY device types we set the highlight flag, and for window-system | |
1146 device types we modify the font spec according to the rules for font specs | |
1147 of that device type. For global locales, we may process both the highlight | |
1148 flag and the font specs (depending on the device types compiled into this | |
1149 XEmacs). When processing font specs, we check the tag set associated with | |
1150 each font spec to see if it's specific to a particular device type; if so, | |
1151 we frob it in the context of that type, else we use the type of the current | |
1152 device. (A hack, but works well in practice -- and if a new device is | |
1153 created, we will automatically frob all the standard fonts to make sure | |
1154 they display OK on that device.) | |
1155 | |
1156 If LOCALE is not a locale type, and both TAGS and EXACT-P are omitted, we | |
1157 do further frobbing in an attempt to give more intuitive behavior. | |
1158 | |
1159 First, if there are no specifications in LOCALE (if LOCALE is `all', we act | |
1160 as if it were `global' for this step), we do our utmost to put a | |
1161 specification there; otherwise, this function will have no effect. For | |
1162 device, frame, or window locales, the face's font is instantiated using the | |
1163 locale as a domain, and the resulting font is frobbed and added back as a | |
1164 specification for this locale. If LOCALE is `global', we retrieve the | |
1165 fallback specs and frob them. If LOCALE is a buffer, things get tricky | |
1166 since you can't instantiate a specifier in a buffer domain \(the buffer can | |
1167 appear in multiple places, or in different places over time, so this | |
1168 operation is not well-defined). We used to signal an error in this case, | |
1169 but now we instead try to do something logical so that we work somewhat | |
1170 similarly to buffer-local variables. Specifically, we use | |
1171 `get-buffer-window' to find a window viewing the buffer, and if there is | |
1172 one, use this as a domain to instantiate the font, and frob the resulting | |
1173 value. Otherwise, we use the selected window for the same purpose. | |
1174 | |
1175 Finally, if the frobbing didn't actually make the font look any different | |
1176 in whatever domain we instantiated the font in (this happens, for example, | |
1177 if your font specification is already bold or has no bold equivalent; note | |
1178 that in this step, we use the selected device in place of `global' or `all' | |
1179 -- another hack, but works well in practice since there's usually only one | |
1180 device), and the font currently looks like the font of the `default' face, | |
1181 it is set to inherit from the `bold' face. | |
1182 | |
1183 NOTE: For the other functions defined below, the identity of these two | |
1184 standard faces mentioned in the previous paragraph, and the TTY properties | |
1185 that are modified, may be different, and whether the TTY property or | |
1186 properties are set or unset may be different. For example, for | |
1187 `make-face-unitalic', the last sentence in the previous paragraph would | |
1188 read \"... and the font currently looks like the font of the `italic' face, | |
1189 it is set to inherit from the `default' face.\", and the second sentence in | |
1190 the first paragraph would read \"This will attempt to make the font | |
1191 non-italic for window-system locales and will unset the underline flag for | |
1192 TTY locales.\" | |
1193 | |
1194 Here's a table indicating the behavior differences with the different | |
1195 functions: | |
1196 | |
1197 function face1 face2 tty-props tty-val | |
1198 ---------------------------------------------------------------------------- | |
1199 make-face-bold default bold highlight t | |
1200 make-face-italic default italic underline t | |
1201 make-face-bold-italic default bold-italic highlight,underline t | |
1202 make-face-unbold bold default highlight nil | |
1203 make-face-unitalic italic default underline nil | |
1204 " | |
1053 (interactive (list (read-face-name "Make which face bold: "))) | 1205 (interactive (list (read-face-name "Make which face bold: "))) |
1054 (frob-face-font-2 | 1206 (Face-frob-property face locale tags exact-p |
1055 face locale tags 'default 'bold | 1207 'default 'bold 'font '(highlight) |
1056 (lambda () | 1208 '(tty (lambda (x) t) |
1057 ;; handle TTY specific entries | 1209 x x-make-font-bold |
1058 (when (featurep 'tty) | 1210 gtk gtk-make-font-bold |
1059 (set-face-highlight-p face t locale (cons 'tty tags)))) | 1211 mswindows mswindows-make-font-bold |
1060 (lambda () | 1212 msprinter mswindows-make-font-bold) |
1061 ;; handle window-system specific entries | 1213 '(([default] . [bold]) |
1062 (when (featurep 'gtk) | 1214 ([bold] . t) |
1063 (frob-face-property face 'font 'gtk-make-font-bold | 1215 ([italic] . [bold-italic]) |
1064 '(gtk) locale tags)) | 1216 ([bold-italic] . t)))) |
1065 (when (featurep 'x) | 1217 |
1066 (frob-face-property face 'font 'x-make-font-bold | 1218 (defun make-face-italic (face &optional locale tags exact-p) |
1067 '(x) locale tags)) | |
1068 (when (featurep 'mswindows) | |
1069 (frob-face-property face 'font 'mswindows-make-font-bold | |
1070 '(mswindows) locale tags) | |
1071 (frob-face-property face 'font 'mswindows-make-font-bold | |
1072 '(msprinter) locale tags)) | |
1073 ) | |
1074 '(([default] . [bold]) | |
1075 ([bold] . t) | |
1076 ([italic] . [bold-italic]) | |
1077 ([bold-italic] . t)))) | |
1078 | |
1079 (defun make-face-italic (face &optional locale tags) | |
1080 "Make FACE italic in LOCALE, if possible. | 1219 "Make FACE italic in LOCALE, if possible. |
1081 This will attempt to make the font italic for X/MS Windows locales and | 1220 This will attempt to make the font italic for X/MS Windows locales and |
1082 will set the underline flag for TTY locales. See `make-face-bold' for | 1221 will set the underline flag for TTY locales. See `make-face-bold' for |
1083 the semantics of the LOCALE argument and for more specifics on exactly | 1222 the semantics of the LOCALE argument and for more specifics on exactly |
1084 how this function works." | 1223 how this function works." |
1085 (interactive (list (read-face-name "Make which face italic: "))) | 1224 (interactive (list (read-face-name "Make which face italic: "))) |
1086 (frob-face-font-2 | 1225 (Face-frob-property face locale tags exact-p |
1087 face locale tags 'default 'italic | 1226 'default 'italic 'font '(underline) |
1088 (lambda () | 1227 '(tty (lambda (x) t) |
1089 ;; handle TTY specific entries | 1228 x x-make-font-italic |
1090 (when (featurep 'tty) | 1229 gtk gtk-make-font-italic |
1091 (set-face-underline-p face t locale (cons 'tty tags)))) | 1230 mswindows mswindows-make-font-italic |
1092 (lambda () | 1231 msprinter mswindows-make-font-italic) |
1093 ;; handle window-system specific entries | 1232 '(([default] . [italic]) |
1094 (when (featurep 'gtk) | 1233 ([bold] . [bold-italic]) |
1095 (frob-face-property face 'font 'gtk-make-font-italic | 1234 ([italic] . t) |
1096 '(gtk) locale tags)) | 1235 ([bold-italic] . t)))) |
1097 (when (featurep 'x) | 1236 |
1098 (frob-face-property face 'font 'x-make-font-italic | 1237 (defun make-face-bold-italic (face &optional locale tags exact-p) |
1099 '(x) locale tags)) | |
1100 (when (featurep 'mswindows) | |
1101 (frob-face-property face 'font 'mswindows-make-font-italic | |
1102 '(mswindows) locale tags) | |
1103 (frob-face-property face 'font 'mswindows-make-font-italic | |
1104 '(msprinter) locale tags)) | |
1105 ) | |
1106 '(([default] . [italic]) | |
1107 ([bold] . [bold-italic]) | |
1108 ([italic] . t) | |
1109 ([bold-italic] . t)))) | |
1110 | |
1111 (defun make-face-bold-italic (face &optional locale tags) | |
1112 "Make FACE bold and italic in LOCALE, if possible. | 1238 "Make FACE bold and italic in LOCALE, if possible. |
1113 This will attempt to make the font bold-italic for X/MS Windows | 1239 This will attempt to make the font bold-italic for X/MS Windows |
1114 locales and will set the highlight and underline flags for TTY | 1240 locales and will set the highlight and underline flags for TTY |
1115 locales. See `make-face-bold' for the semantics of the LOCALE | 1241 locales. See `make-face-bold' for the semantics of the LOCALE |
1116 argument and for more specifics on exactly how this function works." | 1242 argument and for more specifics on exactly how this function works." |
1117 (interactive (list (read-face-name "Make which face bold-italic: "))) | 1243 (interactive (list (read-face-name "Make which face bold-italic: "))) |
1118 (frob-face-font-2 | 1244 (Face-frob-property face locale tags exact-p |
1119 face locale tags 'default 'bold-italic | 1245 'default 'bold-italic 'font '(underline highlight) |
1120 (lambda () | 1246 '(tty (lambda (x) t) |
1121 ;; handle TTY specific entries | 1247 x x-make-font-bold-italic |
1122 (when (featurep 'tty) | 1248 gtk gtk-make-font-bold-italic |
1123 (set-face-highlight-p face t locale (cons 'tty tags)) | 1249 mswindows mswindows-make-font-bold-italic |
1124 (set-face-underline-p face t locale (cons 'tty tags)))) | 1250 msprinter mswindows-make-font-bold-italic) |
1125 (lambda () | 1251 '(([default] . [italic]) |
1126 ;; handle window-system specific entries | 1252 ([bold] . [bold-italic]) |
1127 (when (featurep 'gtk) | 1253 ([italic] . [bold-italic]) |
1128 (frob-face-property face 'font 'gtk-make-font-bold-italic | 1254 ([bold-italic] . t)))) |
1129 '(gtk) locale tags)) | 1255 |
1130 (when (featurep 'x) | 1256 |
1131 (frob-face-property face 'font 'x-make-font-bold-italic | 1257 (defun make-face-unbold (face &optional locale tags exact-p) |
1132 '(x) locale tags)) | |
1133 (when (featurep 'mswindows) | |
1134 (frob-face-property face 'font 'mswindows-make-font-bold-italic | |
1135 '(mswindows) locale tags) | |
1136 (frob-face-property face 'font 'mswindows-make-font-bold-italic | |
1137 '(msprinter) locale tags)) | |
1138 ) | |
1139 '(([default] . [italic]) | |
1140 ([bold] . [bold-italic]) | |
1141 ([italic] . [bold-italic]) | |
1142 ([bold-italic] . t)))) | |
1143 | |
1144 (defun make-face-unbold (face &optional locale tags) | |
1145 "Make FACE non-bold in LOCALE, if possible. | 1258 "Make FACE non-bold in LOCALE, if possible. |
1146 This will attempt to make the font non-bold for X/MS Windows locales | 1259 This will attempt to make the font non-bold for X/MS Windows locales |
1147 and will unset the highlight flag for TTY locales. See | 1260 and will unset the highlight flag for TTY locales. See |
1148 `make-face-bold' for the semantics of the LOCALE argument and for more | 1261 `make-face-bold' for the semantics of the LOCALE argument and for more |
1149 specifics on exactly how this function works." | 1262 specifics on exactly how this function works." |
1150 (interactive (list (read-face-name "Make which face non-bold: "))) | 1263 (interactive (list (read-face-name "Make which face non-bold: "))) |
1151 (frob-face-font-2 | 1264 (Face-frob-property face locale tags exact-p |
1152 face locale tags 'bold 'default | 1265 'bold 'default 'font '(highlight) |
1153 (lambda () | 1266 '(tty (lambda (x) nil) |
1154 ;; handle TTY specific entries | 1267 x x-make-font-unbold |
1155 (when (featurep 'tty) | 1268 gtk gtk-make-font-unbold |
1156 (set-face-highlight-p face nil locale (cons 'tty tags)))) | 1269 mswindows mswindows-make-font-unbold |
1157 (lambda () | 1270 msprinter mswindows-make-font-unbold) |
1158 ;; handle window-system specific entries | 1271 '(([default] . t) |
1159 (when (featurep 'gtk) | 1272 ([bold] . [default]) |
1160 (frob-face-property face 'font 'gtk-make-font-unbold | 1273 ([italic] . t) |
1161 '(gtk) locale tags)) | 1274 ([bold-italic] . [italic])))) |
1162 (when (featurep 'x) | 1275 |
1163 (frob-face-property face 'font 'x-make-font-unbold | 1276 (defun make-face-unitalic (face &optional locale tags exact-p) |
1164 '(x) locale tags)) | |
1165 (when (featurep 'mswindows) | |
1166 (frob-face-property face 'font 'mswindows-make-font-unbold | |
1167 '(mswindows) locale tags) | |
1168 (frob-face-property face 'font 'mswindows-make-font-unbold | |
1169 '(msprinter) locale tags)) | |
1170 ) | |
1171 '(([default] . t) | |
1172 ([bold] . [default]) | |
1173 ([italic] . t) | |
1174 ([bold-italic] . [italic])))) | |
1175 | |
1176 (defun make-face-unitalic (face &optional locale tags) | |
1177 "Make FACE non-italic in LOCALE, if possible. | 1277 "Make FACE non-italic in LOCALE, if possible. |
1178 This will attempt to make the font non-italic for X/MS Windows locales | 1278 This will attempt to make the font non-italic for X/MS Windows locales |
1179 and will unset the underline flag for TTY locales. See | 1279 and will unset the underline flag for TTY locales. See |
1180 `make-face-bold' for the semantics of the LOCALE argument and for more | 1280 `make-face-bold' for the semantics of the LOCALE argument and for more |
1181 specifics on exactly how this function works." | 1281 specifics on exactly how this function works." |
1182 (interactive (list (read-face-name "Make which face non-italic: "))) | 1282 (interactive (list (read-face-name "Make which face non-italic: "))) |
1183 (frob-face-font-2 | 1283 (Face-frob-property face locale tags exact-p |
1184 face locale tags 'italic 'default | 1284 'italic 'default 'font '(underline) |
1185 (lambda () | 1285 '(tty (lambda (x) nil) |
1186 ;; handle TTY specific entries | 1286 x x-make-font-unitalic |
1187 (when (featurep 'tty) | 1287 gtk gtk-make-font-unitalic |
1188 (set-face-underline-p face nil locale (cons 'tty tags)))) | 1288 mswindows mswindows-make-font-unitalic |
1189 (lambda () | 1289 msprinter mswindows-make-font-unitalic) |
1190 ;; handle window-system specific entries | 1290 '(([default] . t) |
1191 (when (featurep 'gtk) | 1291 ([bold] . t) |
1192 (frob-face-property face 'font 'gtk-make-font-unitalic | 1292 ([italic] . [default]) |
1193 '(gtk) locale tags)) | 1293 ([bold-italic] . [bold])))) |
1194 (when (featurep 'x) | |
1195 (frob-face-property face 'font 'x-make-font-unitalic | |
1196 '(x) locale tags)) | |
1197 (when (featurep 'mswindows) | |
1198 (frob-face-property face 'font 'mswindows-make-font-unitalic | |
1199 '(mswindows) locale tags) | |
1200 (frob-face-property face 'font 'mswindows-make-font-unitalic | |
1201 '(msprinter) locale tags)) | |
1202 ) | |
1203 '(([default] . t) | |
1204 ([bold] . t) | |
1205 ([italic] . [default]) | |
1206 ([bold-italic] . [bold])))) | |
1207 | 1294 |
1208 | 1295 |
1209 ;; Size frobbing | 1296 ;; Size frobbing |
1210 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> | 1297 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> |
1211 ;; Jan had a separate helper function | 1298 ;; Jan had a separate helper function |
1212 (defun make-face-size (face size &optional locale tags) | 1299 (defun make-face-size (face size &optional locale tags exact-p) |
1213 "Adjust FACE to SIZE in LOCALE, if possible. | 1300 "Adjust FACE to SIZE in LOCALE, if possible." |
1214 | 1301 (interactive (list (read-face-name "Set size of which face: ") |
1215 Add/replace settings specified by TAGS only." | 1302 (read-number "Size to set: " t 10))) |
1216 (frob-face-property face 'font | 1303 (Face-frob-property face locale tags exact-p |
1217 ;; uses dynamic scope of size | 1304 nil nil 'font nil |
1218 #'(lambda (f d) | 1305 `(lambda (f d) |
1219 ;; keep the dependency on font.el for now | 1306 ;; keep the dependency on font.el for now |
1220 (let ((fo (font-create-object (font-instance-name f) | 1307 (let ((fo (font-create-object f d))) |
1221 d))) | 1308 (set-font-size fo ,size) |
1222 (set-font-size fo size) | 1309 (font-create-name fo d))) |
1223 (font-create-name fo d))) | 1310 nil)) |
1224 nil locale tags)) | |
1225 | 1311 |
1226 ;; Why do the following two functions lose so badly in so many | 1312 ;; Why do the following two functions lose so badly in so many |
1227 ;; circumstances? | 1313 ;; circumstances? |
1228 | 1314 |
1229 (defun make-face-smaller (face &optional locale) | 1315 (defun make-face-smaller (face &optional locale tags exact-p) |
1230 "Make the font of FACE be smaller, if possible. | 1316 "Make the font of FACE be smaller, if possible. |
1231 LOCALE works as in `make-face-bold' et al., but the ``inheriting- | 1317 LOCALE works as in `make-face-bold' et al., but the ``inheriting- |
1232 from-the-bold-face'' operations described there are not done | 1318 from-the-bold-face'' operations described there are not done |
1233 because they don't make sense in this context." | 1319 because they don't make sense in this context." |
1234 (interactive (list (read-face-name "Shrink which face: "))) | 1320 (interactive (list (read-face-name "Shrink which face: "))) |
1235 ;; handle X specific entries | 1321 (Face-frob-property face locale tags exact-p |
1236 (when (featurep 'x) | 1322 nil nil 'font nil |
1237 (frob-face-property face 'font 'x-find-smaller-font | 1323 '(x x-find-smaller-font |
1238 '(x) locale)) | 1324 gtk gtk-find-smaller-font |
1239 (when (featurep 'mswindows) | 1325 mswindows mswindows-find-smaller-font |
1240 (frob-face-property face 'font 'mswindows-find-smaller-font | 1326 msprinter mswindows-find-smaller-font) |
1241 '(mswindows) locale) | 1327 nil)) |
1242 (frob-face-property face 'font 'mswindows-find-smaller-font | 1328 |
1243 '(msprinter) locale))) | 1329 (defun make-face-larger (face &optional locale tags exact-p) |
1244 | |
1245 (defun make-face-larger (face &optional locale) | |
1246 "Make the font of FACE be larger, if possible. | 1330 "Make the font of FACE be larger, if possible. |
1247 See `make-face-smaller' for the semantics of the LOCALE argument." | 1331 See `make-face-smaller' for the semantics of the LOCALE argument." |
1248 (interactive (list (read-face-name "Enlarge which face: "))) | 1332 (interactive (list (read-face-name "Enlarge which face: "))) |
1249 ;; handle X specific entries | 1333 (Face-frob-property face locale tags exact-p |
1250 (when (featurep 'x) | 1334 nil nil 'font nil |
1251 (frob-face-property face 'font 'x-find-larger-font | 1335 '(x x-find-larger-font |
1252 '(x) locale)) | 1336 gtk gtk-find-larger-font |
1253 (when (featurep 'mswindows) | 1337 mswindows mswindows-find-larger-font |
1254 (frob-face-property face 'font 'mswindows-find-larger-font | 1338 msprinter mswindows-find-larger-font) |
1255 '(mswindows) locale) | 1339 nil)) |
1256 (frob-face-property face 'font 'mswindows-find-larger-font | |
1257 '(msprinter) locale))) | |
1258 | 1340 |
1259 (defun invert-face (face &optional locale) | 1341 (defun invert-face (face &optional locale) |
1260 "Swap the foreground and background colors of the face." | 1342 "Swap the foreground and background colors of the face." |
1261 (interactive (list (read-face-name "Invert face: "))) | 1343 (interactive (list (read-face-name "Invert face: "))) |
1262 (if (valid-specifier-domain-p locale) | 1344 (if (valid-specifier-domain-p locale) |
1318 (let* ((color-instance (face-background-instance 'default frame)) | 1400 (let* ((color-instance (face-background-instance 'default frame)) |
1319 (mode (condition-case nil | 1401 (mode (condition-case nil |
1320 (if (< (apply '+ (color-instance-rgb-components | 1402 (if (< (apply '+ (color-instance-rgb-components |
1321 color-instance)) 65536) | 1403 color-instance)) 65536) |
1322 'dark 'light) | 1404 'dark 'light) |
1323 ;; Here, we get an error on a TTY. As we don't have | 1405 ;; Here, we get an error on a TTY (Return value from |
1324 ;; a good way of detecting whether a TTY is light or | 1406 ;; color-instance-rgb-components is nil), and on the |
1325 ;; dark, we'll guess it's dark. | 1407 ;; initial stream device (Return value from |
1408 ;; face-background-instance is nil). As we don't have a | |
1409 ;; good way of detecting whether a TTY is light or dark, | |
1410 ;; we'll guess it's dark. | |
1326 (error 'dark)))) | 1411 (error 'dark)))) |
1327 (set-frame-property frame 'background-mode mode) | 1412 (set-frame-property frame 'background-mode mode) |
1328 mode)) | 1413 mode)) |
1329 | 1414 |
1330 (defun extract-custom-frame-properties (frame) | 1415 (defun extract-custom-frame-properties (frame) |
1585 ((eq 'mswindows (frame-type frame)) | 1670 ((eq 'mswindows (frame-type frame)) |
1586 (declare-fboundp (mswindows-init-frame-faces frame))) | 1671 (declare-fboundp (mswindows-init-frame-faces frame))) |
1587 ;; Is there anything which should be done for TTY's? | 1672 ;; Is there anything which should be done for TTY's? |
1588 ))) | 1673 ))) |
1589 | 1674 |
1590 ;; #### This is somewhat X-specific, and is called when the first | 1675 ;; Called when the first device created. |
1591 ;; X device is created (even if there were TTY devices created | 1676 |
1592 ;; beforehand). The concept of resources has not been generalized | 1677 (defun init-global-faces (device) |
1593 ;; outside of X-specificness, so we have to live with this | 1678 (let ((Face-frob-property-device-considered-current device)) |
1594 ;; breach of device-independence. | 1679 ;; Look for global face resources. |
1595 | 1680 (loop for face in (face-list) do |
1596 (defun init-global-faces () | 1681 (init-face-from-resources face 'global)) |
1597 ;; Look for global face resources. | 1682 ;; Further frobbing. |
1598 (loop for face in (face-list) do | 1683 (and (featurep 'x) (declare-fboundp (x-init-global-faces))) |
1599 (init-face-from-resources face 'global)) | 1684 (and (featurep 'gtk) (declare-fboundp (gtk-init-global-faces))) |
1600 ;; Further X frobbing. | 1685 (and (featurep 'mswindows) (declare-fboundp (mswindows-init-global-faces))) |
1601 (and (featurep 'x) (declare-fboundp (x-init-global-faces))) | 1686 |
1602 (and (featurep 'gtk) (declare-fboundp (gtk-init-global-faces))) | 1687 ;; for bold and the like, make the global specification be bold etc. |
1603 (and (featurep 'mswindows) (declare-fboundp (mswindows-init-global-faces))) | 1688 ;; if the user didn't already specify a value. These will also be |
1604 | 1689 ;; frobbed further in init-other-random-faces. |
1605 ;; for bold and the like, make the global specification be bold etc. | 1690 (unless (face-font 'bold 'global) |
1606 ;; if the user didn't already specify a value. These will also be | 1691 (make-face-bold 'bold 'global)) |
1607 ;; frobbed further in init-other-random-faces. | 1692 ;; |
1608 (unless (face-font 'bold 'global) | 1693 (unless (face-font 'italic 'global) |
1609 (make-face-bold 'bold 'global)) | 1694 (make-face-italic 'italic 'global)) |
1610 ;; | 1695 ;; |
1611 (unless (face-font 'italic 'global) | |
1612 (make-face-italic 'italic 'global)) | |
1613 ;; | |
1614 (unless (face-font 'bold-italic 'global) | |
1615 (make-face-bold-italic 'bold-italic 'global) | |
1616 (unless (face-font 'bold-italic 'global) | 1696 (unless (face-font 'bold-italic 'global) |
1617 (copy-face 'bold 'bold-italic) | 1697 (make-face-bold-italic 'bold-italic 'global) |
1618 (make-face-italic 'bold-italic))) | 1698 (unless (face-font 'bold-italic 'global) |
1619 | 1699 (copy-face 'bold 'bold-italic) |
1620 (when (face-equal 'bold 'bold-italic) | 1700 (make-face-italic 'bold-italic))) |
1621 (copy-face 'italic 'bold-italic) | 1701 |
1622 (make-face-bold 'bold-italic)) | 1702 (when (face-equal 'bold 'bold-italic device) |
1623 ;; | 1703 (copy-face 'italic 'bold-italic) |
1624 ;; Nothing more to be done for X or TTY's? | 1704 (make-face-bold 'bold-italic)))) |
1625 ) | |
1626 | 1705 |
1627 | 1706 |
1628 ;; These warnings are there for a reason. Just specify your fonts | 1707 ;; These warnings are there for a reason. Just specify your fonts |
1629 ;; correctly. Deal with it. Additionally, one can use | 1708 ;; correctly. Deal with it. Additionally, one can use |
1630 ;; `log-warning-minimum-level' instead of this. | 1709 ;; `log-warning-minimum-level' instead of this. |