annotate lisp/x-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 2b676dc88c66
children 491f8cf78a9c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; x-faces.el --- X-specific face frobnication, aka black magic.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
4 ;; Copyright (C) 1995, 1996, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Author: Jamie Zawinski <jwz@jwz.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: extensions, internal, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Synched up with: Not synched.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; This file is dumped with XEmacs (when X support is compiled in).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; Modified by: Chuck Thompson
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; Modified by: Ben Wing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; Modified by: Martin Buchholz
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; This file does the magic to parse X font names, and make sure that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; default and modeline attributes of new frames are specified enough.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; The resource-manager syntax for faces is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; Emacs.bold.attributeFont: font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; Emacs.bold.attributeForeground: fg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; Emacs.bold.attributeBackground: bg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; Emacs.bold.attributeBackgroundPixmap: file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;; Emacs.bold.attributeUnderline: true/false
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; Emacs.bold.attributeStrikethru: true/false
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; You can specify the properties of a face on a per-frame basis. For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; example, to have the "isearch" face use a red foreground on frames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; named "emacs" (the default) but use a blue foreground on frames that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; you create named "debugger", you could do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;; Emacs*emacs.isearch.attributeForeground: red
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; Emacs*debugger.isearch.attributeForeground: blue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; Generally things that make faces won't set any of the face attributes if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; you have already given them values via the resource database. You can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; also change this stuff from your .emacs file, by using the functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; set-face-foreground, set-face-font, etc. See the code in this file, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; in faces.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
65 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
66 '(x-get-resource-and-maybe-bogosity-check
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
67 x-get-resource x-init-pointer-shape))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
68
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (defconst x-font-regexp nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (defconst x-font-regexp-head nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (defconst x-font-regexp-head-2 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (defconst x-font-regexp-weight nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (defconst x-font-regexp-slant nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 (defconst x-font-regexp-pixel nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (defconst x-font-regexp-point nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (defconst x-font-regexp-foundry-and-family nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (defconst x-font-regexp-registry-and-encoding nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (defconst x-font-regexp-spacing nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;;; Regexps matching font names in "Host Portable Character Representation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (let ((- "[-?]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (foundry "[^-]*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (family "[^-]*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 (weight "\\(bold\\|demibold\\|medium\\|black\\)") ; 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (weight\? "\\([^-]*\\)") ; 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (slant "\\([ior]\\)") ; 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ; (slant\? "\\([ior?*]?\\)") ; 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (slant\? "\\([^-]?\\)") ; 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (swidth "\\([^-]*\\)") ; 3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (adstyle "\\([^-]*\\)") ; 4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (pixelsize "\\(\\*\\|[0-9]+\\)") ; 5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (pointsize "\\(\\*\\|0\\|[0-9][0-9]+\\)") ; 6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 ; (resx "\\(\\*\\|[0-9][0-9]+\\)") ; 7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 ; (resy "\\(\\*\\|[0-9][0-9]+\\)") ; 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (resx "\\([*0]\\|[0-9][0-9]+\\)") ; 7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (resy "\\([*0]\\|[0-9][0-9]+\\)") ; 8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (spacing "[cmp?*]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (avgwidth "\\(\\*\\|[0-9]+\\)") ; 9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (registry "[^-]*") ; some fonts have omitted registries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 ; (encoding ".+") ; note that encoding may contain "-"...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (encoding "[^-]+") ; false!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (setq x-font-regexp
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
108 (concat "\\`\\*?[-?*]"
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
109 foundry - family - weight\? - slant\? - swidth - adstyle -
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
110 pixelsize - pointsize - resx - resy - spacing - avgwidth -
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
111 registry - encoding "\\'"
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
112 ))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (setq x-font-regexp-head
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
114 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
115 "\\([-*?]\\|\\'\\)"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (setq x-font-regexp-head-2
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
117 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
118 - swidth - adstyle - pixelsize - pointsize
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
119 "\\([-*?]\\|\\'\\)"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
120 (setq x-font-regexp-slant (concat - slant -))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
121 (setq x-font-regexp-weight (concat - weight -))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ;; if we can't match any of the more specific regexps (unfortunate) then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 ;; look for digits; assume 2+ digits is 10ths of points, and 1-2 digits
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 ;; is pixels. Bogus as hell.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
125 (setq x-font-regexp-pixel "[-?*]\\([0-9][0-9]?\\)[-?*]")
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
126 (setq x-font-regexp-point "[-?*]\\([0-9][0-9]+\\)[-?*]")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 ;; the following two are used by x-font-menu.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 (setq x-font-regexp-foundry-and-family
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
129 (concat "\\`[-?*]" foundry - "\\(" family "\\)" -))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (setq x-font-regexp-registry-and-encoding
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
131 (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (setq x-font-regexp-spacing
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
133 (concat - "\\(" spacing "\\)" - avgwidth
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
134 - registry - encoding "\\'"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 ;; A "loser font" is something like "8x13" -> "8x13bold".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 ;; These are supported only through extreme generosity.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
139 (defconst x-loser-font-regexp "\\`[0-9]+x[0-9]+\\'")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (defun x-frob-font-weight (font which)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (if (font-instance-p font) (setq font (font-instance-name font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 (cond ((null font) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 ((or (string-match x-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (string-match x-font-regexp-head font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (string-match x-font-regexp-weight font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (concat (substring font 0 (match-beginning 1)) which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 (substring font (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 ((string-match x-loser-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (concat font which))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (defun x-frob-font-slant (font which)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (if (font-instance-p font) (setq font (font-instance-name font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (cond ((null font) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 ((or (string-match x-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (string-match x-font-regexp-head font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (concat (substring font 0 (match-beginning 2)) which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (substring font (match-end 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 ((string-match x-font-regexp-slant font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (concat (substring font 0 (match-beginning 1)) which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (substring font (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 ((string-match x-loser-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (concat font which))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (defun x-make-font-bold (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 "Given an X font specification, this attempts to make a `bold' font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 ;; Certain Type1 fonts know "bold" as "black"...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (or (try-font-name (x-frob-font-weight font "bold") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (try-font-name (x-frob-font-weight font "black") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (try-font-name (x-frob-font-weight font "demibold") device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (defun x-make-font-unbold (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 "Given an X font specification, this attempts to make a non-bold font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (try-font-name (x-frob-font-weight font "medium") device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (defcustom try-oblique-before-italic-fonts nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 "*If nil, italic fonts are searched before oblique fonts.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 If non-nil, oblique fonts are tried before italic fonts. This is mostly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 applicable to adobe-courier fonts"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 :group 'x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (define-obsolete-variable-alias '*try-oblique-before-italic-fonts*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 'try-oblique-before-italic-fonts)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (defun x-make-font-italic (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 "Given an X font specification, this attempts to make an `italic' font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (if try-oblique-before-italic-fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (or (try-font-name (x-frob-font-slant font "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (try-font-name (x-frob-font-slant font "i") device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (or (try-font-name (x-frob-font-slant font "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (try-font-name (x-frob-font-slant font "o") device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (defun x-make-font-unitalic (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 "Given an X font specification, this attempts to make a non-italic font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (try-font-name (x-frob-font-slant font "r") device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (defun x-make-font-bold-italic (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 "Given an X font specification, this attempts to make a `bold-italic' font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 If it fails, it returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 ;; This is haired up to avoid loading the "intermediate" fonts.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
207 (if try-oblique-before-italic-fonts
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (or (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 (x-frob-font-slant (x-frob-font-weight font "bold") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (x-frob-font-slant (x-frob-font-weight font "bold") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (x-frob-font-slant (x-frob-font-weight font "black") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (x-frob-font-slant (x-frob-font-weight font "black") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (or (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (x-frob-font-slant (x-frob-font-weight font "bold") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (x-frob-font-slant (x-frob-font-weight font "bold") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (x-frob-font-slant (x-frob-font-weight font "black") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (x-frob-font-slant (x-frob-font-weight font "black") "o") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 (try-font-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (defun x-font-size (font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 "Return the nominal size of the given font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 This is done by parsing its name, so it's likely to lose.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 X fonts can be specified (by the user) in either pixels or 10ths of points,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 and this returns the first one it finds, so you have to decide which units
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 the returned value is measured in yourself..."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (if (font-instance-p font) (setq font (font-instance-name font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (cond ((or (string-match x-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (string-match x-font-regexp-head-2 font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (string-to-int (substring font (match-beginning 6) (match-end 6))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 ((or (string-match x-font-regexp-pixel font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (string-match x-font-regexp-point font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (string-to-int (substring font (match-beginning 1) (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 ;; Given a font name, this function returns a list describing all fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 ;; of all sizes that otherwise match the given font spec. Each element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 ;; in the list is a list of three items: the pixel size of the font,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 ;; the point size (in 1/10ths of a point) of the font, and the fully-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 ;; qualified font name. The first two values may be zero; this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 ;; refers to a scalable font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (defun x-available-font-sizes (font device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (if (font-instance-p font) (setq font (font-instance-name font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (cond ((string-match x-font-regexp font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 ;; turn pixelsize, pointsize, and avgwidth into wildcards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (setq font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (concat (substring font 0 (match-beginning 5)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (substring font (match-end 5) (match-beginning 6)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (substring font (match-end 6) (match-beginning 9)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (substring font (match-end 9) (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 ((string-match x-font-regexp-head-2 font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 ;; turn pixelsize and pointsize into wildcards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (setq font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (concat (substring font 0 (match-beginning 5)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (substring font (match-end 5) (match-beginning 6)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (substring font (match-end 6) (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ((string-match "[-?*]\\([0-9]+\\)[-?*]" font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 ;; Turn the first integer we match into a wildcard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 ;; This is pretty dubious...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (setq font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (concat (substring font 0 (match-beginning 1)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (substring font (match-end 1) (match-end 0))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (sort
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (delq nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (mapcar (function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (lambda (name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (and (string-match x-font-regexp name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (string-to-int (substring name (match-beginning 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (match-end 5)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (string-to-int (substring name (match-beginning 6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (match-end 6)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (list-fonts font device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (function (lambda (x y) (if (= (nth 1 x) (nth 1 y))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (< (nth 0 x) (nth 0 y))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (< (nth 1 x) (nth 1 y)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 ;; Given a font name, this attempts to construct a valid font name for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 ;; DEVICE whose size is the next smaller (if UP-P is nil) or larger
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 ;; (if UP-P is t) size and whose other characteristics are the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 ;; as the given font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (defun x-frob-font-size (font up-p device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (if (stringp font) (setq font (make-font-instance font device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (if (font-instance-p font) (setq font (font-instance-truename font)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (let ((available (and font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (x-available-font-sizes font device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 ((null available) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 ((or (= 0 (nth 0 (car available)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (= 0 (nth 1 (car available))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 ;; R5 scalable fonts: change size by 1 point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 ;; If they're scalable the first font will have pixel or point = 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 ;; Sometimes one is 0 and the other isn't (if it's a bitmap font that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 ;; can be scaled), sometimes both are (if it's a true outline font).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (let ((name (nth 2 (car available)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 old-size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (or (string-match x-font-regexp font) (error "can't parse %S" font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (setq old-size (string-to-int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (substring font (match-beginning 6) (match-end 6))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (or (> old-size 0) (error "font truename has 0 pointsize?"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (or (string-match x-font-regexp name) (error "can't parse %S" name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 ;; turn pixelsize into a wildcard, and make pointsize be +/- 10,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 ;; which is +/- 1 point. All other fields stay the same as they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 ;; were in the "template" font returned by x-available-font-sizes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 ;; #### But this might return the same font: for example, if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 ;; truename of "-*-courier-medium-r-normal--*-230-75-75-m-0-*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 ;; is "...-240-..." (instead of 230) then this loses, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 ;; the 230 that was passed in as an arg got turned into 240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 ;; by the call to font-instance-truename; then we decrement that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 ;; by 10 and return the result which is the same. I think the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 ;; way to fix this is to make this be a loop that keeps trying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 ;; progressively larger pointsize deltas until it finds one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 ;; whose truename differs. Have to be careful to avoid infinite
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 ;; loops at the upper end...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (concat (substring name 0 (match-beginning 5)) "*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (substring name (match-end 5) (match-beginning 6))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 (int-to-string (+ old-size (if up-p 10 -10)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (substring name (match-end 6) (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 ;; non-scalable fonts: take the next available size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (let ((rest available)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (last nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (while rest
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 502
diff changeset
342 (cond ((and (not up-p) (equalp font (nth 2 (car rest))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (setq result last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 rest nil))
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 502
diff changeset
345 ((and up-p (equalp font (and last (nth 2 last))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 (setq result (car rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 rest nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (setq last (car rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (setq rest (cdr rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (nth 2 result))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (defun x-find-smaller-font (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 "Load a new, slightly smaller version of the given font (or font name).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 Returns the font if it succeeds, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 If scalable fonts are available, this returns a font which is 1 point smaller.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 Otherwise, it returns the next smaller version of this font that is defined."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (x-frob-font-size font nil device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (defun x-find-larger-font (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 "Load a new, slightly larger version of the given font (or font name).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 Returns the font if it succeeds, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 If scalable fonts are available, this returns a font which is 1 point larger.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 Otherwise, it returns the next larger version of this font that is defined."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (x-frob-font-size font t device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (defalias 'x-make-face-bold 'make-face-bold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (defalias 'x-make-face-italic 'make-face-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (defalias 'x-make-face-bold-italic 'make-face-bold-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (defalias 'x-make-face-unbold 'make-face-unbold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (defalias 'x-make-face-unitalic 'make-face-unitalic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (make-obsolete 'x-make-face-bold 'make-face-bold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (make-obsolete 'x-make-face-italic 'make-face-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (make-obsolete 'x-make-face-bold-italic 'make-face-bold-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (make-obsolete 'x-make-face-unbold 'make-face-unbold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (make-obsolete 'x-make-face-unitalic 'make-face-unitalic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 ;;; internal routines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 ;;; x-init-face-from-resources is responsible for initializing a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 ;;; newly-created face from the resource database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 ;;; When a new frame is created, it is called from `x-init-frame-faces'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 ;;; called from `init-frame-faces' called from init_frame_faces()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 ;;; from Fmake_frame(). In this case it is called once for each existing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 ;;; face, with the newly-created frame as the argument. It then initializes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 ;;; the newly-created faces on that frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 ;;; It's also called from `init-device-faces' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 ;;; `init-global-faces'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 ;;; This had better not signal an error. The frame is in an intermediate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 ;;; state where signalling an error or entering the debugger would likely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 ;;; result in a crash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (defun x-init-face-from-resources (face &optional locale set-anyway)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 ;; These are things like "attributeForeground" instead of simply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 ;; "foreground" because people tend to do things like "*foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 ;; which would cause all faces to be fully qualified, making faces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 ;; inherit attributes in a non-useful way. So we've made them slightly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 ;; less obvious to specify in order to make them work correctly in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 ;; more random environments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 ;; I think these should be called "face.faceForeground" instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 ;; "face.attributeForeground", but they're the way they are for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 ;; hysterical reasons. (jwz)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (let* ((append (if set-anyway nil 'append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 ;; Some faces are initialized before XEmacs is dumped.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 ;; In order for the X resources to be able to override
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 ;; those settings, such initialization always uses the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 ;; `default' tag. We remove all specifier specs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 ;; containing the `default' tag in the locale before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 ;; adding new specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (tag-set '(default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 ;; The tag order matters here. The spec removal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 ;; function uses the list cdrs. We want to remove (x
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 ;; default) and (default) specs, not (default x) and (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 ;; specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (x-tag-set '(x default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (tty-tag-set '(tty default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 (device-class nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (face-sym (face-name face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (name (symbol-name face-sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (fn (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (concat name ".attributeFont")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 "Face.AttributeFont"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (fg (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (concat name ".attributeForeground")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 "Face.AttributeForeground"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (bg (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (concat name ".attributeBackground")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 "Face.AttributeBackground"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 (bgp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (concat name ".attributeBackgroundPixmap")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 "Face.AttributeBackgroundPixmap"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (ulp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (concat name ".attributeUnderline")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 "Face.AttributeUnderline"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (stp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (concat name ".attributeStrikethru")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 "Face.AttributeStrikethru"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 ;; we still resource for these TTY-only resources so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 ;; you can specify resources for TTY frames/devices. This is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 ;; useful when you start up your XEmacs on an X display and later
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 ;; open some TTY frames.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (hp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (concat name ".attributeHighlight")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 "Face.AttributeHighlight"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (dp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (concat name ".attributeDim")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 "Face.AttributeDim"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (bp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (concat name ".attributeBlinking")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 "Face.AttributeBlinking"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (rp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (concat name ".attributeReverse")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 "Face.AttributeReverse"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 (cond ((framep locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (setq device-class (device-class (frame-device locale))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 ((devicep locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (setq device-class (device-class locale))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (setq tag-set (cons device-class tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 x-tag-set (cons device-class x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 tty-tag-set (cons device-class tty-tag-set)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 ;; If this is the default face, then any unspecified properties should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 ;; be defaulted from the global properties. Can't do this for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 ;; frames or devices because then, common resource specs like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 ;; "*Foreground: black" will have unwanted effects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (if (and (or (eq (face-name face) 'default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (eq (face-name face) 'gui-element))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (or (null locale) (eq locale 'global)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (or fn (setq fn (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
495 "font" "Font" 'string locale nil 'warn)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (or fg (setq fg (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
497 "foreground" "Foreground" 'string locale nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
498 'warn)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (or bg (setq bg (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
500 "background" "Background" 'string locale nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
501 'warn)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 ;; "*cursorColor: foo" is equivalent to setting the background of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 ;; text-cursor face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (if (and (eq (face-name face) 'text-cursor)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (or (null locale) (eq locale 'global)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (setq bg (or (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
509 "cursorColor" "CursorColor" 'string locale nil 'warn)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
510 bg)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 ;; #### should issue warnings? I think this should be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 ;; done when the instancing actually happens, but I'm not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 ;; sure how it should actually be dealt with.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 (when fn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 ;; Always use the x-tag-set to remove specs, since we don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 ;; know whether the predumped face was initialized with an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 ;; 'x tag or not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (remove-specifier-specs-matching-tag-set-cdrs (face-font face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 ;; If there's no device class then we're initializing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 ;; globally. This means we should override global
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 ;; defaults for all X device classes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (remove-specifier (face-font face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (set-face-font face fn locale 'x append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 ;; Kludge-o-rooni. Set the foreground and background resources for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 ;; X devices only -- otherwise things tend to get all messed up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 ;; if you start up an X frame and then later create a TTY frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (when fg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 (remove-specifier-specs-matching-tag-set-cdrs (face-foreground face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (remove-specifier (face-foreground face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 (set-face-foreground face fg locale 'x append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (when bg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (remove-specifier-specs-matching-tag-set-cdrs (face-background face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (remove-specifier (face-background face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (set-face-background face bg locale 'x append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (when bgp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (remove-specifier-specs-matching-tag-set-cdrs (face-background-pixmap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (remove-specifier (face-background-pixmap face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (set-face-background-pixmap face bgp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 (when ulp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 face 'underline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (remove-specifier (face-property face 'underline) locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 (set-face-underline-p face ulp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (when stp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 face 'strikethru)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (remove-specifier (face-property face 'strikethru)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 locale tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (set-face-strikethru-p face stp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (when hp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 (remove-specifier (face-property face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 locale tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 (set-face-highlight-p face hp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (when dp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 face 'dim)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 (remove-specifier (face-property face 'dim) locale tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (set-face-dim-p face dp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 (when bp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 face 'blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (remove-specifier (face-property face 'blinking) locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (set-face-blinking-p face bp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (when rp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 face 'reverse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (remove-specifier (face-property face 'reverse) locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (set-face-reverse-p face rp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 ;; GNU Emacs compatibility. (move to obsolete.el?)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (defalias 'make-face-x-resource-internal 'x-init-face-from-resources)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (defun remove-specifier-specs-matching-tag-set-cdrs (specifier locale tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (while tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (remove-specifier specifier locale tag-set t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (setq tag-set (cdr tag-set))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 ;;; x-init-global-faces is responsible for ensuring that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 ;;; default face has some reasonable fallbacks if nothing else is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 ;;; specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 (defun x-init-global-faces ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 (or (face-foreground 'default 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (set-face-foreground 'default "black" 'global '(x default)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (or (face-background 'default 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 (set-face-background 'default "gray80" 'global '(x default))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 ;;; x-init-device-faces is responsible for initializing default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 ;;; values for faces on a newly created device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (defun x-init-device-faces (device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 ;; If the "default" face didn't have a font specified, try to pick one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 ;;
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
632 ;; (or
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
633 ;; (face-font-instance 'default device)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
634 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
635 ;; [[ No font specified in the resource database; try to cope. ]]
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
636 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
637 ;; NOTE: In reality, this will never happen. The fallbacks will always
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
638 ;; be tried, and the last fallback is "*", which should get any font. No
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
639 ;; need to put the same checks here as in the fallbacks. These comments
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
640 ;; appear to be pre-19.12. --ben
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
642 ;; [[ At first I wanted to do this by just putting a font-spec in the
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
643 ;; fallback resources passed to XtAppInitialize(), but that fails
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
644 ;; if there is an Emacs app-defaults file which doesn't specify a
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
645 ;; font: apparently the fallback resources are not consulted when
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
646 ;; there is an app-defaults file, which seems pretty bogus to me.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
647 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
648 ;; We should also probably try "*xtDefaultFont", but I think that it
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
649 ;; might be legal to specify that as "xtDefaultFont:", that is, at
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
650 ;; top level, instead of "*xtDefaultFont:", that is, applicable to
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
651 ;; every application. `x-get-resource' can't handle that right now.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
652 ;; Anyway, xtDefaultFont is probably variable-width.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
653 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
654 ;; Some who have LucidaTypewriter think it's a better font than Courier,
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
655 ;; but it has the bug that there are no italic and bold italic versions.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
656 ;; We could hair this code up to try and mix-and-match fonts to get a
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
657 ;; full complement, but really, why bother. It's just a default. ]]
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
658 ;;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
659 ;; [[ We default to looking for iso8859 fonts. Using a wildcard for the
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
660 ;; encoding would be bad, because that can cause English speakers to get
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
661 ;; Kanji fonts by default. It is safe to assume that people using a
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
662 ;; language other than English have both set $LANG, and have specified
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
663 ;; their `font' and `fontList' resources. In any event, it's better to
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
664 ;; err on the side of the English speaker in this case because they are
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
665 ;; much less likely to have encountered this problem, and are thus less
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
666 ;; likely to know what to do about it. ]]
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
667
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 801
diff changeset
668
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 ;; If the "default" face didn't have both colors specified, then pick
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 ;; some, taking into account whether one of the colors was specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 (let ((fg (face-foreground-instance 'default device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 (bg (face-background-instance 'default device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 (if (not (and fg bg))
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 502
diff changeset
676 (if (or (and fg (equalp (color-instance-name fg) "white"))
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 502
diff changeset
677 (and bg (equalp (color-instance-name bg) "black")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (or fg (set-face-foreground 'default "white" device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (or bg (set-face-background 'default "black" device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (or fg (set-face-foreground 'default "white" device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (or bg (set-face-background 'default "black" device)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 ;; Don't look at reverseVideo now or initialize the modeline. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 ;; is done on a per-frame basis at the appropriate time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 ;; Now let's try to pick some reasonable defaults for a few other faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 ;; This kind of stuff should normally go on the create-frame-hook, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 ;; this way we won't be in danger of the user screwing things up by not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 ;; adding hooks in a safe way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (x-init-pointer-shape device) ; from x-mouse.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 ;;; This is called from `init-frame-faces', which is called from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 ;;; init_frame_faces() which is called from Fmake_frame(), to perform
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 ;;; any device-specific initialization.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (defun x-init-frame-faces (frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 ;; The faces already got initialized (by init-frame-faces) from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 ;; the resource database or global, non-frame faces. The default,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 ;; bold, bold-italic, and italic faces (plus various other random faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 ;; got set up then. But modeline didn't so that reverseVideo can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 ;; frame-specific.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 ;; If reverseVideo was specified, swap the foreground and background
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 ;; of the default and modeline faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 ;;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
713 (cond ((car (x-get-resource "reverseVideo" "ReverseVideo" 'boolean frame
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
714 nil 'warn))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 ;; First make sure the modeline has fg and bg, inherited from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 ;; current default face - for the case where only one is specified,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 ;; so that invert-face doesn't do something weird.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (or (face-foreground 'modeline frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (set-face-foreground 'modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (face-foreground-instance 'default frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (or (face-background 'modeline frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 (set-face-background 'modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 (face-background-instance 'default frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 ;; Now invert both of them. If they end up looking the same,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 ;; make-frame-initial-faces will invert the modeline again later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 (invert-face 'default frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 (invert-face 'modeline frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 ;;; x-faces.el ends here