annotate lisp/faces.el @ 25131:1d78cd7c460d

(finger): Don't do indirect fingering.
author Karl Heuer <kwzh@gnu.org>
date Fri, 30 Jul 1999 15:39:42 +0000
parents 4cd409210c7f
children 1bee9402f747
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1 ;;; faces.el --- Lisp faces
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
3 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
4 ;; Free Software Foundation, Inc.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
5
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
6 ;; This file is part of GNU Emacs.
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
7
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
9 ;; it under the terms of the GNU General Public License as published by
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
10 ;; the Free Software Foundation; either version 2, or (at your option)
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
11 ;; any later version.
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
12
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
13 ;; GNU Emacs is distributed in the hope that it will be useful,
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
16 ;; GNU General Public License for more details.
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
17
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
18 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 14040
diff changeset
21 ;; Boston, MA 02111-1307, USA.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
22
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
23 ;;; Commentary:
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
24
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
25 ;;; Code:
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
26
10107
2af74ff52cd0 At compile time, discard any defsubr definitions
Richard M. Stallman <rms@gnu.org>
parents: 10105
diff changeset
27 (eval-when-compile
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
28 (require 'custom)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
29 (require 'cl))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
30
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
31 (require 'cus-face)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
32
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
33
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
35 ;;; Font selection.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
37
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
38 (defgroup font-selection nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
39 "Influencing face font selection."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
40 :group 'faces)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
41
12562
a9b08e50d6ec (x-create-frame-with-faces): Set background-mode
Karl Heuer <kwzh@gnu.org>
parents: 12475
diff changeset
42
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
43 (defcustom face-font-selection-order
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
44 '(:width :height :weight :slant)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
45 "*A list specifying how face font selection chooses fonts.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
46 Each of the four symbols `:width', `:height', `:weight', and `:slant'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
47 must appear once in the list, and the list must not contain any other
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
48 elements. Font selection tries to find a best matching font for
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
49 those face attributes first that appear first in the list. For
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
50 example, if `:slant' appears before `:height', font selection first
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
51 tries to find a font with a suitable slant, even if this results in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
52 a font height that isn't optimal."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
53 :tag "Font selection order."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
54 :group 'font-selection
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
55 :set #'(lambda (symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
56 (set-default symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
57 (internal-set-font-selection-order value)))
17522
209c61e51bd0 (frame-set-background-mode): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17386
diff changeset
58
13725
9729af46fe60 Take optional arg FRAME.
Simon Marshall <simon@gnu.org>
parents: 13704
diff changeset
59
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
60 (defcustom face-font-family-alternatives
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
61 '(("courier" "fixed")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
62 ("helv" "helvetica" "fixed"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
63 "*Alist of alternative font family names.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
64 Each element has the the form (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
65 If fonts of family FAMILY can't be loaded, try ALTERNATIVE1, then
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
66 ALTERNATIVE2 etc."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
67 :tag "Alternative font families to try."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
68 :group 'font-selection
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
69 :set #'(lambda (symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
70 (set-default symbol value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
71 (internal-set-alternative-font-family-alist value)))
13725
9729af46fe60 Take optional arg FRAME.
Simon Marshall <simon@gnu.org>
parents: 13704
diff changeset
72
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
73
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
74
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
75 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
76 ;;; Creation, copying.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
77 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
78
3925
f286657c098e * faces.el (global-face-data): Doc fix.
Jim Blandy <jimb@redhat.com>
parents: 3911
diff changeset
79
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
80 (defun face-list ()
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
81 "Return a list of all defined face names."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
82 (mapcar #'car face-new-frame-defaults))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
83
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
84
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
85 ;;; ### If not frame-local initialize by what X resources?
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
86
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
87 (defun make-face (face &optional no-init-from-resources)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
88 "Define a new face with name FACE, a symbol.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
89 NO-INIT-FROM-RESOURCES non-nil means don't initialize frame-local
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
90 variants of FACE from X resources. (X resources recognized are found
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
91 in the global variable `face-x-resources'.) If FACE is already known
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
92 as a face, leave it unmodified. Value is FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
93 (interactive "SMake face: ")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
94 (unless (facep face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
95 ;; Make frame-local faces (this also makes the global one).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
96 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
97 (internal-make-lisp-face face frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
98 ;; Add the face to the face menu.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
99 (when (fboundp 'facemenu-add-new-face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
100 (facemenu-add-new-face face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
101 ;; Define frame-local faces for all frames from X resources.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
102 (unless no-init-from-resources
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
103 (make-face-x-resource-internal face)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
104 face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
105
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
106
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
107 (defun make-empty-face (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
108 "Define a new, empty face with name FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
109 If the face already exists, it is left unmodified. Value is FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
110 (interactive "SMake empty face: ")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
111 (make-face face 'no-init-from-resources))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
112
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
113
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
114 (defun copy-face (old-face new-face &optional frame new-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
115 "Define a face just like OLD-FACE, with name NEW-FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
116
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
117 If NEW-FACE already exists as a face, it is modified to be like
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
118 OLD-FACE. If it doesn't already exist, it is created.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
119
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
120 If the optional argument FRAME is given as a frame, NEW-FACE is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
121 changed on FRAME only.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
122 If FRAME is t, the frame-independent default specification for OLD-FACE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
123 is copied to NEW-FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
124 If FRAME is nil, copying is done for the frame-independent defaults
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
125 and for each existing frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
126
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
127 If the optional fourth argument NEW-FRAME is given,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
128 copy the information from face OLD-FACE on frame FRAME
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
129 to NEW-FACE on frame NEW-FRAME."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
130 (let ((inhibit-quit t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
131 (if (null frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
132 (progn
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
133 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
134 (copy-face old-face new-face frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
135 (copy-face old-face new-face t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
136 (internal-copy-lisp-face old-face new-face frame new-frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
137 new-face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
138
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
139
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
140
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
141 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
142 ;;; Obsolete functions
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
143 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
144
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
145 ;; The functions in this section are defined because Lisp packages use
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
146 ;; them, despite the prefix `internal-' suggesting that they are
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
147 ;; private to the face implementation.
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
148
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
149 (defun internal-find-face (name &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
150 "Retrieve the face named NAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
151 Return nil if there is no such face.
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
152 If the optional argument FRAME is given, this gets the face NAME for
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
153 that frame; otherwise, it uses the selected frame.
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
154 If FRAME is the symbol t, then the global, non-frame face is returned.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
155 If NAME is already a face, it is simply returned.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
156
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
157 This function is defined for compatibility with Emacs 20.2. It
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
158 should not be used anymore."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
159 (facep name))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
160
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
161
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
162 (defun internal-get-face (name &optional frame)
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
163 "Retrieve the face named NAME; error if there is none.
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
164 If the optional argument FRAME is given, this gets the face NAME for
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
165 that frame; otherwise, it uses the selected frame.
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
166 If FRAME is the symbol t, then the global, non-frame face is returned.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
167 If NAME is already a face, it is simply returned.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
168
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
169 This function is defined for compatibility with Emacs 20.2. It
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
170 should not be used anymore."
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
171 (or (internal-find-face name frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
172 (check-face name)))
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
173
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
174
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
175
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
177 ;;; Predicates, type checks.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
179
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
180 (defun facep (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
181 "Return non-nil if FACE is a face name."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
182 (internal-lisp-face-p face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
183
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
184
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
185 (defun check-face (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
186 "Signal an error if FACE doesn't name a face.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
187 Value is FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
188 (unless (facep face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
189 (error "Not a face: %s" face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
190 face)
2744
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
191
f4fc0c4c76f9 Re-arranged stuff to put defsubst accessors at the top
Jim Blandy <jimb@redhat.com>
parents: 2715
diff changeset
192
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
193 ;; The ID returned is not to be confused with the internally used IDs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
194 ;; of realized faces. The ID assigned to Lisp faces is used to
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
195 ;; support faces in display table entries.
17386
b251c8820860 (make-face): New arg no-resources.
Richard M. Stallman <rms@gnu.org>
parents: 17173
diff changeset
196
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
197 (defun face-id (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
198 "Return the interNal ID of face with name FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
199 If optional argument FRAME is nil or omitted, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
200 (check-face face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
201 (get face 'face))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
202
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
203
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
204 (defun face-equal (face1 face2 &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
205 "Non-nil if faces FACE1 and FACE2 are equal.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
206 Faces are considered equal if all their attributes are equal.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
207 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
208 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
209 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
210 (internal-lisp-face-equal-p face1 face2 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
211
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
212
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
213 (defun face-differs-from-default-p (face &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
214 "Non-nil if FACE displays differently from the default face.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
215 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
216 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
217 If FRAME is omitted or nil, use the selected frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
218 A face is considered to be ``the same'' as the default face if it is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
219 actually specified in the same way (equal attributes) or if it is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
220 fully-unspecified, and thus inherits the attributes of any face it
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
221 is displayed on top of."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
222 (or (internal-lisp-face-empty-p face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
223 (not (internal-lisp-face-equal-p face 'default frame))))
10379
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
224
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
225
10379
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
226 (defun face-nontrivial-p (face &optional frame)
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
227 "True if face FACE has some non-nil attribute.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
228 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
229 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
230 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
231 (not (internal-lisp-face-empty-p face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
232
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
233
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
234
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
235 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
236 ;;; Setting face attributes from X resources.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
237 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
238
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
239 (defcustom face-x-resources
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
240 '((:family (".attributeFamily" . "Face.AttributeFamily"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
241 (:width (".attributeWidth" . "Face.AttributeWidth"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
242 (:height (".attributeHeight" . "Face.AttributeHeight"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
243 (:weight (".attributeWeight" . "Face.AttributeWeight"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
244 (:slant (".attributeSlant" . "Face.AttributeSlant"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
245 (:foreground (".attributeForeground" . "Face.AttributeForeground"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
246 (:background (".attributeBackground" . "Face.AttributeBackground"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
247 (:overline (".attributeOverline" . "Face.AttributeOverline"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
248 (:strike-through (".attributeStrikeThrough" . "Face.AttributeStrikeThrough"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
249 (:box (".attributeBox" . "Face.AttributeBox"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
250 (:underline (".attributeUnderline" . "Face.AttributeUnderline"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
251 (:inverse-video (".attributeInverse" . "Face.AttributeInverse"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
252 (:stipple
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
253 (".attributeStipple" . "Face.AttributeStipple")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
254 (".attributeBackgroundPixmap" . "Face.AttributeBackgroundPixmap"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
255 (:font (".attributeFont" . "Face.AttributeFont"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
256 (:bold (".attributeBold" . "Face.AttributeBold"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
257 (:italic (".attributeItalic" . "Face.AttributeItalic"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
258 (:font (".attributeFont" . "Face.AttributeFont")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
259 "*List of X resources and classes for face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
260 Each element has the form (ATTRIBUTE ENTRY1 ENTRY2...) where ATTRIBUTE is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
261 the name of a face attribute, and each ENTRY is a cons of the form
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
262 (RESOURCE . CLASS) with RESOURCE being the resource and CLASS being the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
263 X resource class for the attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
264 :type 'sexp
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
265 :group 'faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
266
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
267
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
268 (defun set-face-attribute-from-resource (face attribute resource class frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
269 "Set FACE's ATTRIBUTE from X resource RESOURCE, class CLASS on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
270 Value is the attribute value specified by the resource, or nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
271 if not present. This function displays a message if the resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
272 specifies an invalid attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
273 (let* ((face-name (face-name face))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
274 (value (internal-face-x-get-resource (concat face-name resource)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
275 class frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
276 (when value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
277 (condition-case ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
278 (internal-set-lisp-face-attribute-from-resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
279 face attribute (downcase value) frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
280 (error
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
281 (message "Face %s, frame %s: invalid attribute %s %s from X resource"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
282 face-name frame attribute value))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
283 value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
284
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
285
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
286 (defun set-face-attributes-from-resources (face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
287 "Set attributes of FACE from X resources for FRAME."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
288 (when (memq (framep frame) '(x w32))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
289 (dolist (definition face-x-resources)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
290 (let ((attribute (car definition)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
291 (dolist (entry (cdr definition))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
292 (set-face-attribute-from-resource face attribute (car entry)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
293 (cdr entry) frame))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
294
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
295
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
296 (defun make-face-x-resource-internal (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
297 "Fill frame-local FACE on FRAME from X resources.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
298 FRAME nil or not specified means do it for all frames."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
299 (if (null frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
300 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
301 (set-face-attributes-from-resources face frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
302 (set-face-attributes-from-resources face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
303
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
304
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
305
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
306 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
307 ;;; Retrieving face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
308 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
309
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
310 (defun face-name (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
311 "Return the name of face FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
312 (symbol-name (check-face face)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
313
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
314
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
315 (defun face-attribute (face attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
316 "Return the value of FACE's ATTRIBUTE on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
317 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
318 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
319 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
320 (internal-get-lisp-face-attribute face attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
321
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
322
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
323 (defun face-foreground (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
324 "Return the foreground color name of FACE, or nil if unspecified.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
325 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
326 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
327 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
328 (internal-get-lisp-face-attribute face :foreground frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
329
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
330
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
331 (defun face-background (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
332 "Return the background color name of FACE, or nil if unspecified.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
333 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
334 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
335 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
336 (internal-get-lisp-face-attribute face :background frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
337
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
338
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
339 (defun face-stipple (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
340 "Return the stipple pixmap name of FACE, or nil if unspecified.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
341 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
342 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
343 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
344 (internal-get-lisp-face-attribute face :stipple frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
345
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
346
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
347 (defalias 'face-background-pixmap 'face-stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
348
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
349
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
350 (defun face-underline-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
351 "Return non-nil if FACE is underlined.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
352 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
353 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
354 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
355 (eq (face-attribute face :underline frame) t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
356
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
357
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
358 (defun face-inverse-video-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
359 "Return non-nil if FACE is in inverse video on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
360 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
361 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
362 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
363 (eq (face-attribute face :inverse-video frame) t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
364
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
365
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
366 (defun face-bold-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
367 "Return non-nil if the font of FACE is bold on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
368 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
369 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
370 If FRAME is omitted or nil, use the selected frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
371 Use `face-attribute' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
372 (let ((bold (face-attribute face :weight frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
373 (not (memq bold '(normal unspecified)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
374
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
375
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
376 (defun face-italic-p (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
377 "Return non-nil if the font of FACE is italic on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
378 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
379 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
380 If FRAME is omitted or nil, use the selected frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
381 Use `face-attribute' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
382 (let ((italic (face-attribute face :slant frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
383 (not (memq italic '(normal unspecified)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
384
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
385
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
386
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
387
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
388
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
389 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
390 ;;; Face documentation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
391 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
392
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
393 (defun face-documentation (face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
394 "Get the documentation string for FACE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
395 (get face 'face-documentation))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
396
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
397
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
398 (defun set-face-documentation (face string)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
399 "Set the documentation string for FACE to STRING."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
400 (put face 'face-documentation string))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
401
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
402
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
403 (defalias 'face-doc-string 'face-documentation)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
404 (defalias 'set-face-doc-string 'set-face-documentation)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
405
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
406
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
407
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
408 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
409 ;; Setting face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
410 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
411
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
412
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
413 (defun set-face-attribute (face frame &rest args)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
414 "Set attributes of FACE on FRAME from ARGS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
415
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
416 FRAME nil means change attributes on all frames. FRAME t means change
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
417 the default for new frames (this is done automatically each time an
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
418 attribute is changed on all frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
419
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
420 ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a valid
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
421 face attribute name. All attributes can be set to `unspecified';
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
422 this fact is not further mentioned below.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
423
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
424 The following attributes are recognized:
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
425
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
426 `:family'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
427
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
428 VALUE must be a string specifying the font family, e.g. ``courier'',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
429 or a fontset alias name. If a font family is specified, wild-cards `*'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
430 and `?' are allowed.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
431
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
432 `:width'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
433
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
434 VALUE specifies the relative proportionate width of the font to use.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
435 It must be one of the symbols `ultra-condensed', `extra-condensed',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
436 `condensed', `semi-condensed', `normal', `semi-expanded', `expanded',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
437 `extra-expanded', or `ultra-expanded'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
438
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
439 `:height'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
440
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
441 VALUE must be an integer specifying the height of the font to use in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
442 1/10 pt.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
443
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
444 `:weight'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
445
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
446 VALUE specifies the weight of the font to use. It must be one of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
447 symbols `ultra-bold', `extra-bold', `bold', `semi-bold', `normal',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
448 `semi-light', `light', `extra-light', `ultra-light'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
449
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
450 `:slant'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
451
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
452 VALUE specifies the slant of the font to use. It must be one of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
453 symbols `italic', `oblique', `normal', `reverse-italic', or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
454 `reverse-oblique'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
455
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
456 `:foreground', `:background'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
457
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
458 VALUE must be a color name, a string.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
459
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
460 `:underline'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
461
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
462 VALUE specifies whether characters in FACE should be underlined. If
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
463 VALUE is t, underline with foreground color of the face. If VALUE is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
464 a string, underline with that color. If VALUE is nil, explicitly
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
465 don't underline.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
466
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
467 `:overline'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
468
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
469 VALUE specifies whether characters in FACE should be overlined. If
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
470 VALUE is t, overline with foreground color of the face. If VALUE is a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
471 string, overline with that color. If VALUE is nil, explicitly don't
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
472 overline.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
473
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
474 `:strike-through'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
475
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
476 VALUE specifies whether characters in FACE should be drawn with a line
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
477 striking through them. If VALUE is t, use the foreground color of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
478 face. If VALUE is a string, strike-through with that color. If VALUE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
479 is nil, explicitly don't strike through.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
480
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
481 `:box'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
482
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
483 VALUE specifies whether characters in FACE should have a box drawn
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
484 around them. If VALUE is nil, explicitly don't draw boxes. If
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
485 VALUE is t, draw a box with lines of width 1 in the foreground color
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
486 of the face. If VALUE is a string, the string must be a color name,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
487 and the box is drawn in that color with a line width of 1. Otherwise,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
488 VALUE must be a property list of the form `(:line-width WIDTH
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
489 :color COLOR :style STYLE)'. If a keyword/value pair is missing from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
490 the property list, a default value will be used for the value, as
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
491 specified below. WIDTH specifies the width of the lines to draw; it
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
492 defaults to 1. COLOR is the name of the color to draw in, default is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
493 the foreground color of the face for simple boxes, and the background
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
494 color of the face for 3D boxes. STYLE specifies whether a 3D box
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
495 should be draw. If STYLE is `released-button', draw a box looking
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
496 like a released 3D button. If STYLE is `pressed-button' draw a box
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
497 that appears like a pressed button. If STYLE is nil, the default if
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
498 the property list doesn't contain a style specification, draw a 2D
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
499 box.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
500
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
501 `:inverse-video'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
502
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
503 VALUE specifies whether characters in FACE should be displayed in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
504 inverse video. VALUE must be one of t or nil.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
505
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
506 `:stipple'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
507
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
508 If VALUE is a string, it must be the name of a file of pixmap data.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
509 The directories listed in the `x-bitmap-file-path' variable are
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
510 searched. Alternatively, VALUE may be a list of the form (WIDTH
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
511 HEIGHT DATA) where WIDTH and HEIGHT are the size in pixels, and DATA
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
512 is a string containing the raw bits of the bitmap. VALUE nil means
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
513 explicitly don't use a stipple pattern.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
514
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
515 For convenience, attributes `:family', `:width', `:height', `:weight',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
516 and `:slant' may also be set in one step from an X font name:
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
517
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
518 `:font'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
519
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
520 Set font-related face attributes from VALUE. VALUE must be a valid
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
521 XLFD font name. If it is a font name pattern, the first matching font
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
522 will be used.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
523
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
524 For compatibility with Emacs 20, keywords `:bold' and `:italic' can
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
525 be used to specify that a bold or italic font should be used. VALUE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
526 must be t or nil in that case. A value of `unspecified' is not allowed."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
527 (cond ((null frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
528 ;; Change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
529 (dolist (frame (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
530 (apply #'set-face-attribute face frame args))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
531 ;; Record that as a default for new frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
532 (apply #'set-face-attribute face t args))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
533 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
534 (while args
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
535 (internal-set-lisp-face-attribute face (car args)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
536 (car (cdr args)) frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
537 (setq args (cdr (cdr args)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
538
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
539
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
540 (defun make-face-bold (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
541 "Make the font of FACE be bold, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
542 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
543 Use `set-face-attribute' for finer control of the font weight."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
544 (interactive (list (read-face-name "Make which face bold: ")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
545 (set-face-attribute face frame :weight 'bold))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
546
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
547
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
548 (defun make-face-unbold (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
549 "Make the font of FACE be non-bold, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
550 FRAME nil or not specified means change face on all frames."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
551 (interactive (list (read-face-name "Make which face non-bold: ")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
552 (set-face-attribute face frame :weight 'normal))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
553
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
554
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
555 (defun make-face-italic (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
556 "Make the font of FACE be italic, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
557 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
558 Use `set-face-attribute' for finer control of the font slant."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
559 (interactive (list (read-face-name "Make which face italic: ")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
560 (set-face-attribute face frame :slant 'italic))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
561
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
562
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
563 (defun make-face-unitalic (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
564 "Make the font of FACE be non-italic, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
565 FRAME nil or not specified means change face on all frames."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
566 (interactive (list (read-face-name "Make which face non-italic: ")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
567 (set-face-attribute face frame :slant 'normal))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
568
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
569
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
570 (defun make-face-bold-italic (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
571 "Make the font of FACE be bold and italic, if possible.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
572 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
573 Use `set-face-attribute' for finer control of font weight and slant."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
574 (interactive (list (read-face-name "Make which face bold-italic: ")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
575 (set-face-attribute face frame :weight 'bold :slant 'italic))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
576
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
577
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
578 (defun set-face-font (face font &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
579 "Change font-related attributes of FACE to those of FONT (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
580 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
581 This sets the attributes `:family', `:width', `:height', `:weight',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
582 and `:slant'. When called interactively, prompt for the face and font."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
583 (interactive (read-face-and-attribute :font))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
584 (set-face-attribute face frame :font font))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
585
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
586
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
587 ;; Implementation note: Emulating gray background colors with a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
588 ;; stipple pattern is now part of the face realization process, and is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
589 ;; done in C depending on the frame on which the face is realized.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
590
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
591 (defun set-face-background (face color &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
592 "Change the background color of face FACE to COLOR (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
593 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
594 When called interactively, prompt for the face and color."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
595 (interactive (read-face-and-attribute :background))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
596 (set-face-attribute face frame :background color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
597
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
598
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
599 (defun set-face-foreground (face color &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
600 "Change the foreground color of face FACE to COLOR (a string).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
601 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
602 When called interactively, prompt for the face and color."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
603 (interactive (read-face-and-attribute :foreground))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
604 (set-face-attribute face frame :foreground color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
605
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
606
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
607 (defun set-face-stipple (face stipple &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
608 "Change the stipple pixmap of face FACE to STIPPLE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
609 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
610 STIPPLE. should be a string, the name of a file of pixmap data.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
611 The directories listed in the `x-bitmap-file-path' variable are searched.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
612
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
613 Alternatively, STIPPLE may be a list of the form (WIDTH HEIGHT DATA)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
614 where WIDTH and HEIGHT are the size in pixels,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
615 and DATA is a string, containing the raw bits of the bitmap."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
616 (interactive (read-face-and-attribute :stipple))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
617 (set-face-attribute face frame :stipple stipple))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
618
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
619
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
620 (defun set-face-underline (face underline &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
621 "Specify whether face FACE is underlined.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
622 UNDERLINE nil means FACE explicitly doesn't underline.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
623 UNDERLINE non-nil means FACE explicitly does underlining
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
624 with the same of the foreground color.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
625 If UNDERLINE is a string, underline with the color named UNDERLINE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
626 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
627 Use `set-face-attribute' to ``unspecify'' underlining."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
628 (interactive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
629 (let ((list (read-face-and-attribute :underline)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
630 (list (car list) (eq (car (cdr list)) t))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
631 (set-face-attribute face frame :underline underline))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
632
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
633
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
634 (defun set-face-underline-p (face underline-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
635 "Specify whether face FACE is underlined.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
636 UNDERLINE-P nil means FACE explicitly doesn't underline.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
637 UNDERLINE-P non-nil means FACE explicitly does underlining.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
638 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
639 Use `set-face-attribute' to ``unspecify'' underlining."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
640 (interactive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
641 (let ((list (read-face-and-attribute :underline)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
642 (list (car list) (eq (car (cdr list)) t))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
643 (set-face-attribute face frame :underline underline-p))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
644
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
645
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
646 (defun set-face-inverse-video-p (face inverse-video-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
647 "Specify whether face FACE is in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
648 INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
649 INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
650 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
651 Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
652 (interactive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
653 (let ((list (read-face-and-attribute :inverse-video)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
654 (list (car list) (eq (car (cdr list)) t))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
655 (set-face-attribute face frame :inverse-video inverse-video-p))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
656
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
657
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
658 (defun set-face-bold-p (face bold-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
659 "Specify whether face FACE is bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
660 BOLD-P non-nil means FACE should explicitly display bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
661 BOLD-P nil means FACE should explicitly display non-bold.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
662 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
663 Use `set-face-attribute' or `modify-face' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
664 (if (null bold-p)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
665 (make-face-unbold face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
666 (make-face-bold face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
667
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
668
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
669 (defun set-face-italic-p (face italic-p &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
670 "Specify whether face FACE is italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
671 ITALIC-P non-nil means FACE should explicitly display italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
672 ITALIC-P nil means FACE should explicitly display non-italic.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
673 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
674 Use `set-face-attribute' or `modify-face' for finer control."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
675 (if (null italic-p)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
676 (make-face-unitalic face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
677 (make-face-italic face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
678
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
679
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
680 (defalias 'set-face-background-pixmap 'set-face-stipple)
10379
f9d713e8c77c (face-nontrivial-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10375
diff changeset
681
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
682
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
683 (defun invert-face (face &optional frame)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
684 "Swap the foreground and background colors of FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
685 FRAME nil or not specified means change face on all frames.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
686 If FACE specifies neither foreground nor background color,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
687 set its foreground and background to the background and foreground
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
688 of the default face. Value is FACE."
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
689 (interactive (list (read-face-name "Invert face: ")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
690 (let ((fg (face-attribute face :foreground frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
691 (bg (face-attribute face :background frame)))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
692 (if (or fg bg)
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
693 (set-face-attribute face frame :foreground bg :background fg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
694 (set-face-attribute face frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
695 :foreground
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
696 (face-attribute 'default :background frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
697 :background
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
698 (face-attribute 'default :foreground frame))))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
699 face)
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
700
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
701
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
702 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
703 ;;; Interactively modifying faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
704 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
705
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
706 (defun read-face-name (prompt)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
707 "Read and return a face symbol, prompting with PROMPT.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
708 Value is a symbol naming a known face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
709 (let ((face-list (mapcar #'(lambda (x) (cons (symbol-name x) x))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
710 (face-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
711 face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
712 (while (equal "" (setq face (completing-read prompt face-list nil t))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
713 (intern face)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
714
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
715
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
716 (defun face-valid-attribute-values (attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
717 "Return valid values for face attribute ATTRIBUTE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
718 The optional argument FRAME is used to determine available fonts
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
719 and colors. If it is nil or not specified, the selected frame is
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
720 used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
721 out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
722 an integer value."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
723 (case attribute
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
724 (:family
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
725 (if window-system
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
726 (mapcar #'(lambda (x) (cons (car x) (car x)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
727 (x-font-family-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
728 ;; Only one font on TTYs.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
729 (cons "default" "default")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
730 ((:width :weight :slant :inverse-video)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
731 (mapcar #'(lambda (x) (cons (symbol-name x) x))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
732 (internal-lisp-face-attribute-values attribute)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
733 ((:underline :overline :strike-through :box)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
734 (if window-system
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
735 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
736 (internal-lisp-face-attribute-values attribute))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
737 (mapcar #'(lambda (c) (cons c c))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
738 (x-defined-colors frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
739 (mapcar #'(lambda (x) (cons (symbol-name x) x))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
740 (internal-lisp-face-attribute-values attribute))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
741 ((:foreground :background)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
742 (mapcar #'(lambda (c) (cons c c))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
743 (or (and window-system (x-defined-colors frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
744 (tty-defined-colors))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
745 ((:height)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
746 'integerp)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
747 (:stipple
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
748 (and window-system
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
749 (mapcar #'list
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
750 (apply #'nconc (mapcar #'directory-files
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
751 x-bitmap-file-path)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
752 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
753 (error "Internal error"))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
754
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
755
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
756 (defvar face-attribute-name-alist
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
757 '((:family . "font family")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
758 (:width . "character set width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
759 (:height . "height in 1/10 pt")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
760 (:weight . "weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
761 (:slant . "slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
762 (:underline . "underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
763 (:overline . "overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
764 (:strike-through . "strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
765 (:box . "box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
766 (:inverse-video . "inverse-video display")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
767 (:foreground . "foreground color")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
768 (:background . "background color")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
769 (:stipple . "background stipple"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
770 "An alist of descriptive names for face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
771 Each element has the form (ATTRIBUTE-NAME . DESCRIPTION) where
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
772 ATTRIBUTE-NAME is a face attribute name (a keyword symbol), and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
773 DESCRIPTION is a descriptive name for ATTRIBUTE-NAME.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
774
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
775
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
776 (defun face-descriptive-attribute-name (attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
777 "Return a descriptive name for ATTRIBUTE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
778 (cdr (assq attribute face-attribute-name-alist)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
779
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
780
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
781 (defun face-read-string (face default name &optional completion-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
782 "Interactively read a face attribute string value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
783 FACE is the face whose attribute is read. DEFAULT is the default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
784 value to return if no new value is entered. NAME is a descriptive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
785 name of the attribute for prompting. COMPLETION-ALIST is an alist
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
786 of valid values, if non-nil.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
787
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
788 Entering ``none'' as attribute value means an unspecified attribute
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
789 value. Entering nothing accepts the default value DEFAULT.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
790
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
791 Value is the new attribute value."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
792 (let* ((completion-ignore-case t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
793 (value (completing-read
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
794 (if default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
795 (format "Set face %s %s (default %s): "
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
796 face name (downcase (if (symbolp default)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
797 (symbol-name default)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
798 default)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
799 (format "Set face %s %s: " face name))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
800 completion-alist)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
801 (if (equal value "none")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
802 nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
803 (if (equal value "") default value))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
804
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
805
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
806 (defun face-read-integer (face default name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
807 "Interactively read an integer face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
808 FACE is the face whose attribute is read. DEFAULT is the default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
809 value to return if no new value is entered. NAME is a descriptive
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
810 name of the attribute for prompting. Value is the new attribute value."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
811 (let ((new-value (face-read-string face
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
812 (and default (int-to-string default))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
813 name)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
814 (and new-value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
815 (string-to-int new-value))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
816
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
817
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
818 (defun read-face-attribute (face attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
819 "Interactively read a new value for FACE's ATTRIBUTE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
820 Optional argument FRAME nil or unspecified means read an attribute value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
821 of a global face. Value is the new attribute value."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
822 (let* ((old-value (face-attribute face attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
823 (attribute-name (face-descriptive-attribute-name attribute))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
824 (valid (face-valid-attribute-values attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
825 new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
826 ;; Represent complex attribute values as strings by printing them
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
827 ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
828 ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
829 ;; SHADOW)'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
830 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
831 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
832 (or (consp old-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
833 (vectorp old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
834 (setq old-value (prin1-to-string old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
835 (cond ((listp valid)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
836 (setq new-value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
837 (cdr (assoc (face-read-string face old-value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
838 attribute-name valid)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
839 valid))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
840 ((eq valid 'integerp)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
841 (setq new-value (face-read-integer face old-value attribute-name)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
842 (t (error "Internal error")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
843 ;; Convert stipple and box value text we read back to a list or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
844 ;; vector if it looks like one. This makes the assumption that a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
845 ;; pixmap file name won't start with an open-paren.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
846 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
847 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
848 (stringp new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
849 (string-match "^[[(]" new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
850 (setq new-value (read new-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
851 new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
852
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
853
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
854 (defun read-face-font (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
855 "Read the name of a font for FACE on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
856 If optional argument FRAME Is nil or omitted, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
857 (let ((completion-ignore-case t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
858 (completing-read "Set font attributes of face %s from font: "
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
859 face (x-list-fonts "*" nil frame))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
860
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
861
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
862 (defun read-all-face-attributes (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
863 "Interactively read all attributes for FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
864 If optional argument FRAME Is nil or omitted, use the selected frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
865 Value is a property list of attribute names and new values."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
866 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
867 (dolist (attribute face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
868 (setq result (cons (car attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
869 (cons (read-face-attribute face (car attribute) frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
870 result))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
871
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
872
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
873 (defun modify-face (&optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
874 "Modify attributes of faces interactively.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
875 If optional argument FRAME is nil or omitted, modify the face used
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
876 for newly created frame, i.e. the global face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
877 (interactive)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
878 (let ((face (read-face-name "Modify face: ")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
879 (apply #'set-face-attribute face frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
880 (read-all-face-attributes face frame))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
881
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
882
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
883 (defun read-face-and-attribute (attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
884 "Read face name and face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
885 ATTRIBUTE is the attribute whose new value is read.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
886 FRAME nil or unspecified means read attribute value of global face.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
887 Value is a list (FACE NEW-VALUE) where FACE is the face read
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
888 (a symbol), and NEW-VALUE is value read."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
889 (cond ((eq attribute :font)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
890 (let* ((prompt (format "Set font-related attributes of face: "))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
891 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
892 (font (read-face-font face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
893 (list face font)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
894 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
895 (let* ((attribute-name (face-descriptive-attribute-name attribute))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
896 (prompt (format "Set %s of face: " attribute-name))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
897 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
898 (new-value (read-face-attribute face attribute frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
899 (list face new-value)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
900
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
901
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
902
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
903 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
904 ;;; Listing faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
905 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
906
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
907 (defvar list-faces-sample-text
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
908 "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
909 "*Text string to display as the sample text for `list-faces-display'.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
910
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
911
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
912 ;; The name list-faces would be more consistent, but let's avoid a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
913 ;; conflict with Lucid, which uses that name differently.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
914
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
915 (defun list-faces-display ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
916 "List all faces, using the same sample text in each.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
917 The sample text is a string that comes from the variable
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
918 `list-faces-sample-text'."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
919 (interactive)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
920 (let ((faces (sort (face-list) #'string-lessp))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
921 (face nil)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
922 (frame (selected-frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
923 disp-frame window)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
924 (with-output-to-temp-buffer "*Faces*"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
925 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
926 (set-buffer standard-output)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
927 (setq truncate-lines t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
928 (while faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
929 (setq face (car faces))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
930 (setq faces (cdr faces))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
931 (insert (format "%25s " (face-name face)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
932 (let ((beg (point)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
933 (insert list-faces-sample-text)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
934 (insert "\n")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
935 (put-text-property beg (1- (point)) 'face face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
936 ;; If the sample text has multiple lines, line up all of them.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
937 (goto-char beg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
938 (forward-line 1)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
939 (while (not (eobp))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
940 (insert " ")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
941 (forward-line 1))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
942 (goto-char (point-min)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
943 (print-help-return-message))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
944 ;; If the *Faces* buffer appears in a different frame,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
945 ;; copy all the face definitions from FRAME,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
946 ;; so that the display will reflect the frame that was selected.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
947 (setq window (get-buffer-window (get-buffer "*Faces*") t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
948 (setq disp-frame (if window (window-frame window)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
949 (car (frame-list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
950 (or (eq frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
951 (let ((faces (face-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
952 (while faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
953 (copy-face (car faces) (car faces) frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
954 (setq faces (cdr faces)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
955
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
956
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
957 (defun describe-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
958 "Display the properties of face FACE on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
959 If the optional argument FRAME is given, report on face FACE in that frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
960 If FRAME is t, report on the defaults for face FACE (for new frames).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
961 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
962 (interactive (list (read-face-name "Describe face: ")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
963 (let* ((attrs '((:family . "Family")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
964 (:width . "Width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
965 (:height . "Height")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
966 (:weight . "Weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
967 (:slant . "Slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
968 (:foreground . "Foreground")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
969 (:background . "Background")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
970 (:underline . "Underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
971 (:overline . "Overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
972 (:strike-through . "Strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
973 (:box . "Box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
974 (:inverse-video . "Inverse")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
975 (:stipple . "Stipple")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
976 (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
977 attrs))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
978 (with-output-to-temp-buffer "*Help*"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
979 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
980 (set-buffer standard-output)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
981 (dolist (a attrs)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
982 (let ((attr (face-attribute face (car a) frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
983 (insert (make-string (- max-width (length (cdr a))) ?\ )
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
984 (cdr a) ": " (format "%s" attr) "\n")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
985 (insert "\nDocumentation:\n\n"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
986 (or (face-documentation face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
987 "not documented as a face.")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
988 (print-help-return-message))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
989
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
990
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
991
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
992
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
993 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
994 ;;; Face specifications (defface).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
995 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
996
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
997 ;; Parameter FRAME Is kept for call compatibility to with previous
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
998 ;; face implementation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
999
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1000 (defun face-attr-construct (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1001 "Return a defface-style attribute list for FACE on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1002 Value is a property list of pairs ATTRIBUTE VALUE for all specified
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1003 face attributes of FACE where ATTRIBUTE is the attribute name and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1004 VALUE is the specified value of that attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1005 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1006 (dolist (entry face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1007 (let* ((attribute (car entry))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1008 (value (face-attribute face attribute)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1009 (unless (eq value 'unspecified)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1010 (setq result (nconc (list attribute value) result)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1011
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1013 (defun face-spec-set-match-display (display frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1014 "Non-nil if DISPLAY matches FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1015 DISPLAY is part of a spec such as can be used in `defface'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1016 If FRAME is nil, the current FRAME is used."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1017 (let* ((conjuncts display)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1018 conjunct req options
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1019 ;; t means we have succeeded against all the conjuncts in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1020 ;; DISPLAY that have been tested so far.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1021 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1022 (if (eq conjuncts t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1023 (setq conjuncts nil))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1024 (while (and conjuncts match)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1025 (setq conjunct (car conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1026 conjuncts (cdr conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1027 req (car conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1028 options (cdr conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1029 match (cond ((eq req 'type)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1030 (or (memq window-system options)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1031 (and (null window-system)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1032 (memq 'tty options))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1033 ((eq req 'class)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1034 (memq (frame-parameter frame 'display-type) options))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1035 ((eq req 'background)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1036 (memq (frame-parameter frame 'background-mode)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1037 options))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1038 (t (error "Unknown req `%S' with options `%S'"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1039 req options)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1040 match))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1041
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1042
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1043 (defun face-spec-choose (spec &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1044 "Choose the proper attributes for FRAME, out of SPEC."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1045 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1046 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1047 (let ((tail spec)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1048 result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1049 (while tail
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1050 (let* ((entry (car tail))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1051 (display (nth 0 entry))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1052 (attrs (nth 1 entry)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1053 (setq tail (cdr tail))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1054 (when (face-spec-set-match-display display frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1055 (setq result attrs tail nil))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1056 result))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1057
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1058
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1059 (defun face-spec-reset-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1060 "Reset all attributes of FACE on FRAME to unspecified."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1061 (let ((attrs face-attribute-name-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1062 params)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1063 (while attrs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1064 (let ((attr-and-name (car attrs)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1065 (setq params (cons (car attr-and-name) (cons 'unspecified params))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1066 (setq attrs (cdr attrs)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1067 (apply #'set-face-attribute face frame params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1068
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1069
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1070 (defun face-spec-set (face spec &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1071 "Set FACE's attributes according to the first matching entry in SPEC.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1072 FRAME is the frame whose frame-local face is set. FRAME nil means
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1073 do it on all frames. See `defface' for information about SPEC."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1074 (let ((attrs (face-spec-choose spec frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1075 params)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1076 (while attrs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1077 (let ((attribute (car attrs))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1078 (value (car (cdr attrs))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1079 ;; Support some old-style attribute names and values.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1080 (case attribute
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1081 (:bold (setq attribute :weight value (if value 'bold 'normal)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1082 (:italic (setq attribute :slant value (if value 'italic 'normal))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1083 (setq params (cons attribute (cons value params))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1084 (setq attrs (cdr (cdr attrs))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1085 (face-spec-reset-face face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1086 (apply #'set-face-attribute face frame params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1087
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1088
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1089 (defun face-attr-match-p (face attrs &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1090 "Value is non-nil if attributes of FACE match values in plist ATTRS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1091 Optional parameter FRAME is the frame whose definition of FACE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1092 is used. If nil or omitted, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1093 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1094 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1095 (let ((list face-attribute-name-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1096 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1097 (while (and match (not (null list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1098 (let* ((attr (car (car list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1099 (specified-value (plist-get attrs attr))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1100 (value-now (face-attribute face attr frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1101 (when specified-value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1102 (setq match (equal specified-value value-now)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1103 (setq list (cdr list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1104 match))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1105
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1106
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1107 (defun face-spec-match-p (face spec &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1108 "Return t if FACE, on FRAME, matches what SPEC says it should look like."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1109 (face-attr-match-p face (face-spec-choose spec frame) frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1110
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1111
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1112
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1114 ;;; Background mode.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1115 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1116
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1117 (defcustom frame-background-mode nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1118 "*The brightness of the background.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1119 Set this to the symbol `dark' if your background color is dark, `light' if
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1120 your background is light, or nil (default) if you want Emacs to
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1121 examine the brightness for you."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1122 :group 'faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1123 :set #'(lambda (var value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1124 (set var value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1125 (mapcar 'frame-set-background-mode (frame-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1126 :initialize 'custom-initialize-changed
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1127 :type '(choice (choice-item dark)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1128 (choice-item light)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1129 (choice-item :tag "default" nil)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1130
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1131
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1132 (defun frame-set-background-mode (frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1133 "Set up the `background-mode' and `display-type' frame parameters for FRAME."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1134 (let* ((bg-resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1135 (and window-system
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1136 (x-get-resource ".backgroundMode" "BackgroundMode")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1137 (params (frame-parameters frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1138 (bg-mode (cond (frame-background-mode)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1139 ((null window-system)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1140 ;; No way to determine this automatically (?).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1141 'dark)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1142 (bg-resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1143 (intern (downcase bg-resource)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1144 ((< (apply '+ (x-color-values
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1145 (cdr (assq 'background-color
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1146 params))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1147 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1148 ;; Just looking at the screen, colors whose
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1149 ;; values add up to .6 of the white total
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1150 ;; still look dark to me.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1151 (* (apply '+ (x-color-values "white" frame)) .6))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1152 'dark)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1153 (t 'light)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1154 (display-type (cond ((null window-system)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1155 (if (tty-display-color-p) 'color 'mono))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1156 ((x-display-color-p frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1157 'color)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1158 ((x-display-grayscale-p frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1159 'grayscale)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1160 (t 'mono))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1161 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1162 (list (cons 'background-mode bg-mode)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1163 (cons 'display-type display-type))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1164
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1165 ;; For all named faces, choose face specs matching the new frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1166 ;; parameters.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1167 (let ((face-list (face-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1168 (while face-list
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1169 (let* ((face (car face-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1170 (spec (get face 'face-defface-spec)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1171 (when spec
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1172 (face-spec-set face spec frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1173 (setq face-list (cdr face-list))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1174
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1175
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1176
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1177
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1179 ;;; Frame creation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1180 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1181
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1182 (defun x-handle-named-frame-geometry (parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1183 "Add geometry parameters for a named frame to parameter list PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1184 Value is the new parameter list."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1185 (let* ((name (or (cdr (assq 'name parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1186 (cdr (assq 'name default-frame-alist))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1187 (x-resource-name name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1188 (res-geometry (if name (x-get-resource "geometry" "Geometry"))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1189 (when res-geometry
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1190 (let ((parsed (x-parse-geometry res-geometry)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1191 ;; If the resource specifies a position, call the position
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1192 ;; and size "user-specified".
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1193 (when (or (assq 'top parsed)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1194 (assq 'left parsed))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1195 (setq parsed (append '((user-position . t) (user-size . t)) parsed)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1196 ;; Put the geometry parameters at the end. Copy
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1197 ;; default-frame-alist so that they go after it.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1198 (setq parameters (append parameters default-frame-alist parsed))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1199 parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1200
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1201
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1202 (defun x-handle-reverse-video (frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1203 "Handle the reverse-video frame parameter and X resource.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1204 `x-create-frame' does not handle this one."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1205 (when (cdr (or (assq 'reverse parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1206 (assq 'reverse default-frame-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1207 (let ((resource (x-get-resource "reverseVideo"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1208 "ReverseVideo")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1209 (if resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1210 (cons nil (member (downcase resource)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1211 '("on" "true")))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1212 (let* ((params (frame-parameters frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1213 (bg (cdr (assq 'foreground-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1214 (fg (cdr (assq 'background-color params))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1215 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1216 (list (cons 'foreground-color fg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1217 (cons 'background-color bg)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1218 (if (equal bg (cdr (assq 'border-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1219 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1220 (list (cons 'border-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1221 (if (equal bg (cdr (assq 'mouse-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1222 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1223 (list (cons 'mouse-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1224 (if (equal bg (cdr (assq 'cursor-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1225 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1226 (list (cons 'cursor-color fg)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1227
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1228
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1229 (defun x-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1230 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1231 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1232 `default-frame-alist'. If PARAMETERS specify a frame name,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1233 handle X geometry resources for that name. If either PARAMETERS
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1234 or `default-frame-alist' contains a `reverse' parameter, or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1235 the X resource ``reverseVideo'' is present, handle that.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1236 Value is the new frame created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1237 (setq parameters (x-handle-named-frame-geometry parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1238 (let ((visibility-spec (assq 'visibility parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1239 (frame-list (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1240 (frame (x-create-frame (cons '(visibility . nil) parameters)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1241 success)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1242 (unwind-protect
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1243 (progn
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1244 (x-handle-reverse-video frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1245 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1246 (face-set-after-frame-default frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1247 (if (or (null frame-list) (null visibility-spec))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1248 (make-frame-visible frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1249 (modify-frame-parameters frame (list visibility-spec)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1250 (setq success t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1251 (unless success
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1252 (delete-frame frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1253 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1254
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1255
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1256 (defun face-set-after-frame-default (frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1257 "Set frame-local faces of FRAME from face specs and resources."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1258 (dolist (face (face-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1259 (let ((spec (or (get face 'saved-face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1260 (get face 'face-defface-spec))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1261 (when spec
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1262 (face-spec-set face spec frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1263 (internal-merge-in-global-face face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1264 (when window-system
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1265 (make-face-x-resource-internal face frame)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1266
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1267
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1268 (defun tty-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1269 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1270 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1271 `default-frame-alist'. If either PARAMETERS or `default-frame-alist'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1272 contains a `reverse' parameter, handle that. Value is the new frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1273 created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1274 (let ((frame (make-terminal-frame parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1275 success)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1276 (unwind-protect
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1277 (progn
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1278 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1279 (face-set-after-frame-default frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1280 (setq success t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1281 (unless success
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1282 (delete-frame frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1283 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1284
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1285
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1286 ;; Called from C function init_display to initialize faces of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1287 ;; dumped terminal frame on startup.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1288
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1289 (defun tty-set-up-initial-frame-faces ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1290 (let ((frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1291 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1292 (face-set-after-frame-default frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1293
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1294
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1295
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1296
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1297 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1298 ;;; Compatiblity with 20.2
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1299 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1300
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1301 ;; Update a frame's faces when we change its default font.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1302
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1303 (defun frame-update-faces (frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1304 nil)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1305
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1306
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1307 ;; Update the colors of FACE, after FRAME's own colors have been
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1308 ;; changed.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1309
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1310 (defun frame-update-face-colors (frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1311 (frame-set-background-mode frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1312
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1313
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1314
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1315 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1316 ;;; Standard faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1317 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1318
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1319 ;; Make the standard faces. The C code knows faces `default',
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1320 ;; `modeline', `toolbar' and `region', so they must be the first faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1321 ;; made. Unspecified attributes of these three faces are filled-in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1322 ;; from frame parameters in the C code.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1323
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1324 (defgroup basic-faces nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1325 "The standard faces of Emacs."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1326 :group 'faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1327
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1328
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1329 (defface default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1330 '((t nil))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1331 "Basic default face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1332 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1333
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1334
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1335 (defface modeline
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1336 '((((type x) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1337 (:box (:line-width 2 :style released-button) :background "grey75"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1338 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1339 (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1340 "Basic mode line face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1341 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1342
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1343
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1344 (defface top-line
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1345 '((((type x) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1346 (:box (:line-width 2 :style released-button) :background "grey75"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1347 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1348 (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1349 "Basic top line face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1350 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1351
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1352
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1353 (defface toolbar
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1354 '((((type x) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1355 (:box (:line-width 1 :style released-button) :background "grey75"))
25090
4cd409210c7f (toolbar): Add face definition for mono displays.
Gerd Moellmann <gerd@gnu.org>
parents: 25070
diff changeset
1356 (((type x) (class mono))
4cd409210c7f (toolbar): Add face definition for mono displays.
Gerd Moellmann <gerd@gnu.org>
parents: 25070
diff changeset
1357 (:box (:line-width 1 :style released-button) :background "grey"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1358 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1359 ()))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1360 "Basic toolbar face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1361 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1362
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1363
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1364 (defface region
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1365 '((((type tty) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1366 (:background "blue" :foreground "white"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1367 (((type tty) (class mono))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1368 (:inverse-video t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1369 (((class color) (background dark))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1370 (:background "blue"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1371 (((class color) (background light))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1372 (:background "lightblue"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1373 (t (:background "gray")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1374 "Basic face for highlight the region."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1375 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1376
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1377
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1378 (defface bitmap-area
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1379 '((((class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1380 (:background "grey95"))
25070
b4b6828139fd (bitmap-area): Change background to white for mono displays.
Gerd Moellmann <gerd@gnu.org>
parents: 25012
diff changeset
1381 (((class mono))
b4b6828139fd (bitmap-area): Change background to white for mono displays.
Gerd Moellmann <gerd@gnu.org>
parents: 25012
diff changeset
1382 (:background "white"))
b4b6828139fd (bitmap-area): Change background to white for mono displays.
Gerd Moellmann <gerd@gnu.org>
parents: 25012
diff changeset
1383 (t
b4b6828139fd (bitmap-area): Change background to white for mono displays.
Gerd Moellmann <gerd@gnu.org>
parents: 25012
diff changeset
1384 (:background "gray")))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1385 "Basic face for bitmap areas under X."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1386 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1387
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1388
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1389 (defface bold '((t (:weight bold)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1390 "Basic bold face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1391 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1392
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1393
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1394 (defface italic '((t (:slant italic)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1395 "Basic italic font."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1396 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1397
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1398
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1399 (defface bold-italic '((t (:weight bold :slant italic)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1400 "Basic bold-italic face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1401 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1402
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1403
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1404 (defface underline '((t (:underline t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1405 "Basic underlined face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1406 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1407
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1408
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1409 (defface highlight
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1410 '((((type tty) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1411 (:background "green"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1412 (((class color) (background light))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1413 (:background "darkseagreen2"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1414 (((class color) (background dark))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1415 (:background "darkolivegreen"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1416 (t (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1417 "Basic face for highlighting.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1418
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1419
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1420 (defface secondary-selection
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1421 '((((type tty) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1422 (:background "cyan"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1423 (((class color) (background light))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1424 (:background "paleturquoise"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1425 (((class color) (background dark))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1426 (:background "darkslateblue"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1427 (t (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1428 "Basic face for displaying the secondary selection.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1429
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1430
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1431 (defface fixed-pitch '((t (:family "courier*")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1432 "The basic fixed-pitch face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1433 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1434
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1435
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1436 (defface variable-pitch '((t (:family "helv*")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1437 "The basic variable-pitch face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1438 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1439
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1440
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1441 (defface trailing-whitespace
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1442 '((((class color) (background light))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1443 (:background "red"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1444 (((class color) (background dark))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1445 (:background "red"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1446 (t (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1447 "Basic face for highlighting trailing whitespace.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1448
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1449
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1450
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1451 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1452 ;;; Manipulating font names.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1453 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1454
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1455 ;; This is here for compatibilty with Emacs 20.2. For example,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1456 ;; international/fontset.el uses these functions to manipulate font
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1457 ;; names. The following functions are not used in the face
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1458 ;; implementation itself.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1459
16687
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
1460 (defvar x-font-regexp nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
1461 (defvar x-font-regexp-head nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
1462 (defvar x-font-regexp-weight nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
1463 (defvar x-font-regexp-slant nil)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1464
12668
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
1465 (defconst x-font-regexp-weight-subnum 1)
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
1466 (defconst x-font-regexp-slant-subnum 2)
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
1467 (defconst x-font-regexp-swidth-subnum 3)
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
1468 (defconst x-font-regexp-adstyle-subnum 4)
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
1469
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1470 ;;; Regexps matching font names in "Host Portable Character Representation."
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1471 ;;;
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1472 (let ((- "[-?]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1473 (foundry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1474 (family "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1475 (weight "\\(bold\\|demibold\\|medium\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1476 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1477 (weight\? "\\([^-]*\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1478 (slant "\\([ior]\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1479 ; (slant\? "\\([ior?*]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1480 (slant\? "\\([^-]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1481 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1482 (swidth "\\([^-]*\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1483 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
12690
e2d3fa52d100 (x-font-regexp): Add \\(\\) for substring extraction.
Karl Heuer <kwzh@gnu.org>
parents: 12668
diff changeset
1484 (adstyle "\\([^-]*\\)") ; 4
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1485 (pixelsize "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1486 (pointsize "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1487 (resx "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1488 (resy "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1489 (spacing "[cmp?*]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1490 (avgwidth "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1491 (registry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1492 (encoding "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1493 )
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1494 (setq x-font-regexp
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1495 (concat "\\`\\*?[-?*]"
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1496 foundry - family - weight\? - slant\? - swidth - adstyle -
12475
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
1497 pixelsize - pointsize - resx - resy - spacing - avgwidth -
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
1498 registry - encoding "\\*?\\'"
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1499 ))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1500 (setq x-font-regexp-head
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1501 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1502 "\\([-*?]\\|\\'\\)"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1503 (setq x-font-regexp-slant (concat - slant -))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1504 (setq x-font-regexp-weight (concat - weight -))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1505 nil)
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1506
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1507
3071
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
1508 (defun x-resolve-font-name (pattern &optional face frame)
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
1509 "Return a font name matching PATTERN.
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
1510 All wildcards in PATTERN become substantiated.
3130
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
1511 If PATTERN is nil, return the name of the frame's base font, which never
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
1512 contains wildcards.
10170
5fc240a3e4a0 (face-initialize): Test for framep not t or nil.
Richard M. Stallman <rms@gnu.org>
parents: 10107
diff changeset
1513 Given optional arguments FACE and FRAME, return a font which is
5fc240a3e4a0 (face-initialize): Test for framep not t or nil.
Richard M. Stallman <rms@gnu.org>
parents: 10107
diff changeset
1514 also the same size as FACE on FRAME, or fail."
3233
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
1515 (or (symbolp face)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
1516 (setq face (face-name face)))
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
1517 (and (eq frame t)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
1518 (setq frame nil))
3130
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
1519 (if pattern
5092
36508a7c0a3f (x-resolve-font-name): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5081
diff changeset
1520 ;; Note that x-list-fonts has code to handle a face with nil as its font.
16002
c8cbde1d3f11 (internal-set-face-1): When calling x-list-fonts, ask for just one match.
Richard M. Stallman <rms@gnu.org>
parents: 15884
diff changeset
1521 (let ((fonts (x-list-fonts pattern face frame 1)))
3130
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
1522 (or fonts
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
1523 (if face
10584
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1524 (if (string-match "\\*" pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1525 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1526 (error "No matching fonts are the same height as the frame default font")
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1527 (error "No matching fonts are the same height as face `%s'" face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1528 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1529 (error "Height of font `%s' doesn't match the frame default font"
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1530 pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1531 (error "Height of font `%s' doesn't match face `%s'"
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1532 pattern face)))
3353
8cbd38886eef (x-resolve-font-name): Clean up error messages.
Richard M. Stallman <rms@gnu.org>
parents: 3298
diff changeset
1533 (error "No fonts match `%s'" pattern)))
3130
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
1534 (car fonts))
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
1535 (cdr (assq 'font (frame-parameters (selected-frame))))))
3071
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
1536
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1537
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1538 (defun x-frob-font-weight (font which)
13704
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1539 (let ((case-fold-search t))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1540 (cond ((string-match x-font-regexp font)
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1541 (concat (substring font 0
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1542 (match-beginning x-font-regexp-weight-subnum))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1543 which
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1544 (substring font (match-end x-font-regexp-weight-subnum)
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1545 (match-beginning x-font-regexp-adstyle-subnum))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1546 ;; Replace the ADD_STYLE_NAME field with *
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1547 ;; because the info in it may not be the same
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1548 ;; for related fonts.
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1549 "*"
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1550 (substring font (match-end x-font-regexp-adstyle-subnum))))
14880
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
1551 ((string-match x-font-regexp-head font)
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
1552 (concat (substring font 0 (match-beginning 1)) which
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
1553 (substring font (match-end 1))))
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
1554 ((string-match x-font-regexp-weight font)
13704
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1555 (concat (substring font 0 (match-beginning 1)) which
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1556 (substring font (match-end 1)))))))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1557
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1558
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1559 (defun x-frob-font-slant (font which)
13704
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1560 (let ((case-fold-search t))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1561 (cond ((string-match x-font-regexp font)
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1562 (concat (substring font 0
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1563 (match-beginning x-font-regexp-slant-subnum))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1564 which
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1565 (substring font (match-end x-font-regexp-slant-subnum)
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1566 (match-beginning x-font-regexp-adstyle-subnum))
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1567 ;; Replace the ADD_STYLE_NAME field with *
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1568 ;; because the info in it may not be the same
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1569 ;; for related fonts.
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1570 "*"
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1571 (substring font (match-end x-font-regexp-adstyle-subnum))))
14880
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
1572 ((string-match x-font-regexp-head font)
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
1573 (concat (substring font 0 (match-beginning 2)) which
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
1574 (substring font (match-end 2))))
b405f39b5493 (x-frob-font-slant): Properly handle a match against
Richard M. Stallman <rms@gnu.org>
parents: 14409
diff changeset
1575 ((string-match x-font-regexp-slant font)
13704
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1576 (concat (substring font 0 (match-beginning 1)) which
3dcaddea344a Wrap case-fold-search for x-frob-font-weight and x-frob-font-slant.
Simon Marshall <simon@gnu.org>
parents: 13609
diff changeset
1577 (substring font (match-end 1)))))))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1578
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1579
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1580 (defun x-make-font-bold (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1581 "Given an X font specification, make a bold version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1582 If that can't be done, return nil."
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1583 (x-frob-font-weight font "bold"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1584
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1585
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1586 (defun x-make-font-demibold (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1587 "Given an X font specification, make a demibold version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1588 If that can't be done, return nil."
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1589 (x-frob-font-weight font "demibold"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1590
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1591
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1592 (defun x-make-font-unbold (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1593 "Given an X font specification, make a non-bold version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1594 If that can't be done, return nil."
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1595 (x-frob-font-weight font "medium"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1596
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1597
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1598 (defun x-make-font-italic (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1599 "Given an X font specification, make an italic version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1600 If that can't be done, return nil."
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1601 (x-frob-font-slant font "i"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1602
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1603
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1604 (defun x-make-font-oblique (font) ; you say tomayto...
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1605 "Given an X font specification, make an oblique version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1606 If that can't be done, return nil."
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1607 (x-frob-font-slant font "o"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1608
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1609
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1610 (defun x-make-font-unitalic (font)
4439
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1611 "Given an X font specification, make a non-italic version of it.
e7ab04f23df5 Make boldness and italicness affect subsequently created frames.
Richard M. Stallman <rms@gnu.org>
parents: 4122
diff changeset
1612 If that can't be done, return nil."
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1613 (x-frob-font-slant font "r"))
17752
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
1614
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1615
17752
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
1616 (defun x-make-font-bold-italic (font)
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
1617 "Given an X font specification, make a bold and italic version of it.
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
1618 If that can't be done, return nil."
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
1619 (and (setq font (x-make-font-bold font))
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
1620 (x-make-font-italic font)))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1621
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1622
2715
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
1623 (provide 'faces)
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
1624
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1625 ;;; end of faces.el