annotate lisp/faces.el @ 853:2b6fa2618f76

[xemacs-hg @ 2002-05-28 08:44:22 by ben] merge my stderr-proc ws make-docfile.c: Fix places where we forget to check for EOF. code-init.el: Don't use CRLF conversion by default on process output. CMD.EXE and friends work both ways but Cygwin programs don't like the CRs. code-process.el, multicast.el, process.el: Removed. Improvements to call-process-internal: -- allows a buffer to be specified for input and stderr output -- use it on all systems -- implement C-g as documented -- clean up and comment call-process-region uses new call-process facilities; no temp file. remove duplicate funs in process.el. comment exactly how coding systems work and fix various problems. open-multicast-group now does similar coding-system frobbing to open-network-stream. dumped-lisp.el, faces.el, msw-faces.el: Fix some hidden errors due to code not being defined at the right time. xemacs.mak: Add -DSTRICT. ================================================================ ALLOW SEPARATION OF STDOUT AND STDERR IN PROCESSES ================================================================ Standard output and standard error can be processed separately in a process. Each can have its own buffer, its own mark in that buffer, and its filter function. You can specify a separate buffer for stderr in `start-process' to get things started, or use the new primitives: set-process-stderr-buffer process-stderr-buffer process-stderr-mark set-process-stderr-filter process-stderr-filter Also, process-send-region takes a 4th optional arg, a buffer. Currently always uses a pipe() under Unix to read the error output. (#### Would a PTY be better?) sysdep.h, sysproc.h, unexfreebsd.c, unexsunos4.c, nt.c, emacs.c, callproc.c, symsinit.h, sysdep.c, Makefile.in.in, process-unix.c: Delete callproc.c. Move child_setup() to process-unix.c. wait_for_termination() now only needed on a few really old systems. console-msw.h, event-Xt.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.h, process-nt.c, process-unix.c, process.c, process.h, procimpl.h: Rewrite the process methods to handle a separate channel for error input. Create Lstreams for reading in the error channel. Many process methods need change. In general the changes are fairly clear as they involve duplicating what's used for reading the normal stdout and changing for stderr -- although tedious, as such changes are required throughout the entire process code. Rewrote the code that reads process output to do two loops, one for stdout and one for stderr. gpmevent.c, tooltalk.c: set_process_filter takes an argument for stderr. ================================================================ NEW ERROR-TRAPPING MECHANISM ================================================================ Totally rewrite error trapping code to be unified and support more features. Basic function is call_trapping_problems(), which lets you specify, by means of flags, what sorts of problems you want trapped. these can include -- quit -- errors -- throws past the function -- creation of "display objects" (e.g. buffers) -- deletion of already-existing "display objects" (e.g. buffers) -- modification of already-existing buffers -- entering the debugger -- gc -- errors->warnings (ala suspended errors) etc. All other error funs rewritten in terms of this one. Various older mechanisms removed or rewritten. window.c, insdel.c, console.c, buffer.c, device.c, frame.c: When creating a display object, added call to note_object_created(), for use with trapping_problems mechanism. When deleting, call check_allowed_operation() and note_object deleted(). The trapping-problems code records the objects created since the call-trapping-problems began. Those objects can be deleted, but none others (i.e. previously existing ones). bytecode.c, cmdloop.c: internal_catch takes another arg. eval.c: Add long comments describing the "five lists" used to maintain state (backtrace, gcpro, specbind, etc.) in the Lisp engine. backtrace.h, eval.c: Implement trapping-problems mechanism, eliminate old mechanisms or redo in terms of new one. frame.c, gutter.c: Flush out the concept of "critical display section", defined by the in_display() var. Use an internal_bind() to get it reset, rather than just doing it at end, because there may be a non-local exit. event-msw.c, event-stream.c, console-msw.h, device.c, dialog-msw.c, frame.c, frame.h, intl.c, toolbar.c, menubar-msw.c, redisplay.c, alloc.c, menubar-x.c: Make use of new trapping-errors stuff and rewrite code based on old mechanisms. glyphs-widget.c, redisplay.h: Protect calling Lisp in redisplay. insdel.c: Protect hooks against deleting existing buffers. frame-msw.c: Use EQ, not EQUAL in hash tables whose keys are just numbers. Otherwise we run into stickiness in redisplay because internal_equal() can QUIT. ================================================================ SIGNAL, C-G CHANGES ================================================================ Here we change the way that C-g interacts with event reading. The idea is that a C-g occurring while we're reading a user event should be read as C-g, but elsewhere should be a QUIT. The former code did all sorts of bizarreness -- requiring that no QUIT occurs anywhere in event-reading code (impossible to enforce given the stuff called or Lisp code invoked), and having some weird system involving enqueue/dequeue of a C-g and interaction with Vquit_flag -- and it didn't work. Now, we simply enclose all code where we want C-g read as an event with {begin/end}_dont_check_for_quit(). This completely turns off the mechanism that checks (and may remove or alter) C-g in the read-ahead queues, so we just get the C-g normal. Signal.c documents this very carefully. cmdloop.c: Correct use of dont_check_for_quit to new scheme, remove old out-of-date comments. event-stream.c: Fix C-g handling to actually work. device-x.c: Disable quit checking when err out. signal.c: Cleanup. Add large descriptive comment. process-unix.c, process-nt.c, sysdep.c: Use QUIT instead of REALLY_QUIT. It's not necessary to use REALLY_QUIT and just confuses the issue. lisp.h: Comment quit handlers. ================================================================ CONS CHANGES ================================================================ free_cons() now takes a Lisp_Object not the result of XCONS(). car and cdr have been renamed so that they don't get used directly; go through XCAR(), XCDR() instead. alloc.c, dired.c, editfns.c, emodules.c, fns.c, glyphs-msw.c, glyphs-x.c, glyphs.c, keymap.c, minibuf.c, search.c, eval.c, lread.c, lisp.h: Correct free_cons calling convention: now takes Lisp_Object, not Lisp_Cons chartab.c: Eliminate direct use of ->car, ->cdr, should be black box. callint.c: Rewrote using EXTERNAL_LIST_LOOP to avoid use of Lisp_Cons. ================================================================ USE INTERNAL-BIND-* ================================================================ eval.c: Cleanups of these funs. alloc.c, fileio.c, undo.c, specifier.c, text.c, profile.c, lread.c, redisplay.c, menubar-x.c, macros.c: Rewrote to use internal_bind_int() and internal_bind_lisp_object() in place of whatever varied and cumbersome mechanisms were formerly there. ================================================================ SPECBIND SANITY ================================================================ backtrace.h: - Improved comments backtrace.h, bytecode.c, eval.c: Add new mechanism check_specbind_stack_sanity() for sanity checking code each time the catchlist or specbind stack change. Removed older prototype of same mechanism. ================================================================ MISC ================================================================ lisp.h, insdel.c, window.c, device.c, console.c, buffer.c: Fleshed out authorship. device-msw.c: Correct bad Unicode-ization. print.c: Be more careful when not initialized or in fatal error handling. search.c: Eliminate running_asynch_code, an FSF holdover. alloc.c: Added comments about gc-cons-threshold. dialog-x.c: Use begin_gc_forbidden() around code to build up a widget value tree, like in menubar-x.c. gui.c: Use Qunbound not Qnil as the default for gethash. lisp-disunion.h, lisp-union.h: Added warnings on use of VOID_TO_LISP(). lisp.h: Use ERROR_CHECK_STRUCTURES to turn on ERROR_CHECK_TRAPPING_PROBLEMS and ERROR_CHECK_TYPECHECK lisp.h: Add assert_with_message. lisp.h: Add macros for gcproing entire arrays. (You could do this before but it required manual twiddling the gcpro structure.) lisp.h: Add prototypes for new functions defined elsewhere.
author ben
date Tue, 28 May 2002 08:45:36 +0000
parents 79940b592197
children 79c6ff3eef26
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 ;;; faces.el --- Lisp interface to the C "face" structure
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 Board of Trustees, University of Illinois
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Copyright (C) 1995, 1996 Ben Wing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Author: Ben Wing <ben@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: faces, 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 with FSF. Almost completely divergent.
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.
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 ;; face implementation #1 (used Lisp vectors and parallel C vectors;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@jwz.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; pre Lucid-Emacs 19.0.
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 ;; face implementation #2 (used one face object per frame per face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; authored by Jamie Zawinski for 19.9.
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 ;; face implementation #3 (use one face object per face) originally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; authored for 19.12 by Chuck Thompson <cthomp@cs.uiuc.edu>,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; rewritten by Ben Wing with the advent of specifiers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;;; Some stuff in FSF's faces.el is in our x-faces.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 735
diff changeset
49 ;; To elude the warnings for font functions. (Normally autoloaded when
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 735
diff changeset
50 ;; font-create-object is called)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 735
diff changeset
51 (eval-when-compile
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 735
diff changeset
52 (require 'font))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 735
diff changeset
53
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 (defgroup faces nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 "Support for multiple text attributes (fonts, colors, ...)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 Such a collection of attributes is called a \"face\"."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 (defun read-face-name (prompt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (let (face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (while (= (length face) 0) ; nil or ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 (setq face (completing-read prompt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (mapcar (lambda (x) (list (symbol-name x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (face-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 nil t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (intern face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (defun face-interactive (what &optional bool)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (let* ((fn (intern (concat "face-" what "-instance")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (face (read-face-name (format "Set %s of face: " what)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (default (if (fboundp fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; #### we should distinguish here between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; explicitly setting the value to be the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; same as the default face's value, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; not setting a value at all.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (funcall fn face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (value (if bool
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (y-or-n-p (format "Should face %s be %s? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (symbol-name face) bool))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (read-string (format "Set %s of face %s to: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 what (symbol-name face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (cond ((font-instance-p default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (font-instance-name default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ((color-instance-p default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (color-instance-name default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ((image-instance-p default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (image-instance-file-name default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (t default))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (list face (if (equal value "") nil value))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (defconst built-in-face-specifiers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (built-in-face-specifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 "A list of the built-in face properties that are specifiers.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (defun face-property (face property &optional locale tag-set exact-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 "Return FACE's value of the given PROPERTY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 If LOCALE is omitted, the FACE's actual value for PROPERTY will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 returned. For built-in properties, this will be a specifier object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 of a type appropriate to the property (e.g. a font or color
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 specifier). For other properties, this could be anything.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 If LOCALE is supplied, then instead of returning the actual value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 the specification(s) for the given locale or locale type will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 be returned. This will only work if the actual value of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 PROPERTY is a specifier (this will always be the case for built-in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 properties, but not or not may apply to user-defined properties).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 If the actual value of PROPERTY is not a specifier, this value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 will simply be returned regardless of LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 The return value will be a list of instantiators (e.g. strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 specifying a font or color name), or a list of specifications, each
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 of which is a cons of a locale and a list of instantiators.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Specifically, if LOCALE is a particular locale (a buffer, window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 frame, device, or 'global), a list of instantiators for that locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 will be returned. Otherwise, if LOCALE is a locale type (one of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 the symbols 'buffer, 'window, 'frame, or 'device), the specifications
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 for all locales of that type will be returned. Finally, if LOCALE is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 'all, the specifications for all locales of all types will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 The specifications in a specifier determine what the value of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 PROPERTY will be in a particular \"domain\" or set of circumstances,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 which is typically a particular Emacs window along with the buffer
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
125 it contains and the frame and device it lies within. The value is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
126 derived from the instantiator associated with the most specific
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 locale (in the order buffer, window, frame, device, and 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 that matches the domain in question. In other words, given a domain
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
129 (i.e. an Emacs window, usually), the specifier for PROPERTY will
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
130 first be searched for a specification whose locale is the buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
131 contained within that window; then for a specification whose locale
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
132 is the window itself; then for a specification whose locale is the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
133 frame that the window is contained within; etc. The first
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
134 instantiator that is valid for the domain (usually this means that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
135 the instantiator is recognized by the device [i.e. MS Windows, the X
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
136 server or TTY device] that the domain is on. The function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
137 `face-property-instance' actually does all this, and is used to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
138 determine how to display the face.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 See `set-face-property' for the built-in property-names."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (setq face (get-face face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 (let ((value (get face property)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (if (and locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (or (memq property built-in-face-specifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (specifierp value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (setq value (specifier-specs value locale tag-set exact-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (defun convert-face-property-into-specifier (face property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 "Convert PROPERTY on FACE into a specifier, if it's not already."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 (setq face (get-face face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (let ((specifier (get face property)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 ;; if a user-property does not have a specifier but a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 ;; locale was specified, put a specifier there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 ;; If there was already a value there, convert it to a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 ;; specifier with the value as its 'global instantiator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (unless (specifierp specifier)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (let ((new-specifier (make-specifier 'generic)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (if (or (not (null specifier))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 ;; make sure the nil returned from `get' wasn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 ;; actually the value of the property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (null (get face property t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (add-spec-to-specifier new-specifier specifier))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (setq specifier new-specifier)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (put face property specifier)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (defun face-property-instance (face property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 "Return the instance of FACE's PROPERTY in the specified DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 Under most circumstances, DOMAIN will be a particular window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 and the returned instance describes how the specified property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 actually is displayed for that window and the particular buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 in it. Note that this may not be the same as how the property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 appears when the buffer is displayed in a different window or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 frame, or how the property appears in the same window if you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 switch to another buffer in that window; and in those cases,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 the returned instance would be different.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 The returned instance will typically be a color-instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 font-instance, or pixmap-instance object, and you can query
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 it using the appropriate object-specific functions. For example,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 you could use `color-instance-rgb-components' to find out the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 RGB (red, green, and blue) components of how the 'background
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 property of the 'highlight face is displayed in a particular
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 window. The results might be different from the results
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 you would get for another window (perhaps the user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 specified a different color for the frame that window is on;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 or perhaps the same color was specified but the window is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 on a different X server, and that X server has different RGB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 values for the color from this one).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 DOMAIN defaults to the selected window if omitted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 DOMAIN can be a frame or device, instead of a window. The value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 returned for a such a domain is used in special circumstances
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 when a more specific domain does not apply; for example, a frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 value might be used for coloring a toolbar, which is conceptually
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 attached to a frame rather than a particular window. The value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 is also useful in determining what the value would be for a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 particular window within the frame or device, if it is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 overridden by a more specific specification.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 If PROPERTY does not name a built-in property, its value will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 simply be returned unless it is a specifier object, in which case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 it will be instanced using `specifier-instance'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 Optional arguments DEFAULT and NO-FALLBACK are the same as in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 `specifier-instance'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (setq face (get-face face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (let ((value (get face property)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (if (specifierp value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (setq value (specifier-instance value domain default no-fallback)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (defun face-property-matching-instance (face property matchspec
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 &optional domain default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 "Return the instance of FACE's PROPERTY matching MATCHSPEC in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 Currently the only useful value for MATCHSPEC is a charset, when used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 in conjunction with the face's font; this allows you to retrieve a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 font that can be used to display a particular charset, rather than just
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 any font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Other than MATCHSPEC, this function is identical to `face-property-instance'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 See also `specifier-matching-instance' for a fuller description of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 matching process."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (setq face (get-face face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (let ((value (get face property)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (if (specifierp value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (setq value (specifier-matching-instance value matchspec domain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 default no-fallback)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (defun set-face-property (face property value &optional locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 "Change a property of FACE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 NOTE: If you want to remove a property from a face, use `remove-face-property'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 rather than attempting to set a value of nil for the property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 For built-in properties, the actual value of the property is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 specifier and you cannot change this; but you can change the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 specifications within the specifier, and that is what this function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 will do. For user-defined properties, you can use this function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 to either change the actual value of the property or, if this value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 is a specifier, change the specifications within it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 If PROPERTY is a built-in property, the specifications to be added to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 this property can be supplied in many different ways:
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 -- If VALUE is a simple instantiator (e.g. a string naming a font or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 color) or a list of instantiators, then the instantiator(s) will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 be added as a specification of the property for the given LOCALE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (which defaults to 'global if omitted).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 -- If VALUE is a list of specifications (each of which is a cons of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 a locale and a list of instantiators), then LOCALE must be nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (it does not make sense to explicitly specify a locale in this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 case), and specifications will be added as given.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 -- If VALUE is a specifier (as would be returned by `face-property'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 if no LOCALE argument is given), then some or all of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 specifications in the specifier will be added to the property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 In this case, the function is really equivalent to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 `copy-specifier' and LOCALE has the same semantics (if it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 a particular locale, the specification for the locale will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 copied; if a locale type, specifications for all locales of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 that type will be copied; if nil or 'all, then all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 specifications will be copied).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 HOW-TO-ADD should be either nil or one of the symbols 'prepend,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 'append, 'remove-tag-set-prepend, 'remove-tag-set-append, 'remove-locale,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 'remove-locale-type, or 'remove-all. See `copy-specifier' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 `add-spec-to-specifier' for a description of what each of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 these means. Most of the time, you do not need to worry about
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 this argument; the default behavior usually is fine.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 In general, it is OK to pass an instance object (e.g. as returned
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 by `face-property-instance') as an instantiator in place of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 an actual instantiator. In such a case, the instantiator used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 to create that instance object will be used (for example, if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 you set a font-instance object as the value of the 'font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 property, then the font name used to create that object will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 be used instead). If some cases, however, doing this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 conversion does not make sense, and this will be noted in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 the documentation for particular types of instance objects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 If PROPERTY is not a built-in property, then this function will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 simply set its value if LOCALE is nil. However, if LOCALE is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 given, then this function will attempt to add VALUE as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 instantiator for the given LOCALE, using `add-spec-to-specifier'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 If the value of the property is not a specifier, it will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 automatically be converted into a 'generic specifier.
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 The following symbols have predefined meanings:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 foreground The foreground color of the face.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
301 For valid instantiators, see `make-color-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 background The background color of the face.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
304 For valid instantiators, see `make-color-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 font The font used to display text covered by this face.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
307 For valid instantiators, see `make-font-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 display-table The display table of the face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 This should be a vector of 256 elements.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 background-pixmap The pixmap displayed in the background of the face.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
313 Only used by faces on X and MS Windows devices.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
314 For valid instantiators, see `make-image-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 underline Underline all text covered by this face.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
317 For valid instantiators, see `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 strikethru Draw a line through all text covered by this face.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
320 For valid instantiators, see `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 highlight Highlight all text covered by this face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 Only used by faces on TTY devices.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
324 For valid instantiators, see `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 dim Dim all text covered by this face.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
327 For valid instantiators, see `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 blinking Blink all text covered by this face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 Only used by faces on TTY devices.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
331 For valid instantiators, see `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 reverse Reverse the foreground and background colors.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 Only used by faces on TTY devices.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
335 For valid instantiators, see `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 doc-string Description of what the face's normal use is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 NOTE: This is not a specifier, unlike all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 the other built-in properties, and cannot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 contain locale-specific values."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (setq face (get-face face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (if (memq property built-in-face-specifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (set-specifier (get face property) value locale tag-set how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ;; This section adds user defined properties.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (if (not locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (put face property value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (convert-face-property-into-specifier face property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (add-spec-to-specifier (get face property) value locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 how-to-add)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (defun remove-face-property (face property &optional locale tag-set exact-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 "Remove a property from FACE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 For built-in properties, this is analogous to `remove-specifier'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 See `remove-specifier' for the meaning of the LOCALE, TAG-SET, and EXACT-P
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 arguments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (or locale (setq locale 'all))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (if (memq property built-in-face-specifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (remove-specifier (face-property face property) locale tag-set exact-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (if (eq locale 'all)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (remprop (get-face face) property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (convert-face-property-into-specifier face property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (remove-specifier (face-property face property) locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 exact-p))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (defun reset-face (face &optional locale tag-set exact-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 "Clear all existing built-in specifications from FACE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 This makes FACE inherit all its display properties from 'default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 WARNING: Be absolutely sure you want to do this!!! It is a dangerous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 operation and is not undoable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 The arguments LOCALE, TAG-SET and EXACT-P are the same as for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 `remove-specifier'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (mapc (lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (remove-specifier (face-property face x) locale tag-set exact-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 built-in-face-specifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (defun set-face-parent (face parent &optional locale tag-set how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 "Set the parent of FACE to PARENT, for all properties.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 This makes all properties of FACE inherit from PARENT."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (setq parent (get-face parent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (mapcar (lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (set-face-property face x (vector parent) locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (delq 'display-table
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (delq 'background-pixmap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (copy-sequence built-in-face-specifiers))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (set-face-background-pixmap face (vector 'inherit ':face parent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 locale tag-set how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (defun face-doc-string (face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 "Return the documentation string for FACE."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (face-property face 'doc-string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (defun set-face-doc-string (face doc-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 "Change the documentation string of FACE to DOC-STRING."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (interactive (face-interactive "doc-string"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (set-face-property face 'doc-string doc-string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (defun face-font-name (face &optional domain charset)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 "Return the font name of FACE in DOMAIN, or nil if it is unspecified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 DOMAIN is as in `face-font-instance'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (let ((f (face-font-instance face domain charset)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (and f (font-instance-name f))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (defun face-font (face &optional locale tag-set exact-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 "Return the font of FACE in LOCALE, or nil if it is unspecified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 LOCALE may be a locale (the instantiators for that particular locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 will be returned), a locale type (the specifications for all locales
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 of that type will be returned), 'all (all specifications will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 returned), or nil (the actual specifier object will be returned).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 See `face-property' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (face-property face 'font locale tag-set exact-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (defun face-font-instance (face &optional domain charset)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 "Return the instance of FACE's font in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 Normally DOMAIN will be a window or nil (meaning the selected window),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 and an instance object describing how the font appears in that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 particular window and buffer will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 See `face-property-instance' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (if charset
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (face-property-matching-instance face 'font charset domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (face-property-instance face 'font domain)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (defun set-face-font (face font &optional locale tag-set how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 "Change the font of FACE to FONT in LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
442 FONT should be an instantiator (see `make-font-specifier'), a list of
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 instantiators, an alist of specifications (each mapping a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 locale to an instantiator list), or a font specifier object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 If FONT is an alist, LOCALE must be omitted. If FONT is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 specifier object, LOCALE can be a locale, a locale type, 'all,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 specifies the locale under which the specified instantiator(s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 will be added, and defaults to 'global.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 See `set-face-property' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (interactive (face-interactive "font"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (set-face-property face 'font font locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (defun face-foreground (face &optional locale tag-set exact-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 "Return the foreground of FACE in LOCALE, or nil if it is unspecified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 LOCALE may be a locale (the instantiators for that particular locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 will be returned), a locale type (the specifications for all locales
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 of that type will be returned), 'all (all specifications will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 returned), or nil (the actual specifier object will be returned).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 See `face-property' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (face-property face 'foreground locale tag-set exact-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (defun face-foreground-instance (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 "Return the instance of FACE's foreground in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 FACE may be either a face object or a symbol representing a face.
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 Normally DOMAIN will be a window or nil (meaning the selected window),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 and an instance object describing how the foreground appears in that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 particular window and buffer will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 See `face-property-instance' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (face-property-instance face 'foreground domain default no-fallback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (defun face-foreground-name (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 "Return the name of FACE's foreground color in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 FACE may be either a face object or a symbol representing a face.
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 Normally DOMAIN will be a window or nil (meaning the selected window),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 and an instance object describing how the background appears in that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 particular window and buffer will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 See `face-property-instance' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (color-instance-name (face-foreground-instance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 face domain default no-fallback)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (defun set-face-foreground (face color &optional locale tag-set how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 "Change the foreground color of FACE to COLOR in LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
499 COLOR should be an instantiator (see `make-color-specifier'), a list of
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 instantiators, an alist of specifications (each mapping a locale to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 an instantiator list), or a color specifier object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 If COLOR is an alist, LOCALE must be omitted. If COLOR is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 specifier object, LOCALE can be a locale, a locale type, 'all,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 specifies the locale under which the specified instantiator(s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 will be added, and defaults to 'global.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 See `set-face-property' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (interactive (face-interactive "foreground"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 (set-face-property face 'foreground color locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (defun face-background (face &optional locale tag-set exact-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 "Return the background color of FACE in LOCALE, or nil if it is unspecified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 LOCALE may be a locale (the instantiators for that particular locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 will be returned), a locale type (the specifications for all locales
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 of that type will be returned), 'all (all specifications will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 returned), or nil (the actual specifier object will be returned).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 See `face-property' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 (face-property face 'background locale tag-set exact-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (defun face-background-instance (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 "Return the instance of FACE's background in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 Normally DOMAIN will be a window or nil (meaning the selected window),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 and an instance object describing how the background appears in that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 particular window and buffer will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 See `face-property-instance' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 (face-property-instance face 'background domain default no-fallback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (defun face-background-name (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 "Return the name of FACE's background color in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 Normally DOMAIN will be a window or nil (meaning the selected window),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 and an instance object describing how the background appears in that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 particular window and buffer will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 See `face-property-instance' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (color-instance-name (face-background-instance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 face domain default no-fallback)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (defun set-face-background (face color &optional locale tag-set how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 "Change the background color of FACE to COLOR in LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
556 COLOR should be an instantiator (see `make-color-specifier'), a list of
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 instantiators, an alist of specifications (each mapping a locale to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 an instantiator list), or a color specifier object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 If COLOR is an alist, LOCALE must be omitted. If COLOR is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 specifier object, LOCALE can be a locale, a locale type, 'all,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 specifies the locale under which the specified instantiator(s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 will be added, and defaults to 'global.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 See `set-face-property' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (interactive (face-interactive "background"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (set-face-property face 'background color locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (defun face-background-pixmap (face &optional locale tag-set exact-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 "Return the background pixmap of FACE in LOCALE, or nil if it is unspecified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 This property is only used on window system devices.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 LOCALE may be a locale (the instantiators for that particular locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 will be returned), a locale type (the specifications for all locales
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 of that type will be returned), 'all (all specifications will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 returned), or nil (the actual specifier object will be returned).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 See `face-property' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (face-property face 'background-pixmap locale tag-set exact-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (defun face-background-pixmap-instance (face &optional domain default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 "Return the instance of FACE's background pixmap in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 Normally DOMAIN will be a window or nil (meaning the selected window),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 and an instance object describing how the background appears in that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 particular window and buffer will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 See `face-property-instance' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (face-property-instance face 'background-pixmap domain default no-fallback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (defun set-face-background-pixmap (face pixmap &optional locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 "Change the background pixmap of FACE to PIXMAP in LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 This property is only used on window system devices.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 FACE may be either a face object or a symbol representing a face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
604 PIXMAP should be an instantiator (see `make-image-specifier'), a list
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 of instantiators, an alist of specifications (each mapping a locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 to an instantiator list), or an image specifier object.
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 If PIXMAP is an alist, LOCALE must be omitted. If PIXMAP is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 specifier object, LOCALE can be a locale, a locale type, 'all,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 specifies the locale under which the specified instantiator(s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 will be added, and defaults to 'global.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 See `set-face-property' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (interactive (face-interactive "background-pixmap"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (set-face-property face 'background-pixmap pixmap locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 (defun face-display-table (face &optional locale tag-set exact-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 "Return the display table of FACE in LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 A vector (as returned by `make-display-table') will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 LOCALE may be a locale (the instantiators for that particular locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 will be returned), a locale type (the specifications for all locales
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 of that type will be returned), 'all (all specifications will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 returned), or nil (the actual specifier object will be returned).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 See `face-property' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 (face-property face 'display-table locale tag-set exact-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (defun face-display-table-instance (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 "Return the instance of FACE's display table in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 A vector (as returned by `make-display-table') will be returned.
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 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (face-property-instance face 'display-table domain default no-fallback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (defun set-face-display-table (face display-table &optional locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 "Change the display table of FACE to DISPLAY-TABLE in LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 DISPLAY-TABLE should be a vector as returned by `make-display-table'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 HOW-TO-ADD arguments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (interactive (face-interactive "display-table"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (set-face-property face 'display-table display-table locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 ;; The following accessors and mutators are, IMHO, good
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 ;; implementation. Cf. with `make-face-bold'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (defun face-underline-p (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 "Return t if FACE is underlined in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (face-property-instance face 'underline domain default no-fallback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 (defun set-face-underline-p (face underline-p &optional locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 "Change the underline property of FACE to UNDERLINE-P.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 UNDERLINE-P is normally a face-boolean instantiator; see
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
661 `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 HOW-TO-ADD arguments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (interactive (face-interactive "underline-p" "underlined"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 (set-face-property face 'underline underline-p locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 (defun face-strikethru-p (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 "Return t if FACE is strikethru-d (i.e. struck through) in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (face-property-instance face 'strikethru domain default no-fallback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (defun set-face-strikethru-p (face strikethru-p &optional locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 STRIKETHRU-P is normally a face-boolean instantiator; see
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
676 `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 HOW-TO-ADD arguments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (interactive (face-interactive "strikethru-p" "strikethru-d"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (set-face-property face 'strikethru strikethru-p locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (defun face-highlight-p (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 "Return t if FACE is highlighted in DOMAIN (TTY domains only).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (face-property-instance face 'highlight domain default no-fallback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (defun set-face-highlight-p (face highlight-p &optional locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 "Change whether FACE is highlighted in LOCALE (TTY locales only).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 HIGHLIGHT-P is normally a face-boolean instantiator; see
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
691 `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 HOW-TO-ADD arguments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 (interactive (face-interactive "highlight-p" "highlighted"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (set-face-property face 'highlight highlight-p locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (defun face-dim-p (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 "Return t if FACE is dimmed in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (face-property-instance face 'dim domain default no-fallback))
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 (defun set-face-dim-p (face dim-p &optional locale tag-set how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 "Change whether FACE is dimmed in LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 DIM-P is normally a face-boolean instantiator; see
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
705 `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 HOW-TO-ADD arguments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (interactive (face-interactive "dim-p" "dimmed"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (set-face-property face 'dim dim-p locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (defun face-blinking-p (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 "Return t if FACE is blinking in DOMAIN (TTY domains only).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (face-property-instance face 'blinking domain default no-fallback))
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 (defun set-face-blinking-p (face blinking-p &optional locale tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 "Change whether FACE is blinking in LOCALE (TTY locales only).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 BLINKING-P is normally a face-boolean instantiator; see
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
720 `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 HOW-TO-ADD arguments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 (interactive (face-interactive "blinking-p" "blinking"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 (set-face-property face 'blinking blinking-p locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 (defun face-reverse-p (face &optional domain default no-fallback)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 "Return t if FACE is reversed in DOMAIN (TTY domains only).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 (face-property-instance face 'reverse domain default no-fallback))
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 (defun set-face-reverse-p (face reverse-p &optional locale tag-set how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 "Change whether FACE is reversed in LOCALE (TTY locales only).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 REVERSE-P is normally a face-boolean instantiator; see
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
734 `make-face-boolean-specifier'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 HOW-TO-ADD arguments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 (interactive (face-interactive "reverse-p" "reversed"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 (set-face-property face 'reverse reverse-p locale tag-set how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 (defun face-property-equal (face1 face2 prop domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 (equal (face-property-instance face1 prop domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 (face-property-instance face2 prop domain)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (defun face-equal-loop (props face1 face2 domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 (while (and props
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 (face-property-equal face1 face2 (car props) domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 (setq props (cdr props)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 (null props))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 (defun face-equal (face1 face2 &optional domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 "Return t if FACE1 and FACE2 will display in the same way in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (if (null domain) (setq domain (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 (if (not (valid-specifier-domain-p domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 (error "Invalid specifier domain"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 (let ((device (dfw-device domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 (common-props '(foreground background font display-table underline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 dim))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 (win-props '(background-pixmap strikethru))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (tty-props '(highlight blinking reverse)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 ;; First check the properties which are used in common between the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 ;; x and tty devices. Then, check those properties specific to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 ;; the particular device type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (and (face-equal-loop common-props face1 face2 domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 (cond ((eq 'tty (device-type device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (face-equal-loop tty-props face1 face2 domain))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
769 ;; #### Why isn't this (console-on-window-system-p (device-console device))?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
770 ;; #### FIXME!
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 ((or (eq 'x (device-type device))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
772 (eq 'gtk (device-type device))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (eq 'mswindows (device-type device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 (face-equal-loop win-props face1 face2 domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (t t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (defun face-differs-from-default-p (face &optional domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 "Return t if FACE will display differently from the default face in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (not (face-equal face 'default domain)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 ; moved from x-faces.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 (defun try-font-name (name &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 ;; yes, name really should be here twice.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (and name (make-font-instance name device t) name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 ;; This function is a terrible, disgusting hack!!!! Need to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 ;; separate out the font elements as separate face properties!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 ;; WE DEMAND LEXICAL SCOPING!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 ;; WE DEMAND LEXICAL SCOPING!!!
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
806 (defun frob-face-property (face property func device-tags &optional
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
807 locale tags)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 This function is ugly and messy and is primarily used as an internal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 helper function for `make-face-bold' et al., so you probably don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 want to use it or read the rest of the documentation. But if you do ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 FUNC should be a function of two arguments (an instance and a device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 that returns a modified name that is valid for the given device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 If LOCALE specifies a valid domain (i.e. a window, frame, or device),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 this function instantiates the specifier over that domain, applies FUNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 to the resulting instance, and adds the result back as an instantiator
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 for that locale. Otherwise, LOCALE should be a locale, locale type, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 'all (defaults to 'all if omitted). For each specification thusly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 included: if the locale given is a valid domain, FUNC will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 iterated over all valid instantiators for the device of the domain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 until a non-nil result is found (if there is no such result, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 first valid instantiator is used), and that result substituted for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 the specification; otherwise, the process just outlined is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 iterated over each existing device and the concatenated results
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
826 substituted for the specification.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
827
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
828 DEVICE-TAGS is a list of tags that each device must match in order for
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
829 the function to be called on it."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 (let ((sp (face-property face property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 temp-sp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 (if (valid-specifier-domain-p locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 ;; this is easy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 (let* ((inst (face-property-instance face property locale))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
835 (name (and inst
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
836 (device-matches-specifier-tag-set-p
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
837 (dfw-device locale) device-tags)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
838 (funcall func inst (dfw-device locale)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 (when name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 (add-spec-to-specifier sp name locale tags)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 ;; otherwise, map over all specifications ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 ;; but first, some further kludging:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 ;; (1) if we're frobbing the global property, make sure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 ;; that something is there (copy from the default face,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 ;; if necessary). Otherwise, something like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 ;; (make-face-larger 'modeline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 ;; won't do anything at all if the modeline simply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 ;; inherits its font from 'default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 ;; (2) if we're frobbing a particular locale, nothing would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 ;; happen if that locale has no instantiators. So signal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 ;; an error to indicate this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
853
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 (setq temp-sp (copy-specifier sp))
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
855 (if (or (eq locale 'global) (eq locale 'all) (not locale))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
856 (when (not (specifier-specs temp-sp 'global))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
857 ;; Try fallback via the official ways and then do it "by hand"
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
858 (let* ((fallback (specifier-fallback sp))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
859 (fallback-sp
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
860 (cond ((specifierp fallback) fallback)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
861 ;; just an inst list
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
862 (fallback
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
863 (make-specifier-and-init (specifier-type sp)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
864 fallback))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
865 ((eq (get-face face) (get-face 'default))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
866 (error "Unable to find global specification"))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
867 ;; If no fallback we snoop from default
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
868 (t (face-property 'default property)))))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
869 (copy-specifier fallback-sp temp-sp 'global))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 (if (and (valid-specifier-locale-p locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 (not (specifier-specs temp-sp locale)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 (error "Property must have a specification in locale %S" locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 (map-specifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 temp-sp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 (lambda (sp-arg locale inst-list func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 (let* ((device (dfw-device locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 ;; if a device can be derived from the locale,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 ;; call frob-face-property-1 for that device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 ;; Otherwise map frob-face-property-1 over each device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (if device
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
882 (list (and (device-matches-specifier-tag-set-p
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
883 device device-tags)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
884 (frob-face-property-1 sp-arg device inst-list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
885 func)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 (mapcar (lambda (device)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
887 (and (device-matches-specifier-tag-set-p
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
888 device device-tags)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
889 (frob-face-property-1 sp-arg device
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
890 inst-list func)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 (device-list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 new-result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 ;; remove duplicates and nils from the obtained list of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 ;; instantiators. Also add tags amd remove 'defaults'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 (mapcar (lambda (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 (when arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 (if (not (consp arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 (setq arg (cons tags arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 (setcar arg (append tags (delete 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 (car arg))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
901 (when (and arg (not (member arg new-result)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 (setq new-result (cons arg new-result))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 ;; add back in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 (add-spec-list-to-specifier sp (list (cons locale new-result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 ;; tell map-specifier to keep going.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 func))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 (defun frob-face-property-1 (sp device inst-list func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 (let
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 (first-valid result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 (while (and inst-list (not result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 (let* ((inst-pair (car inst-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 (tag-set (car inst-pair))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 (sp-inst (specifier-instance-from-inst-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 sp device (list inst-pair))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 (if sp-inst
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 (if (not first-valid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 (setq first-valid inst-pair))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 (setq result (funcall func sp-inst device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 (if result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 (setq result (cons tag-set result))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 (setq inst-list (cdr inst-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 (or result first-valid)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
929 (defcustom face-frob-from-locale-first nil
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
930 "*If non nil, use kludgy way of frobbing fonts suitable for non-mule
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
931 multi-charset environments."
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
932 :group 'faces
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
933 :type 'boolean)
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
934
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 (defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
936 tty-thunk ws-thunk standard-face-mapping)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 ;; another kludge to make things more intuitive. If we're
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 ;; inheriting from a standard face in this locale, frob the
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
939 ;; inheritance as appropriate. Else, if, after the first
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
940 ;; window-system frobbing pass, the face hasn't changed and still
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
941 ;; looks like the standard unfrobbed face (e.g. 'default), make it
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
942 ;; inherit from the standard frobbed face (e.g. 'bold). Regardless
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943 ;; of things, do the TTY frobbing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 ;; but is a "locale, locale-type, or nil for all". So ... do our extra
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 ;; frobbing only if it's actually a locale; or for nil, do the frobbing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 ;; on 'global. This specifier stuff needs some rethinking.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 (let* ((the-locale (cond ((null locale) 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 ((valid-specifier-locale-p locale) locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 (t nil)))
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
952 (spec-list
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
953 (and
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
954 the-locale
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
955 (specifier-spec-list (get (get-face face) 'font) the-locale tags t)))
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
956 (change-it
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
957 (and
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
958 spec-list
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
959 (cdr (assoc (cdadar spec-list) standard-face-mapping)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 (if (and change-it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 (not (memq (face-name (find-face face))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 '(default bold italic bold-italic))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 (or (equal change-it t)
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
965 (set-face-property face 'font change-it the-locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 (funcall tty-thunk))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 (let* ((domain (cond ((null the-locale) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 ((valid-specifier-domain-p the-locale) the-locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 ;; OK, this next one is truly a kludge, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 ;; it results in more intuitive behavior most
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 ;; of the time. (really!)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 ((or (eq the-locale 'global) (eq the-locale 'all))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 (selected-device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 (inst (and domain (face-property-instance face 'font domain))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 ;; If it's reasonable to do the inherit-from-standard-face trick,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 ;; and it's called for, then do it now.
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
978 (if (and
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
979 face-frob-from-locale-first
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
980 (eq the-locale 'global)
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
981 domain
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
982 (equal inst (face-property-instance face 'font domain))
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
983 ;; don't do it for standard faces, or you'll get inheritance loops.
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
984 ;; #### This makes XEmacs seg fault! fix this bug.
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
985 (not (memq (face-name (find-face face))
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
986 '(default bold italic bold-italic)))
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
987 (equal (face-property-instance face 'font domain)
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
988 (face-property-instance unfrobbed-face 'font domain)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 (set-face-property face 'font (vector frobbed-face)
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
990 the-locale tags)
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
991 ;; and only otherwise try to build new property value artificially
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
992 (funcall tty-thunk)
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
993 (funcall ws-thunk)
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
994 (and
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
995 domain
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
996 (equal inst (face-property-instance face 'font domain))
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
997 ;; don't do it for standard faces, or you'll get inheritance loops.
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
998 ;; #### This makes XEmacs seg fault! fix this bug.
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
999 (not (memq (face-name (find-face face))
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
1000 '(default bold italic bold-italic)))
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
1001 (equal (face-property-instance face 'font domain)
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
1002 (face-property-instance unfrobbed-face 'font domain))
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 446
diff changeset
1003 (set-face-property face 'font (vector frobbed-face) the-locale tags)))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1005 ;; WE DEMAND FOUNDRY FROBBING!
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1006
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1007 ;; Family frobbing
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1008 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com>
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1009 ;; Brainlessly derived from make-face-size by Stephen; don't blame Jan.
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1010 ;; I'm long since flown to Rio, it does you little good to blame me, either.
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1011 (defun make-face-family (face family &optional locale tags)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1012 "Set FACE's family to FAMILY in LOCALE, if possible.
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1013
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1014 Add/replace settings specified by TAGS only."
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1015 (frob-face-property face 'font
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1016 ;; uses dynamic scope of family
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1017 #'(lambda (f d)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1018 ;; keep the dependency on font.el for now
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1019 (let ((fo (font-create-object (font-instance-name f)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1020 d)))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1021 (set-font-family fo family)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1022 (font-create-name fo d)))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1023 nil locale tags))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1024
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1025 ;; Style (ie, typographical face) frobbing
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 (defun make-face-bold (face &optional locale tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 "Make FACE bold in LOCALE, if possible.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1028 This will attempt to make the font bold for X/MSW locales and will set the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 highlight flag for TTY locales.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 If LOCALE is nil, omitted, or `all', this will attempt to frob all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 font specifications for FACE to make them appear bold. Similarly, if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 LOCALE is a locale type, this frobs all font specifications for locales
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 of that type. If LOCALE is a particular locale, what happens depends on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 what sort of locale is given. If you gave a device, frame, or window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 then it's always possible to determine what the font actually will be,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 so this is determined and the resulting font is frobbed and added back as a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 specification for this locale. If LOCALE is a buffer, however, you can't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 determine what the font will actually be unless there's actually a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 specification given for that particular buffer (otherwise, it depends
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 on what window and frame the buffer appears in, and might not even be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 well-defined if the buffer appears multiple times in different places);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 therefore you will get an error unless there's a specification for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 Finally, in some cases (specifically, when LOCALE is not a locale type),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 if the frobbing didn't actually make the font look any different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 \(this happens, for example, if your font specification is already bold
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 or has no bold equivalent), and currently looks like the font of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 'default face, it is set to inherit from the 'bold face. This is kludgy
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 but it makes `make-face-bold' have more intuitive behavior in many
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 circumstances."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 (interactive (list (read-face-name "Make which face bold: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 (frob-face-font-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 face locale tags 'default 'bold
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 (lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 ;; handle TTY specific entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 (when (featurep 'tty)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 (set-face-highlight-p face t locale (cons 'tty tags))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 (lambda ()
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1061 ;; handle window-system specific entries
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1062 (when (featurep 'gtk)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1063 (frob-face-property face 'font 'gtk-make-font-bold
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1064 '(gtk) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 (when (featurep 'x)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1066 (frob-face-property face 'font 'x-make-font-bold
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1067 '(x) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 (when (featurep 'mswindows)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1069 (frob-face-property face 'font 'mswindows-make-font-bold
484
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1070 '(mswindows) locale tags)
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1071 (frob-face-property face 'font 'mswindows-make-font-bold
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1072 '(msprinter) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 '(([default] . [bold])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 ([bold] . t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 ([italic] . [bold-italic])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 ([bold-italic] . t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 (defun make-face-italic (face &optional locale tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 "Make FACE italic in LOCALE, if possible.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1081 This will attempt to make the font italic for X/MS Windows locales and
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1082 will set the underline flag for TTY locales. See `make-face-bold' for
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1083 the semantics of the LOCALE argument and for more specifics on exactly
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1084 how this function works."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 (interactive (list (read-face-name "Make which face italic: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 (frob-face-font-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 face locale tags 'default 'italic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 (lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 ;; handle TTY specific entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 (when (featurep 'tty)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 (set-face-underline-p face t locale (cons 'tty tags))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 (lambda ()
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1093 ;; handle window-system specific entries
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1094 (when (featurep 'gtk)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1095 (frob-face-property face 'font 'gtk-make-font-italic
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1096 '(gtk) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 (when (featurep 'x)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1098 (frob-face-property face 'font 'x-make-font-italic
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1099 '(x) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 (when (featurep 'mswindows)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1101 (frob-face-property face 'font 'mswindows-make-font-italic
484
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1102 '(mswindows) locale tags)
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1103 (frob-face-property face 'font 'mswindows-make-font-italic
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1104 '(msprinter) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 '(([default] . [italic])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 ([bold] . [bold-italic])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 ([italic] . t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 ([bold-italic] . t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 (defun make-face-bold-italic (face &optional locale tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 "Make FACE bold and italic in LOCALE, if possible.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1113 This will attempt to make the font bold-italic for X/MS Windows
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1114 locales and will set the highlight and underline flags for TTY
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1115 locales. See `make-face-bold' for the semantics of the LOCALE
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1116 argument and for more specifics on exactly how this function works."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 (interactive (list (read-face-name "Make which face bold-italic: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 (frob-face-font-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 face locale tags 'default 'bold-italic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 (lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 ;; handle TTY specific entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 (when (featurep 'tty)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 (set-face-highlight-p face t locale (cons 'tty tags))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 (set-face-underline-p face t locale (cons 'tty tags))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 (lambda ()
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1126 ;; handle window-system specific entries
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1127 (when (featurep 'gtk)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1128 (frob-face-property face 'font 'gtk-make-font-bold-italic
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1129 '(gtk) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 (when (featurep 'x)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1131 (frob-face-property face 'font 'x-make-font-bold-italic
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1132 '(x) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 (when (featurep 'mswindows)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1134 (frob-face-property face 'font 'mswindows-make-font-bold-italic
484
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1135 '(mswindows) locale tags)
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1136 (frob-face-property face 'font 'mswindows-make-font-bold-italic
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1137 '(msprinter) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 '(([default] . [italic])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 ([bold] . [bold-italic])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 ([italic] . [bold-italic])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 ([bold-italic] . t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 (defun make-face-unbold (face &optional locale tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 "Make FACE non-bold in LOCALE, if possible.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1146 This will attempt to make the font non-bold for X/MS Windows locales
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1147 and will unset the highlight flag for TTY locales. See
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1148 `make-face-bold' for the semantics of the LOCALE argument and for more
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1149 specifics on exactly how this function works."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 (interactive (list (read-face-name "Make which face non-bold: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 (frob-face-font-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 face locale tags 'bold 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 (lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 ;; handle TTY specific entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 (when (featurep 'tty)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 (set-face-highlight-p face nil locale (cons 'tty tags))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 (lambda ()
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1158 ;; handle window-system specific entries
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1159 (when (featurep 'gtk)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1160 (frob-face-property face 'font 'gtk-make-font-unbold
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1161 '(gtk) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 (when (featurep 'x)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1163 (frob-face-property face 'font 'x-make-font-unbold
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1164 '(x) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 (when (featurep 'mswindows)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1166 (frob-face-property face 'font 'mswindows-make-font-unbold
484
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1167 '(mswindows) locale tags)
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1168 (frob-face-property face 'font 'mswindows-make-font-unbold
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1169 '(msprinter) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 '(([default] . t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 ([bold] . [default])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 ([italic] . t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 ([bold-italic] . [italic]))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 (defun make-face-unitalic (face &optional locale tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 "Make FACE non-italic in LOCALE, if possible.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1178 This will attempt to make the font non-italic for X/MS Windows locales
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1179 and will unset the underline flag for TTY locales. See
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1180 `make-face-bold' for the semantics of the LOCALE argument and for more
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1181 specifics on exactly how this function works."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 (interactive (list (read-face-name "Make which face non-italic: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 (frob-face-font-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 face locale tags 'italic 'default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 (lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 ;; handle TTY specific entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 (when (featurep 'tty)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 (set-face-underline-p face nil locale (cons 'tty tags))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 (lambda ()
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1190 ;; handle window-system specific entries
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1191 (when (featurep 'gtk)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1192 (frob-face-property face 'font 'gtk-make-font-unitalic
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1193 '(gtk) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 (when (featurep 'x)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1195 (frob-face-property face 'font 'x-make-font-unitalic
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1196 '(x) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 (when (featurep 'mswindows)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1198 (frob-face-property face 'font 'mswindows-make-font-unitalic
484
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1199 '(mswindows) locale tags)
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1200 (frob-face-property face 'font 'mswindows-make-font-unitalic
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1201 '(msprinter) locale tags))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 '(([default] . t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 ([bold] . t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 ([italic] . [default])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 ([bold-italic] . [bold]))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1209 ;; Size frobbing
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1210 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com>
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1211 ;; Jan had a separate helper function
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1212 (defun make-face-size (face size &optional locale tags)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1213 "Adjust FACE to SIZE in LOCALE, if possible.
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1214
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1215 Add/replace settings specified by TAGS only."
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1216 (frob-face-property face 'font
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1217 ;; uses dynamic scope of size
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1218 #'(lambda (f d)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1219 ;; keep the dependency on font.el for now
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1220 (let ((fo (font-create-object (font-instance-name f)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1221 d)))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1222 (set-font-size fo size)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1223 (font-create-name fo d)))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1224 nil locale tags))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1225
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 ;; Why do the following two functions lose so badly in so many
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 ;; circumstances?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 (defun make-face-smaller (face &optional locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 "Make the font of FACE be smaller, if possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 LOCALE works as in `make-face-bold' et al., but the ``inheriting-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 from-the-bold-face'' operations described there are not done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 because they don't make sense in this context."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 (interactive (list (read-face-name "Shrink which face: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 ;; handle X specific entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 (when (featurep 'x)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1237 (frob-face-property face 'font 'x-find-smaller-font
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1238 '(x) locale))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 (when (featurep 'mswindows)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1240 (frob-face-property face 'font 'mswindows-find-smaller-font
484
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1241 '(mswindows) locale)
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1242 (frob-face-property face 'font 'mswindows-find-smaller-font
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1243 '(msprinter) locale)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 (defun make-face-larger (face &optional locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 "Make the font of FACE be larger, if possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 See `make-face-smaller' for the semantics of the LOCALE argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 (interactive (list (read-face-name "Enlarge which face: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 ;; handle X specific entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 (when (featurep 'x)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1251 (frob-face-property face 'font 'x-find-larger-font
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1252 '(x) locale))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 (when (featurep 'mswindows)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1254 (frob-face-property face 'font 'mswindows-find-larger-font
484
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1255 '(mswindows) locale)
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1256 (frob-face-property face 'font 'mswindows-find-larger-font
029314e67086 [xemacs-hg @ 2001-04-26 04:20:37 by tomonori]
tomonori
parents: 462
diff changeset
1257 '(msprinter) locale)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 (defun invert-face (face &optional locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 "Swap the foreground and background colors of the face."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 (interactive (list (read-face-name "Invert face: ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 (if (valid-specifier-domain-p locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 (let ((foreface (face-foreground-instance face locale)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 (set-face-foreground face (face-background-instance face locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 (set-face-background face foreface locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 (let ((forespec (copy-specifier (face-foreground face) nil locale)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 (copy-specifier (face-background face) (face-foreground face) locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 (copy-specifier forespec (face-background face) locale))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 ;;; Convenience functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 (defun face-ascent (face &optional domain charset)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 "Return the ascent of FACE in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 (font-ascent (face-font face) domain charset))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 (defun face-descent (face &optional domain charset)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 "Return the descent of FACE in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 (font-descent (face-font face) domain charset))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 (defun face-width (face &optional domain charset)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 "Return the width of FACE in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 (font-width (face-font face) domain charset))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 (defun face-height (face &optional domain charset)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 "Return the height of FACE in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 (+ (face-ascent face domain charset) (face-descent face domain charset)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 (defun face-proportional-p (face &optional domain charset)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 "Return t if FACE is proportional in DOMAIN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 See `face-property-instance' for the semantics of the DOMAIN argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 (font-proportional-p (face-font face) domain charset))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 ;; Functions that used to be in cus-face.el, but logically go here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 (defcustom frame-background-mode nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 "*The brightness of the background.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 Set this to the symbol dark if your background color is dark, light if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 your background is light, or nil (default) if you want Emacs to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 examine the brightness for you."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 :group 'faces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 :type '(choice (choice-item dark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 (choice-item light)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 (choice-item :tag "Auto" nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 ;; The old variable that many people still have in .emacs files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 (define-obsolete-variable-alias 'custom-background-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 'frame-background-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 (defun get-frame-background-mode (frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 "Detect background mode for FRAME."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 (let* ((color-instance (face-background-instance 'default frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 (mode (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 (if (< (apply '+ (color-instance-rgb-components
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 color-instance)) 65536)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 'dark 'light)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 ;; Here, we get an error on a TTY. As we don't have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 ;; a good way of detecting whether a TTY is light or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 ;; dark, we'll guess it's dark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 (error 'dark))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 (set-frame-property frame 'background-mode mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 (defun extract-custom-frame-properties (frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 "Return a plist with the frame properties of FRAME used by custom."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 (list 'type (or (frame-property frame 'display-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 (device-type (frame-device frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 'class (device-class (frame-device frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 'background (or frame-background-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 (frame-property frame 'background-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 (get-frame-background-mode frame))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 (defcustom init-face-from-resources t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 "If non nil, attempt to initialize faces from the resource database."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 :group 'faces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 :type 'boolean)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 ;; Old name, used by custom. Also, FSFmacs name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 (defvaralias 'initialize-face-resources 'init-face-from-resources)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 ;; Make sure all custom setting are added with this tag so we can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 ;; identify-them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 (define-specifier-tag 'custom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 (defun face-spec-set (face spec &optional frame tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 "Set FACE's face attributes according to the first matching entry in SPEC.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 If optional FRAME is non-nil, set it for that frame only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 If it is nil, then apply SPEC to each frame individually.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 See `defface' for information about SPEC."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 (if frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 (reset-face face frame tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 (face-display-set face spec frame tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 (init-face-from-resources face frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 (let ((frames (relevant-custom-frames)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 (reset-face face nil tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 ;; This should not be needed. We only remove our own specifiers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 ;; (if (and (eq 'default face) (featurep 'x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 ;; (x-init-global-faces))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 (face-display-set face spec nil tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 (while frames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 (face-display-set face spec (car frames) tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 (pop frames))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 (init-face-from-resources face))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 (defun face-display-set (face spec &optional frame tags)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 "Set FACE to the attributes to the first matching entry in SPEC.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 Iff optional FRAME is non-nil, set it for that frame only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 See `defface' for information about SPEC."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 (while spec
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 (let ((display (caar spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 (atts (cadar spec)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 (pop spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 (when (face-spec-set-match-display display frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 ;; Avoid creating frame local duplicates of the global face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 (unless (and frame (eq display (get face 'custom-face-display)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 (apply 'face-custom-attributes-set face frame tags atts))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 (unless frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 (put face 'custom-face-display display))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 (setq spec nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 (defvar default-custom-frame-properties nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 "The frame properties used for the global faces.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1390 Frames not matching these properties should have frame local faces.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 The value should be nil, if uninitialized, or a plist otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 See `defface' for a list of valid keys and values for the plist.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 (defun get-custom-frame-properties (&optional frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 "Return a plist with the frame properties of FRAME used by custom.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 If FRAME is nil, return the default frame properties."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 (cond (frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 ;; Try to get from cache.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 (let ((cache (frame-property frame 'custom-properties)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 (unless cache
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 ;; Oh well, get it then.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 (setq cache (extract-custom-frame-properties frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 ;; and cache it...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 (set-frame-property frame 'custom-properties cache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 cache))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 (default-custom-frame-properties)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 (setq default-custom-frame-properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 (extract-custom-frame-properties (selected-frame))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 (defun face-spec-update-all-matching (spec display plist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 "Update all entries in the face spec that could match display to
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1413 have the entries from the new plist and return the new spec."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 (lambda (e)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 (let ((entries (car e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 (options (cadr e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 (match t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 dplist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 (new-options plist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 (unless (eq display t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 (mapc (lambda (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 (setq dplist (plist-put dplist (car arg) (cadr arg))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 display))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 (unless (eq entries t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 (mapc (lambda (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 (setq match (and match (eq (cadr arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 (plist-get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 dplist (car arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 (cadr arg))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 entries))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 (if (not match)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 e
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 (while new-options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 (setq options
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 (plist-put options (car new-options) (cadr new-options)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 (setq new-options (cddr new-options)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 (list entries options))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 (copy-sequence spec)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1441
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1442
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 (defun face-spec-set-match-display (display &optional frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 "Return non-nil if DISPLAY matches FRAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 DISPLAY is part of a spec such as can be used in `defface'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 If FRAME is nil or omitted, the selected frame is used."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 (if (eq display t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 (let* ((props (get-custom-frame-properties frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 (type (plist-get props 'type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 (class (plist-get props 'class))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 (background (plist-get props 'background))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 (match t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 (entries display)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 entry req options)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 (while (and entries match)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 (setq entry (car entries)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 entries (cdr entries)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 req (car entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 options (cdr entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 match (case req
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 (type (memq type options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 (class (memq class options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 (background (memq background options))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 (t (warn "Unknown req `%S' with options `%S'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 req options)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 match)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 (defun relevant-custom-frames ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 "List of frames whose custom properties differ from the default."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 (let ((relevant nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 (default (get-custom-frame-properties))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 (frames (frame-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 (while frames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 (setq frame (car frames)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 frames (cdr frames))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 (unless (equal default (get-custom-frame-properties frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 (push frame relevant)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 relevant))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 (defun initialize-custom-faces (&optional frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 "Initialize all custom faces for FRAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 If FRAME is nil or omitted, initialize them for all frames."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 (mapc (lambda (symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 (let ((spec (or (get symbol 'saved-face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 (get symbol 'face-defface-spec))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 (when spec
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 ;; No need to init-face-from-resources -- code in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 ;; `init-frame-faces' does it already.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 (face-display-set symbol spec frame))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 (face-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 (defun custom-initialize-frame (frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 "Initialize frame-local custom faces for FRAME if necessary."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 (unless (equal (get-custom-frame-properties)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 (get-custom-frame-properties frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 (initialize-custom-faces frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1502 (defun startup-initialize-custom-faces ()
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1503 "Reset faces created by defface. Only called at startup.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1504 Don't use this function in your program."
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1505 (when default-custom-frame-properties
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1506 ;; Reset default value to the actual frame, not stream.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1507 (setq default-custom-frame-properties
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1508 (extract-custom-frame-properties (selected-frame)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1509 ;; like initialize-custom-faces but removes property first.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1510 (mapc (lambda (symbol)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1511 (let ((spec (or (get symbol 'saved-face)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1512 (get symbol 'face-defface-spec))))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1513 (when spec
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1514 ;; Reset faces created during auto-autoloads loading.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1515 (reset-face symbol)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1516 ;; And set it according to the spec.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1517 (face-display-set symbol spec nil))))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1518 (face-list))))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1519
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 (defun make-empty-face (name &optional doc-string temporary)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 "Like `make-face', but doesn't query the resource database."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 (let ((init-face-from-resources nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 (make-face name doc-string temporary)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 (defun init-face-from-resources (face &optional locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 "Initialize FACE from the resource database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 If LOCALE is specified, it should be a frame, device, or 'global, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 the face will be resourced over that locale. Otherwise, the face will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 be resourced over all possible locales (i.e. all frames, all devices,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 and 'global)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 (cond ((null init-face-from-resources)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 ;; Do nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 ((not locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 ;; Global, set for all frames.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 (init-face-from-resources face 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 (let ((devices (device-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 (while devices
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 (init-face-from-resources face (car devices))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 (setq devices (cdr devices))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 (let ((frames (frame-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 (while frames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 (init-face-from-resources face (car frames))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 (setq frames (cdr frames))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 ;; Specific.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 (let ((devtype (cond ((devicep locale) (device-type locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 ((framep locale) (frame-type locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 (t nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1553 (declare-fboundp (x-init-face-from-resources face locale)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 ((or (not devtype) (eq 'tty devtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 ;; Nothing to do for TTYs?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 ))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 (defun init-device-faces (device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 ;; First, add any device-local face resources.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 (when init-face-from-resources
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 (loop for face in (face-list) do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 (init-face-from-resources face device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 ;; Then do any device-specific initialization.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 (cond ((eq 'x (device-type device))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1565 (declare-fboundp (x-init-device-faces device)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1566 ((eq 'gtk (device-type device))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1567 (declare-fboundp (gtk-init-device-faces device)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 ((eq 'mswindows (device-type device))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1569 (declare-fboundp (mswindows-init-device-faces device)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 ;; Nothing to do for TTYs?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 (or (eq 'stream (device-type device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 (init-other-random-faces device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 (defun init-frame-faces (frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 (when init-face-from-resources
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 ;; First, add any frame-local face resources.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 (loop for face in (face-list) do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 (init-face-from-resources face frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 ;; Then do any frame-specific initialization.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 (cond ((eq 'x (frame-type frame))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1582 (declare-fboundp (x-init-frame-faces frame)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1583 ((eq 'gtk (frame-type frame))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1584 (declare-fboundp (gtk-init-frame-faces frame)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 ((eq 'mswindows (frame-type frame))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1586 (declare-fboundp (mswindows-init-frame-faces frame)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 ;; Is there anything which should be done for TTY's?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 ;; #### This is somewhat X-specific, and is called when the first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 ;; X device is created (even if there were TTY devices created
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 ;; beforehand). The concept of resources has not been generalized
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 ;; outside of X-specificness, so we have to live with this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 ;; breach of device-independence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 (defun init-global-faces ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 ;; Look for global face resources.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 (loop for face in (face-list) do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 (init-face-from-resources face 'global))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 ;; Further X frobbing.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1601 (and (featurep 'x) (declare-fboundp (x-init-global-faces)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1602 (and (featurep 'gtk) (declare-fboundp (gtk-init-global-faces)))
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 776
diff changeset
1603 (and (featurep 'mswindows) (declare-fboundp (mswindows-init-global-faces)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 452
diff changeset
1604
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 ;; for bold and the like, make the global specification be bold etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 ;; if the user didn't already specify a value. These will also be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 ;; frobbed further in init-other-random-faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 (unless (face-font 'bold 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 (make-face-bold 'bold 'global))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 (unless (face-font 'italic 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 (make-face-italic 'italic 'global))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 (unless (face-font 'bold-italic 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 (make-face-bold-italic 'bold-italic 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 (unless (face-font 'bold-italic 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 (copy-face 'bold 'bold-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 (make-face-italic 'bold-italic)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 (when (face-equal 'bold 'bold-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 (copy-face 'italic 'bold-italic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 (make-face-bold 'bold-italic))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 ;; Nothing more to be done for X or TTY's?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 ;; These warnings are there for a reason. Just specify your fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 ;; correctly. Deal with it. Additionally, one can use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 ;; `log-warning-minimum-level' instead of this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 ;(defvar inhibit-font-complaints nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 ; "Whether to suppress complaints about incomplete sets of fonts.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 (defun face-complain-about-font (face device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 (if (symbolp face) (setq face (symbol-name face)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 ;; (if (not inhibit-font-complaints)
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1637 ;; complaining for printers is generally annoying.
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1638 (unless (device-printer-p device)
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1639 (display-warning
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1640 'font
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1641 (let ((default-name (face-font-name 'default device)))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1642 (format "%s: couldn't deduce %s %s version of the font
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 %S.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 Please specify X resources to make the %s face
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 visually distinguishable from the default face.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 For example, you could add one of the following to $HOME/Emacs:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 Emacs.%s.attributeFont: -dt-*-medium-i-*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 Emacs.%s.attributeForeground: hotpink\n"
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1652 invocation-name
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1653 (if (string-match "\\`[aeiouAEIOU]" face) "an" "a")
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1654 face
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1655 default-name
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1656 face
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1657 face
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1658 face
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 502
diff changeset
1659 )))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 ;; #### This is quite a mess. We should use the custom mechanism for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 ;; most of this stuff. Currently we don't do it, because Custom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 ;; doesn't use specifiers (yet.) FSF does it the Right Way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 ;; For instance, the definition of `bold' should be something like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 ;; (defface bold ((t (:bold t))) "Bold text.") -- and `:bold t' should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 ;; make sure that everything works properly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 (defun init-other-random-faces (device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 "Initialize the colors and fonts of the bold, italic, bold-italic,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 zmacs-region, list-mode-item-selected, highlight, primary-selection,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 secondary-selection, and isearch faces when each device is created. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 you want to add code to do stuff like this, use the create-device-hook."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 ;; try to make 'bold look different from the default on this device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 ;; If that doesn't work at all, then issue a warning.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 (unless (face-differs-from-default-p 'bold device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 (make-face-bold 'bold device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 (unless (face-differs-from-default-p 'bold device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 (make-face-unbold 'bold device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 (unless (face-differs-from-default-p 'bold device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 ;; the luser specified one of the bogus font names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 (face-complain-about-font 'bold device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 ;; Similar for italic.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 ;; It's unreasonable to expect to be able to make a font italic all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 ;; the time. For many languages, italic is an alien concept.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 ;; Basically, because italic is not a globally meaningful concept,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1690 ;; the use of the italic face should really be obsoleted.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 ;; I disagree with above. In many languages, the concept of capital
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 ;; letters is just as alien, and yet we use them. Italic is here to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 ;; stay. -hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 ;; In a Solaris Japanese environment, there just aren't any italic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 ;; fonts - period. CDE recognizes this reality, and fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 ;; -dt-interface user-medium-r-normal-*-*-*-*-*-*-*-*-* don't come
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 ;; in italic versions. So we first try to make the font bold before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 ;; complaining.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 (unless (face-differs-from-default-p 'italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 (make-face-italic 'italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 (unless (face-differs-from-default-p 'italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 (make-face-bold 'italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 (unless (face-differs-from-default-p 'italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 (face-complain-about-font 'italic device))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 ;; similar for bold-italic.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 (unless (face-differs-from-default-p 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 (make-face-bold-italic 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 ;; if we couldn't get a bold-italic version, try just bold.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 (unless (face-differs-from-default-p 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 (make-face-bold 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 ;; if we couldn't get bold or bold-italic, then that's probably because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 ;; the default font is bold, so make the `bold-italic' face be unbold.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 (unless (face-differs-from-default-p 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 (make-face-unbold 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 (make-face-italic 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 (unless (face-differs-from-default-p 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 ;; if that didn't work, try plain italic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 ;; (can this ever happen? what the hell.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 (make-face-italic 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 (unless (face-differs-from-default-p 'bold-italic device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 ;; then bitch and moan.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 (face-complain-about-font 'bold-italic device))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 ;; Set the text-cursor colors unless already specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 (when (and (not (eq 'tty (device-type device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 (not (face-background 'text-cursor 'global))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 (face-property-equal 'text-cursor 'default 'background device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 (set-face-background 'text-cursor [default foreground] 'global
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 nil 'append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 (when (and (not (eq 'tty (device-type device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 (not (face-foreground 'text-cursor 'global))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 (face-property-equal 'text-cursor 'default 'foreground device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 (set-face-foreground 'text-cursor [default background] 'global
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 nil 'append))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1740 ;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1741 ;; Jones and Hrvoje Niksic.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 (defun set-face-stipple (face pixmap &optional frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 "Change the stipple pixmap of FACE to PIXMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 This is an Emacs compatibility function; consider using
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 set-face-background-pixmap instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 PIXMAP should be a string, the name of a file of pixmap data.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1748 The directories listed in the variables `x-bitmap-file-path' and
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1749 `mswindows-bitmap-file-path' under X and MS Windows respectively
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1750 are searched.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 a string, containing the raw bits of the bitmap. XBM data is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 expected in this case, other types of image data will not work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 If the optional FRAME argument is provided, change only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 in that frame; otherwise change each frame."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 (while (not (find-face face))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1760 (setq face (wrong-type-argument 'facep face)))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1761 (let ((bitmap-path
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1762 (ecase (console-type)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1763 (x (declare-boundp x-bitmap-file-path))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 484
diff changeset
1764 (mswindows (declare-boundp mswindows-bitmap-file-path))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1765 instantiator)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1766 (while
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1767 (null
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1768 (setq instantiator
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1769 (cond ((stringp pixmap)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1770 (let ((file (if (file-name-absolute-p pixmap)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1771 pixmap
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1772 (locate-file pixmap bitmap-path
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1773 '(".xbm" "")))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1774 (and file
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1775 `[xbm :file ,file])))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1776 ((and (listp pixmap) (= (length pixmap) 3))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1777 `[xbm :data ,pixmap])
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1778 (t nil))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1779 ;; We're signaling a continuable error; let's make sure the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1780 ;; function `stipple-pixmap-p' at least exists.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1781 (flet ((stipple-pixmap-p (pixmap)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1782 (or (stringp pixmap)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1783 (and (listp pixmap) (= (length pixmap) 3)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1784 (setq pixmap (signal 'wrong-type-argument
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1785 (list 'stipple-pixmap-p pixmap)))))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1786 (check-type frame (or null frame))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1787 (set-face-background-pixmap face instantiator frame)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 ;; Create the remaining standard faces now. This way, packages that we dump
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 ;; can reference these faces as parents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 ;; The default, modeline, left-margin, right-margin, text-cursor,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 ;; and pointer faces are created in C.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 (make-face 'bold "Bold text.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 (make-face 'italic "Italic text.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 (make-face 'bold-italic "Bold-italic text.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 (make-face 'underline "Underlined text.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 (or (face-differs-from-default-p 'underline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 (set-face-underline-p 'underline t 'global '(default)))
735
b63242824a7a [xemacs-hg @ 2002-01-26 22:02:52 by youngs]
youngs
parents: 711
diff changeset
1802 (make-face 'zmacs-region "Used on highlighted region between point and mark.")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 (make-face 'isearch "Used on region matched by isearch.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 (make-face 'isearch-secondary "Face to use for highlighting all matches.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 (make-face 'list-mode-item-selected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 "Face for the selected list item in list-mode.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 (make-face 'highlight "Highlight face.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 (make-face 'primary-selection "Primary selection face.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 (make-face 'secondary-selection "Secondary selection face.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 ;; Several useful color faces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 (dolist (color '(red green blue yellow))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 (make-face color (concat (symbol-name color) " text."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 (set-face-foreground color (symbol-name color) nil 'color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 ;; Make some useful faces. This happens very early, before creating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 ;; the first non-stream device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 (set-face-background 'text-cursor
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1820 '(((win default) . "Red3"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 ;; some older X servers don't recognize "darkseagreen2"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 (set-face-background 'highlight
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1825 '(((win default color) . "darkseagreen2")
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1826 ((win default color) . "green")
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1827 ((win default grayscale) . "gray53"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 (set-face-background-pixmap 'highlight
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1830 '(((win default mono) . "gray1"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 (set-face-background 'zmacs-region
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1834 '(((win default color) . "gray65")
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1835 ((win default grayscale) . "gray65"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 (set-face-background-pixmap 'zmacs-region
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1838 '(((win default mono) . "gray3"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 (set-face-background 'list-mode-item-selected
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1842 '(((win default color) . "gray68")
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1843 ((win default grayscale) . "gray68")
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1844 ((win default mono) . [default foreground]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 (set-face-foreground 'list-mode-item-selected
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1847 '(((win default mono) . [default background]))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 (set-face-background 'primary-selection
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1851 '(((win default color) . "gray65")
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1852 ((win default grayscale) . "gray65"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 (set-face-background-pixmap 'primary-selection
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1855 '(((win default mono) . "gray3"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 (set-face-background 'secondary-selection
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1859 '(((win default color) . "paleturquoise")
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1860 ((win default color) . "green")
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1861 ((win default grayscale) . "gray53"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 (set-face-background-pixmap 'secondary-selection
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1864 '(((win default mono) . "gray1"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 (set-face-background 'isearch
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1868 '(((win default color) . "paleturquoise")
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1869 ((win default color) . "green"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 ;; #### This should really, I mean *really*, be converted to some form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 ;; of `defface' one day.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 (set-face-foreground 'isearch-secondary
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
1875 '(((win default color) . "red3"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 ;; Define some logical color names to be used when reading the pixmap files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 (if (featurep 'xpm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 (setq xpm-color-symbols
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 (list
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1882 '("foreground" (face-foreground 'default))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1883 '("background" (face-background 'default))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1884 '("backgroundToolBarColor"
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1885 (or
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1886 (and
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1887 (featurep 'x)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1888 (x-get-resource "backgroundToolBarColor"
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1889 "BackgroundToolBarColor" 'string
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1890 nil nil 'warn))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1892 (face-background 'toolbar)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1893 '("foregroundToolBarColor"
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1894 (or
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1895 (and
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1896 (featurep 'x)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1897 (x-get-resource "foregroundToolBarColor"
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1898 "ForegroundToolBarColor" 'string
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1899 nil nil 'warn))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1900 (face-foreground 'toolbar)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 (when (featurep 'tty)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 (set-face-highlight-p 'bold t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 (set-face-underline-p 'italic t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 (set-face-highlight-p 'bold-italic t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 (set-face-underline-p 'bold-italic t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 (set-face-highlight-p 'highlight t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 (set-face-reverse-p 'text-cursor t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 (set-face-reverse-p 'modeline t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 (set-face-reverse-p 'zmacs-region t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 (set-face-reverse-p 'primary-selection t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 (set-face-underline-p 'secondary-selection t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 (set-face-reverse-p 'list-mode-item-selected t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 (set-face-reverse-p 'isearch t 'global '(default tty))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 ;;; faces.el ends here