annotate lisp/x-faces.el @ 502:7039e6323819

[xemacs-hg @ 2001-05-04 22:41:46 by ben] ----------------------- byte-comp warning fixes ----------------- New functions for cleanly eliminating byte-compiler warnings. Their definitions require no changes at all in bytecomp.el, meaning that any package that wants to use them and be compatible with older versions of XEmacs need only copy the code and rename the functions (i.e. prefix them with the package name). Eliminate byte-compiler warnings using the new functions in bytecomp-runtime.el. Move coding-system-put,get,category, since they're not Mule-specific and are used in prefer-coding-system. font.el was incredibly ugly. Clean it up. Avoid using defsubst for any exported functions, to avoid possible compatibility problems if we later change the internal interface. (It happened before, with face accessors, between 19.8 and 19.9). Fix tons of warnings. Clean up (new function gpm-is-supported-p eliminates duplicate code in gpm-create/delete-device-hook) and eliminate warnings. ---------- make byte-recompile-directory work in the --------- core `lisp' dir, even in the absence of a Mule XEmacs (i.e. make it skip the Mule files rather than trying to compile them). now you should be able to do `touch *.el' in the `lisp' dir, then M-x byte-recompile-directory, and get no warnings. Avoid trying to compile Mule files in byte-recompile-directory when we're not in a Mule XEmacs, since we're highly likely to get syntax errors. Add a coding-system cookie to all Mule files so that byte-recompile-directory ignores them. Magic cookie function moved to files.el from code-files.el (for use by bytecomp even in a non-coding-system XEmacs), and changed names and semantics for use by bytecomp. NOTE: IMO this is an internal function that we can change as we like (and there is absolutely no code anywhere else using the function). ---------------- GUI improvements: menus, help ------------------- Rearrange order of keymap declarations to be alphabetical. Improve help on help to include all bindings, and group by category. Add bindings for new Info commands. Remove warnings. Use command-hyper-apropos in place of command-apropos. Add a function to do the equivalent of command-apropos. Evals its help-text argument so you can put expressions there. Used now by help-for-help. Add binding to continue text searches. Expand index searches to work over multiple info documents. Add commands to search text/index in User and Lispref. Add new entry, "Uncomment Region" (parallels "Comment Out Region"). Redo Help menu; add bindings for new Info commands to search the index or text of the User and Lispref manuals. Add command for mark-paragraph, activate-region. Make Edit->R accelerator be rectangle, not register (more commonly used), and put rectangle first. Fix the Edit Init File entry to never load the .elc file. Simplify the default-popup-menu. Add Cmds->Tabs menu. Use kp-left not kp_left, etc. ---------------- Miscellaneous bug fixes/cleanup ------------------- byte-compiler-options: Correct doc string. easy-menu-do-define: fix extra quote. fill-paragraph-or-region:Rewrite to be more correct -- use call-interactively so that we always get exactly the same behavior as if the functions were called directly. No need to fiddle with zmacs-region-stays, now that bogus clearing of it (2001-04-28 src/ChangeLog) is removed. Put dialog titles back in -- this time correctly. Fix various other problems with leaks and such. key-sequence-list-description: Clean up fun to always correctly canonicalize. Clean up Kinsoku comments, synch comment-region with FSF 20.7. * simple.el (region-exists-p): * simple.el (region-active-p): Add comment about which one is correct to use in menu specs. * sound.el (load-sound-file): Minor code clean up. * startup.el: * startup.el (command-line-early): * startup.el (initial-scratch-message): Comment changes. Add info about sample.init.el to splash screen. Improve initial-scratch-message and clarify purpose of Scratch buffer. Fix byte-compile warning. ------------------------ Added features ------------------------- Add new variable to control whether etags checks all parent directories for tag files. (On by default.) * hash-table.el: New file, useful utility functions. * dumped-lisp.el (preloaded-file-list): Dump hash-table.el. ------------ notable bug fix: Windows event code -------------- Get critical quit working. ------------ notable bug fix and new feature: regex code -------------- Shy groups were implemented in a horrible, half-assed way that would cause them to screw up regex searching in most cases. Fixed to work correctly. Also extended back-reference syntax past 9. Only is recognized as such if there are at least that many non-shy groups; and optionally will warn about such uses, to catch old code that might be using them differently. (Added variable to control this in search.c -- `warn-about-possibly-incompatible-back- references', on by default for the moment. Declared in lisp.h. ---------------- process/SIGIO improvements ------------------- define USE_GETADDRINFO to replace more complex conditional, and use it. the code conditionalized on this in unix_open_network_stream had *serious* problems handling errors. it's now fixed, and major amounts of duplicate code between the two versions were combined. don't disable SIGIO and other interrupts unless CONNECT_NEEDS_SLOWED_INTERRUPTS is defined -- don't penalize OS's without bugs. similarly for a freebsd bug that was affecting all OS's. * s\ultrix.h: define CONNECT_NEEDS_SLOWED_INTERRUPTS, since that's the OS mentioned as having a kernel bug. * sysdep.c (request_sigio_on_device): * sysdep.c (unrequest_sigio_on_device): fix SIGIO problems on Linux. add check for O_ASYNC in case it's defined and FASYNC isn't. add comment about other ways to do SIGIO on Linux. * callproc.c (Fold_call_process_internal): * process.c (Fstart_process_internal): Deal with the possibility that `default-directory' doesn't have terminating slash. Correct comments about vfork. ---------------- Miscellaneous bug fixes/cleanup ------------------- * callint.c (Finteractive): Add lots of documentation -- exactly what the Lisp equivalents of all the interactive specs are. * console.h (struct console): change type of quit_char to Emchar. * event-msw.c (lstream_type_create_mswindows_selectable): spacing change. Eliminate events-mod.h and combine into events.h. * emacs.c: * emacs.c (make_arg_list_1): * emacs.c (main_1): A couple of char->Extbyte changes, add a comment. * glyphs-msw.c: Correct indentation of function defns to not exceed 80 cols. Try (sort of) to fix some code that sets the colors of the progress gauge. (Commented out) * keymap.c (syms_of_keymap): use DEFSYMBOL. * process.c (read_process_output): No need to fiddle with zmacs_region_stays, now that bogus clearing of it (see below) is removed. * search.c (Freplace_match): warning fix.
author ben
date Fri, 04 May 2001 22:42:35 +0000
parents 576fb035e263
children 2b676dc88c66
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.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995, 1996 Ben Wing.
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 (setq font (downcase font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (while rest
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (cond ((and (not up-p) (equal font (downcase (nth 2 (car rest)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (setq result last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 rest nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ((and up-p (equal font (and last (downcase (nth 2 last)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (setq result (car rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 rest nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (setq last (car rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (setq rest (cdr rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (nth 2 result))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (defun x-find-smaller-font (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 "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
355 Returns the font if it succeeds, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 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
357 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
358 (x-frob-font-size font nil device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (defun x-find-larger-font (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 "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
362 Returns the font if it succeeds, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 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
364 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
365 (x-frob-font-size font t device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (defalias 'x-make-face-bold 'make-face-bold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (defalias 'x-make-face-italic 'make-face-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (defalias 'x-make-face-bold-italic 'make-face-bold-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (defalias 'x-make-face-unbold 'make-face-unbold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (defalias 'x-make-face-unitalic 'make-face-unitalic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (make-obsolete 'x-make-face-bold 'make-face-bold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (make-obsolete 'x-make-face-italic 'make-face-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (make-obsolete 'x-make-face-bold-italic 'make-face-bold-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (make-obsolete 'x-make-face-unbold 'make-face-unbold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (make-obsolete 'x-make-face-unitalic 'make-face-unitalic)
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 ;;; internal routines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 ;;; x-init-face-from-resources is responsible for initializing a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 ;;; newly-created face from the resource database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 ;;; 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
386 ;;; called from `init-frame-faces' called from init_frame_faces()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 ;;; 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
388 ;;; face, with the newly-created frame as the argument. It then initializes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 ;;; the newly-created faces on that frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 ;;; It's also called from `init-device-faces' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 ;;; `init-global-faces'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 ;;; 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
395 ;;; state where signalling an error or entering the debugger would likely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 ;;; result in a crash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (defun x-init-face-from-resources (face &optional locale set-anyway)
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 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 ;; These are things like "attributeForeground" instead of simply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 ;; "foreground" because people tend to do things like "*foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 ;; which would cause all faces to be fully qualified, making faces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 ;; 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
405 ;; less obvious to specify in order to make them work correctly in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 ;; more random environments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 ;; I think these should be called "face.faceForeground" instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 ;; "face.attributeForeground", but they're the way they are for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 ;; hysterical reasons. (jwz)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (let* ((append (if set-anyway nil 'append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 ;; Some faces are initialized before XEmacs is dumped.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 ;; In order for the X resources to be able to override
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 ;; those settings, such initialization always uses the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 ;; `default' tag. We remove all specifier specs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 ;; containing the `default' tag in the locale before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 ;; adding new specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (tag-set '(default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 ;; The tag order matters here. The spec removal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 ;; function uses the list cdrs. We want to remove (x
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 ;; default) and (default) specs, not (default x) and (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 ;; specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (x-tag-set '(x default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 (tty-tag-set '(tty default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (device-class nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (face-sym (face-name face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (name (symbol-name face-sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (fn (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (concat name ".attributeFont")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 "Face.AttributeFont"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (fg (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (concat name ".attributeForeground")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 "Face.AttributeForeground"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (bg (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (concat name ".attributeBackground")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 "Face.AttributeBackground"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (bgp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 (concat name ".attributeBackgroundPixmap")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 "Face.AttributeBackgroundPixmap"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 'string locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (ulp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (concat name ".attributeUnderline")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 "Face.AttributeUnderline"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (stp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 (concat name ".attributeStrikethru")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 "Face.AttributeStrikethru"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 ;; we still resource for these TTY-only resources so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 ;; you can specify resources for TTY frames/devices. This is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 ;; 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
456 ;; open some TTY frames.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (hp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (concat name ".attributeHighlight")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 "Face.AttributeHighlight"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (dp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (concat name ".attributeDim")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 "Face.AttributeDim"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (bp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (concat name ".attributeBlinking")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 "Face.AttributeBlinking"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 'boolean locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (rp (x-get-resource-and-maybe-bogosity-check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (concat name ".attributeReverse")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 "Face.AttributeReverse"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 'boolean locale))
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (cond ((framep locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (setq device-class (device-class (frame-device locale))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 ((devicep locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (setq device-class (device-class locale))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (setq tag-set (cons device-class tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 x-tag-set (cons device-class x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 tty-tag-set (cons device-class tty-tag-set)))
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 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 ;; If this is the default face, then any unspecified properties should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 ;; be defaulted from the global properties. Can't do this for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 ;; frames or devices because then, common resource specs like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 ;; "*Foreground: black" will have unwanted effects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (if (and (or (eq (face-name face) 'default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (eq (face-name face) 'gui-element))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (or (null locale) (eq locale 'global)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 (or fn (setq fn (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
496 "font" "Font" 'string locale nil 'warn)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (or fg (setq fg (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
498 "foreground" "Foreground" 'string locale nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
499 'warn)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (or bg (setq bg (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
501 "background" "Background" 'string locale nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
502 'warn)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 ;; "*cursorColor: foo" is equivalent to setting the background of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 ;; text-cursor face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (if (and (eq (face-name face) 'text-cursor)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (or (null locale) (eq locale 'global)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (setq bg (or (x-get-resource
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
510 "cursorColor" "CursorColor" 'string locale nil 'warn)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
511 bg)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 ;; #### should issue warnings? I think this should be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 ;; done when the instancing actually happens, but I'm not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 ;; sure how it should actually be dealt with.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (when fn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 ;; 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
518 ;; know whether the predumped face was initialized with an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 ;; 'x tag or not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (remove-specifier-specs-matching-tag-set-cdrs (face-font face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 ;; If there's no device class then we're initializing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 ;; globally. This means we should override global
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 ;; defaults for all X device classes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (remove-specifier (face-font face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (set-face-font face fn locale 'x append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 ;; Kludge-o-rooni. Set the foreground and background resources for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 ;; X devices only -- otherwise things tend to get all messed up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 ;; 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
531 (when fg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (remove-specifier-specs-matching-tag-set-cdrs (face-foreground face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 (remove-specifier (face-foreground face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (set-face-foreground face fg locale 'x append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (when bg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (remove-specifier-specs-matching-tag-set-cdrs (face-background face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (remove-specifier (face-background face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (set-face-background face bg locale 'x append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (when bgp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (remove-specifier-specs-matching-tag-set-cdrs (face-background-pixmap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 x-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (remove-specifier (face-background-pixmap face) locale x-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 (set-face-background-pixmap face bgp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (when ulp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 face 'underline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (remove-specifier (face-property face 'underline) locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (set-face-underline-p face ulp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 (when stp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 face 'strikethru)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (remove-specifier (face-property face 'strikethru)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 locale tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (set-face-strikethru-p face stp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (when hp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (remove-specifier (face-property face 'highlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 locale tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (set-face-highlight-p face hp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 (when dp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 face 'dim)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (remove-specifier (face-property face 'dim) locale tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 (set-face-dim-p face dp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (when bp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 face 'blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (remove-specifier (face-property face 'blinking) locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (set-face-blinking-p face bp locale nil append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (when rp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (if device-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (remove-specifier-specs-matching-tag-set-cdrs (face-property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 face 'reverse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 tty-tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (remove-specifier (face-property face 'reverse) locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 tty-tag-set nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (set-face-reverse-p face rp locale nil append))
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 ;; GNU Emacs compatibility. (move to obsolete.el?)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (defalias 'make-face-x-resource-internal 'x-init-face-from-resources)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (defun remove-specifier-specs-matching-tag-set-cdrs (specifier locale tag-set)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (while tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (remove-specifier specifier locale tag-set t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (setq tag-set (cdr tag-set))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 ;;; x-init-global-faces is responsible for ensuring that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 ;;; default face has some reasonable fallbacks if nothing else is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 ;;; specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 (defun x-init-global-faces ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (or (face-font 'default 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (set-face-font 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 'global '(x default)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 (or (face-foreground 'default 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (set-face-foreground 'default "black" 'global '(x default)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 (or (face-background 'default 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (set-face-background 'default "gray80" 'global '(x default))))
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 ;;; x-init-device-faces is responsible for initializing default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 ;;; values for faces on a newly created device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (defun x-init-device-faces (device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 ;; 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
636 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (face-font-instance 'default device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 ;; No font specified in the resource database; try to cope.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 ;; At first I wanted to do this by just putting a font-spec in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 ;; fallback resources passed to XtAppInitialize(), but that fails
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 ;; if there is an Emacs app-defaults file which doesn't specify a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 ;; font: apparently the fallback resources are not consulted when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 ;; there is an app-defaults file, which seems pretty bogus to me.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 ;; We should also probably try "*xtDefaultFont", but I think that it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 ;; might be legal to specify that as "xtDefaultFont:", that is, at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 ;; top level, instead of "*xtDefaultFont:", that is, applicable to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 ;; every application. `x-get-resource' can't handle that right now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 ;; Anyway, xtDefaultFont is probably variable-width.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 ;; Some who have LucidaTypewriter think it's a better font than Courier,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 ;; but it has the bug that there are no italic and bold italic versions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 ;; We could hair this code up to try and mix-and-match fonts to get a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 ;; full complement, but really, why bother. It's just a default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (let (new-x-font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (setq new-x-font (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 ;; We default to looking for iso8859 fonts. Using a wildcard for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 ;; encoding would be bad, because that can cause English speakers to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 ;; Kanji fonts by default. It is safe to assume that people using a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 ;; language other than English have both set $LANG, and have specified
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 ;; their `font' and `fontList' resources. In any event, it's better to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 ;; err on the side of the English speaker in this case because they are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 ;; much less likely to have encountered this problem, and are thus less
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 ;; likely to know what to do about it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 ;; Try for Courier. Almost everyone has that. (Does anyone not?)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (make-font-instance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 (make-font-instance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 ;; Next try for any "medium" charcell or monospaced iso8859 font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 ;; Next try for any charcell or monospaced iso8859 font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (make-font-instance "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (make-font-instance "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 ;; Ok, let's at least try to stay in 8859...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (make-font-instance "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 ;; Boy, we sure are losing now. Try the above, but in any encoding.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (make-font-instance "-*-*-*-r-*-*-*-120-*-*-m-*-*-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 (make-font-instance "-*-*-*-r-*-*-*-120-*-*-c-*-*-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 (make-font-instance "-*-*-*-r-*-*-*-120-*-*-*-*-*-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 ;; Hello? Please?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 (make-font-instance "-*-*-*-*-*-*-*-120-*-*-*-*-*-*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 (make-font-instance "*" device t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 ;; if we get to here we're screwed, and faces.c will fatal()...
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 (if (not (face-font 'default 'global))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (set-face-font 'default new-x-font)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (set-face-font 'default new-x-font device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 ;; If the "default" face didn't have both colors specified, then pick
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 ;; some, taking into account whether one of the colors was specified.
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 (let ((fg (face-foreground-instance 'default device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (bg (face-background-instance 'default device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (if (not (and fg bg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (if (or (and fg (equal (downcase (color-instance-name fg)) "white"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 (and bg (equal (downcase (color-instance-name bg)) "black")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (or fg (set-face-foreground 'default "white" device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (or bg (set-face-background 'default "black" device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 (or fg (set-face-foreground 'default "white" device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (or bg (set-face-background 'default "black" device)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 ;; Don't look at reverseVideo now or initialize the modeline. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 ;; is done on a per-frame basis at the appropriate time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 ;; 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
718 ;; 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
719 ;; 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
720 ;; adding hooks in a safe way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (x-init-pointer-shape device) ; from x-mouse.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 ;;; This is called from `init-frame-faces', which is called from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 ;;; init_frame_faces() which is called from Fmake_frame(), to perform
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 ;;; any device-specific initialization.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 (defun x-init-frame-faces (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 ;; The faces already got initialized (by init-frame-faces) from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 ;; the resource database or global, non-frame faces. The default,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 ;; bold, bold-italic, and italic faces (plus various other random faces)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 ;; 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
735 ;; frame-specific.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 ;; If reverseVideo was specified, swap the foreground and background
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 ;; of the default and modeline faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 ;;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
742 (cond ((car (x-get-resource "reverseVideo" "ReverseVideo" 'boolean frame
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
743 nil 'warn))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 ;; First make sure the modeline has fg and bg, inherited from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 ;; current default face - for the case where only one is specified,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 ;; so that invert-face doesn't do something weird.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 (or (face-foreground 'modeline frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 (set-face-foreground 'modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 (face-foreground-instance 'default frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 (or (face-background 'modeline frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 (set-face-background 'modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 (face-background-instance 'default frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 ;; Now invert both of them. If they end up looking the same,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 ;; make-frame-initial-faces will invert the modeline again later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 (invert-face 'default frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 (invert-face 'modeline frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 ;;; x-faces.el ends here