annotate lisp/faces.el @ 25542:047532b73119

(tool-bar): Change face `toolbar' to `tool-bar'.
author Gerd Moellmann <gerd@gnu.org>
date Sun, 05 Sep 1999 15:48:38 +0000
parents 170d491fe703
children b0a117037bde
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."
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
723 (let (valid)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
724 (setq valid
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
725 (case attribute
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
726 (:family
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
727 (if window-system
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
728 (mapcar #'(lambda (x) (cons (car x) (car x)))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
729 (x-font-family-list))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
730 ;; Only one font on TTYs.
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
731 (list (cons "default" "default"))))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
732 ((:width :weight :slant :inverse-video)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
733 (mapcar #'(lambda (x) (cons (symbol-name x) x))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
734 (internal-lisp-face-attribute-values attribute)))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
735 ((:underline :overline :strike-through :box)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
736 (if window-system
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
737 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
738 (internal-lisp-face-attribute-values attribute))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
739 (mapcar #'(lambda (c) (cons c c))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
740 (x-defined-colors frame)))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
741 (mapcar #'(lambda (x) (cons (symbol-name x) x))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
742 (internal-lisp-face-attribute-values attribute))))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
743 ((:foreground :background)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
744 (mapcar #'(lambda (c) (cons c c))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
745 (or (and window-system (x-defined-colors frame))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
746 (tty-defined-colors))))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
747 ((:height)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
748 'integerp)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
749 (:stipple
25265
3aba9b200c5f (face-valid-attribute-values): Look in
Eli Zaretskii <eliz@gnu.org>
parents: 25245
diff changeset
750 (and (memq window-system '(x w32))
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
751 (mapcar #'list
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
752 (apply #'nconc (mapcar #'directory-files
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
753 x-bitmap-file-path)))))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
754 (t
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
755 (error "Internal error"))))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
756 (if (listp valid)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
757 (nconc (list (cons "unspecified" 'unspecified)) valid)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
758 valid)))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
759
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
760
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
761
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
762 (defvar face-attribute-name-alist
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
763 '((:family . "font family")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
764 (:width . "character set width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
765 (:height . "height in 1/10 pt")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
766 (:weight . "weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
767 (:slant . "slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
768 (:underline . "underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
769 (:overline . "overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
770 (:strike-through . "strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
771 (:box . "box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
772 (:inverse-video . "inverse-video display")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
773 (:foreground . "foreground color")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
774 (:background . "background color")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
775 (:stipple . "background stipple"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
776 "An alist of descriptive names for face attributes.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
777 Each element has the form (ATTRIBUTE-NAME . DESCRIPTION) where
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
778 ATTRIBUTE-NAME is a face attribute name (a keyword symbol), and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
779 DESCRIPTION is a descriptive name for ATTRIBUTE-NAME.")
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
782 (defun face-descriptive-attribute-name (attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
783 "Return a descriptive name for ATTRIBUTE."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
784 (cdr (assq attribute face-attribute-name-alist)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
785
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
786
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
787 (defun face-read-string (face default name &optional completion-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
788 "Interactively read a face attribute string value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
789 FACE is the face whose attribute is read. DEFAULT is the default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
790 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
791 name of the attribute for prompting. COMPLETION-ALIST is an alist
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
792 of valid values, if non-nil.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
793
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
794 Entering nothing accepts the default value DEFAULT.
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
795 Value is the new attribute value."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
796 (let* ((completion-ignore-case t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
797 (value (completing-read
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
798 (if default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
799 (format "Set face %s %s (default %s): "
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
800 face name (downcase (if (symbolp default)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
801 (symbol-name default)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
802 default)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
803 (format "Set face %s %s: " face name))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
804 completion-alist)))
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
805 (if (equal value "") default value)))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
806
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
807
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
808 (defun face-read-integer (face default name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
809 "Interactively read an integer face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
810 FACE is the face whose attribute is read. DEFAULT is the default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
811 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
812 name of the attribute for prompting. Value is the new attribute value."
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
813 (let ((new-value
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
814 (face-read-string face
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
815 (if (eq default 'unspecified)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
816 'unspecified
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
817 (int-to-string default))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
818 name
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
819 (list (cons "unspecified" 'unspecified)))))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
820 (if (eq new-value 'unspecified)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
821 new-value
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
822 (string-to-int new-value))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
823
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
824
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
825 (defun read-face-attribute (face attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
826 "Interactively read a new value for FACE's ATTRIBUTE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
827 Optional argument FRAME nil or unspecified means read an attribute value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
828 of a global face. Value is the new attribute value."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
829 (let* ((old-value (face-attribute face attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
830 (attribute-name (face-descriptive-attribute-name attribute))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
831 (valid (face-valid-attribute-values attribute frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
832 new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
833 ;; Represent complex attribute values as strings by printing them
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
834 ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
835 ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
836 ;; SHADOW)'.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
837 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
838 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
839 (or (consp old-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
840 (vectorp old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
841 (setq old-value (prin1-to-string old-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
842 (cond ((listp valid)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
843 (setq new-value
25245
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
844 (face-read-string face old-value attribute-name valid))
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
845 (unless (eq new-value 'unspecified)
ef080d2576f9 (face-valid-attribute-values): Return an alist for
Gerd Moellmann <gerd@gnu.org>
parents: 25210
diff changeset
846 (setq new-value (cdr (assoc new-value valid)))))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
847 ((eq valid 'integerp)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
848 (setq new-value (face-read-integer face old-value attribute-name)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
849 (t (error "Internal error")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
850 ;; 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
851 ;; vector if it looks like one. This makes the assumption that a
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
852 ;; pixmap file name won't start with an open-paren.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
853 (when (and (or (eq attribute :stipple)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
854 (eq attribute :box))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
855 (stringp new-value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
856 (string-match "^[[(]" new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
857 (setq new-value (read new-value)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
858 new-value))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
859
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 (defun read-face-font (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
862 "Read the name of a font for FACE on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
863 If optional argument FRAME Is nil or omitted, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
864 (let ((completion-ignore-case t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
865 (completing-read "Set font attributes of face %s from font: "
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
866 face (x-list-fonts "*" nil frame))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
867
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
868
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
869 (defun read-all-face-attributes (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
870 "Interactively read all attributes for FACE.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
871 If optional argument FRAME Is nil or omitted, use the selected frame.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
872 Value is a property list of attribute names and new values."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
873 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
874 (dolist (attribute face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
875 (setq result (cons (car attribute)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
876 (cons (read-face-attribute face (car attribute) frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
877 result))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
878
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
879
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
880 (defun modify-face (&optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
881 "Modify attributes of faces interactively.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
882 If optional argument FRAME is nil or omitted, modify the face used
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
883 for newly created frame, i.e. the global face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
884 (interactive)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
885 (let ((face (read-face-name "Modify face: ")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
886 (apply #'set-face-attribute face frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
887 (read-all-face-attributes face frame))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
888
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
889
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
890 (defun read-face-and-attribute (attribute &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
891 "Read face name and face attribute value.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
892 ATTRIBUTE is the attribute whose new value is read.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
893 FRAME nil or unspecified means read attribute value of global face.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
894 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
895 (a symbol), and NEW-VALUE is value read."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
896 (cond ((eq attribute :font)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
897 (let* ((prompt (format "Set font-related attributes of face: "))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
898 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
899 (font (read-face-font face frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
900 (list face font)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
901 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
902 (let* ((attribute-name (face-descriptive-attribute-name attribute))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
903 (prompt (format "Set %s of face: " attribute-name))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
904 (face (read-face-name prompt))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
905 (new-value (read-face-attribute face attribute frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
906 (list face new-value)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
907
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
908
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
909
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 ;;; Listing faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
912 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
913
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
914 (defvar list-faces-sample-text
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
915 "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
916 "*Text string to display as the sample text for `list-faces-display'.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
917
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
918
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
919 ;; 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
920 ;; conflict with Lucid, which uses that name differently.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
921
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
922 (defun list-faces-display ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
923 "List all faces, using the same sample text in each.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
924 The sample text is a string that comes from the variable
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
925 `list-faces-sample-text'."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
926 (interactive)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
927 (let ((faces (sort (face-list) #'string-lessp))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
928 (face nil)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
929 (frame (selected-frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
930 disp-frame window)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
931 (with-output-to-temp-buffer "*Faces*"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
932 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
933 (set-buffer standard-output)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
934 (setq truncate-lines t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
935 (while faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
936 (setq face (car faces))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
937 (setq faces (cdr faces))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
938 (insert (format "%25s " (face-name face)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
939 (let ((beg (point)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
940 (insert list-faces-sample-text)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
941 (insert "\n")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
942 (put-text-property beg (1- (point)) 'face face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
943 ;; If the sample text has multiple lines, line up all of them.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
944 (goto-char beg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
945 (forward-line 1)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
946 (while (not (eobp))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
947 (insert " ")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
948 (forward-line 1))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
949 (goto-char (point-min)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
950 (print-help-return-message))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
951 ;; If the *Faces* buffer appears in a different frame,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
952 ;; copy all the face definitions from FRAME,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
953 ;; so that the display will reflect the frame that was selected.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
954 (setq window (get-buffer-window (get-buffer "*Faces*") t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
955 (setq disp-frame (if window (window-frame window)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
956 (car (frame-list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
957 (or (eq frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
958 (let ((faces (face-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
959 (while faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
960 (copy-face (car faces) (car faces) frame disp-frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
961 (setq faces (cdr faces)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
962
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
963
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
964 (defun describe-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
965 "Display the properties of face FACE on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
966 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
967 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
968 If FRAME is omitted or nil, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
969 (interactive (list (read-face-name "Describe face: ")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
970 (let* ((attrs '((:family . "Family")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
971 (:width . "Width")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
972 (:height . "Height")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
973 (:weight . "Weight")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
974 (:slant . "Slant")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
975 (:foreground . "Foreground")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
976 (:background . "Background")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
977 (:underline . "Underline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
978 (:overline . "Overline")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
979 (:strike-through . "Strike-through")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
980 (:box . "Box")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
981 (:inverse-video . "Inverse")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
982 (:stipple . "Stipple")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
983 (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
984 attrs))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
985 (with-output-to-temp-buffer "*Help*"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
986 (save-excursion
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
987 (set-buffer standard-output)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
988 (dolist (a attrs)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
989 (let ((attr (face-attribute face (car a) frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
990 (insert (make-string (- max-width (length (cdr a))) ?\ )
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
991 (cdr a) ": " (format "%s" attr) "\n")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
992 (insert "\nDocumentation:\n\n"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
993 (or (face-documentation face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
994 "not documented as a face.")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
995 (print-help-return-message))))
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
998
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
999
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1000 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1001 ;;; Face specifications (defface).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1002 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1003
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1004 ;; Parameter FRAME Is kept for call compatibility to with previous
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1005 ;; face implementation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1006
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1007 (defun face-attr-construct (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1008 "Return a defface-style attribute list for FACE on FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1009 Value is a property list of pairs ATTRIBUTE VALUE for all specified
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1010 face attributes of FACE where ATTRIBUTE is the attribute name and
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1011 VALUE is the specified value of that attribute."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1012 (let (result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1013 (dolist (entry face-attribute-name-alist result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1014 (let* ((attribute (car entry))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1015 (value (face-attribute face attribute)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1016 (unless (eq value 'unspecified)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1017 (setq result (nconc (list attribute value) result)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1018
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1019
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1020 (defun face-spec-set-match-display (display frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1021 "Non-nil if DISPLAY matches FRAME.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1022 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
1023 If FRAME is nil, the current FRAME is used."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1024 (let* ((conjuncts display)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1025 conjunct req options
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1026 ;; t means we have succeeded against all the conjuncts in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1027 ;; DISPLAY that have been tested so far.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1028 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1029 (if (eq conjuncts t)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1030 (setq conjuncts nil))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1031 (while (and conjuncts match)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1032 (setq conjunct (car conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1033 conjuncts (cdr conjuncts)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1034 req (car conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1035 options (cdr conjunct)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1036 match (cond ((eq req 'type)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1037 (or (memq window-system options)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1038 (and (null window-system)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1039 (memq 'tty options))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1040 ((eq req 'class)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1041 (memq (frame-parameter frame 'display-type) options))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1042 ((eq req 'background)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1043 (memq (frame-parameter frame 'background-mode)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1044 options))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1045 (t (error "Unknown req `%S' with options `%S'"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1046 req options)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1047 match))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1048
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1049
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1050 (defun face-spec-choose (spec &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1051 "Choose the proper attributes for FRAME, out of SPEC."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1052 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1053 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1054 (let ((tail spec)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1055 result)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1056 (while tail
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1057 (let* ((entry (car tail))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1058 (display (nth 0 entry))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1059 (attrs (nth 1 entry)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1060 (setq tail (cdr tail))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1061 (when (face-spec-set-match-display display frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1062 (setq result attrs tail nil))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1063 result))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1064
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1065
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1066 (defun face-spec-reset-face (face &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1067 "Reset all attributes of FACE on FRAME to unspecified."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1068 (let ((attrs face-attribute-name-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1069 params)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1070 (while attrs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1071 (let ((attr-and-name (car attrs)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1072 (setq params (cons (car attr-and-name) (cons 'unspecified params))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1073 (setq attrs (cdr attrs)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1074 (apply #'set-face-attribute face frame params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1075
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1076
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1077 (defun face-spec-set (face spec &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1078 "Set FACE's attributes according to the first matching entry in SPEC.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1079 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
1080 do it on all frames. See `defface' for information about SPEC."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1081 (let ((attrs (face-spec-choose spec frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1082 params)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1083 (while attrs
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1084 (let ((attribute (car attrs))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1085 (value (car (cdr attrs))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1086 ;; Support some old-style attribute names and values.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1087 (case attribute
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1088 (:bold (setq attribute :weight value (if value 'bold 'normal)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1089 (:italic (setq attribute :slant value (if value 'italic 'normal))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1090 (setq params (cons attribute (cons value params))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1091 (setq attrs (cdr (cdr attrs))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1092 (face-spec-reset-face face frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1093 (apply #'set-face-attribute face frame params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1094
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1095
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1096 (defun face-attr-match-p (face attrs &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1097 "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
1098 Optional parameter FRAME is the frame whose definition of FACE
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1099 is used. If nil or omitted, use the selected frame."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1100 (unless frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1101 (setq frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1102 (let ((list face-attribute-name-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1103 (match t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1104 (while (and match (not (null list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1105 (let* ((attr (car (car list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1106 (specified-value (plist-get attrs attr))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1107 (value-now (face-attribute face attr frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1108 (when specified-value
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1109 (setq match (equal specified-value value-now)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1110 (setq list (cdr list))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1111 match))
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 (defun face-spec-match-p (face spec &optional frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1115 "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
1116 (face-attr-match-p face (face-spec-choose spec frame) frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1117
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1118
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1119
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1121 ;;; Background mode.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1122 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1123
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1124 (defcustom frame-background-mode nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1125 "*The brightness of the background.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1126 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
1127 your background is light, or nil (default) if you want Emacs to
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1128 examine the brightness for you."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1129 :group 'faces
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1130 :set #'(lambda (var value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1131 (set var value)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1132 (mapcar 'frame-set-background-mode (frame-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1133 :initialize 'custom-initialize-changed
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1134 :type '(choice (choice-item dark)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1135 (choice-item light)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1136 (choice-item :tag "default" nil)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1137
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1138
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1139 (defun frame-set-background-mode (frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1140 "Set up the `background-mode' and `display-type' frame parameters for FRAME."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1141 (let* ((bg-resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1142 (and window-system
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1143 (x-get-resource ".backgroundMode" "BackgroundMode")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1144 (params (frame-parameters frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1145 (bg-mode (cond (frame-background-mode)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1146 ((null window-system)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1147 ;; No way to determine this automatically (?).
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1148 'dark)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1149 (bg-resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1150 (intern (downcase bg-resource)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1151 ((< (apply '+ (x-color-values
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1152 (cdr (assq 'background-color
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1153 params))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1154 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1155 ;; Just looking at the screen, colors whose
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1156 ;; values add up to .6 of the white total
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1157 ;; still look dark to me.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1158 (* (apply '+ (x-color-values "white" frame)) .6))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1159 'dark)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1160 (t 'light)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1161 (display-type (cond ((null window-system)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1162 (if (tty-display-color-p) 'color 'mono))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1163 ((x-display-color-p frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1164 'color)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1165 ((x-display-grayscale-p frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1166 'grayscale)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1167 (t 'mono))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1168 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1169 (list (cons 'background-mode bg-mode)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1170 (cons 'display-type display-type))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1171
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1172 ;; For all named faces, choose face specs matching the new frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1173 ;; parameters.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1174 (let ((face-list (face-list)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1175 (while face-list
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1176 (let* ((face (car face-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1177 (spec (get face 'face-defface-spec)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1178 (when spec
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1179 (face-spec-set face spec frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1180 (setq face-list (cdr face-list))))))
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1183
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1184
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1186 ;;; Frame creation.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1188
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1189 (defun x-handle-named-frame-geometry (parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1190 "Add geometry parameters for a named frame to parameter list PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1191 Value is the new parameter list."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1192 (let* ((name (or (cdr (assq 'name parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1193 (cdr (assq 'name default-frame-alist))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1194 (x-resource-name name)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1195 (res-geometry (if name (x-get-resource "geometry" "Geometry"))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1196 (when res-geometry
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1197 (let ((parsed (x-parse-geometry res-geometry)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1198 ;; If the resource specifies a position, call the position
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1199 ;; and size "user-specified".
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1200 (when (or (assq 'top parsed)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1201 (assq 'left parsed))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1202 (setq parsed (append '((user-position . t) (user-size . t)) parsed)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1203 ;; Put the geometry parameters at the end. Copy
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1204 ;; default-frame-alist so that they go after it.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1205 (setq parameters (append parameters default-frame-alist parsed))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1206 parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1207
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1208
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1209 (defun x-handle-reverse-video (frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1210 "Handle the reverse-video frame parameter and X resource.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1211 `x-create-frame' does not handle this one."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1212 (when (cdr (or (assq 'reverse parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1213 (assq 'reverse default-frame-alist)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1214 (let ((resource (x-get-resource "reverseVideo"
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1215 "ReverseVideo")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1216 (if resource
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1217 (cons nil (member (downcase resource)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1218 '("on" "true")))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1219 (let* ((params (frame-parameters frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1220 (bg (cdr (assq 'foreground-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1221 (fg (cdr (assq 'background-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 'foreground-color fg)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1224 (cons 'background-color bg)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1225 (if (equal bg (cdr (assq 'border-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1226 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1227 (list (cons 'border-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1228 (if (equal bg (cdr (assq 'mouse-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1229 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1230 (list (cons 'mouse-color fg))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1231 (if (equal bg (cdr (assq 'cursor-color params)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1232 (modify-frame-parameters frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1233 (list (cons 'cursor-color fg)))))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1234
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1235
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1236 (defun x-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1237 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1238 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1239 `default-frame-alist'. If PARAMETERS specify a frame name,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1240 handle X geometry resources for that name. If either PARAMETERS
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1241 or `default-frame-alist' contains a `reverse' parameter, or
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1242 the X resource ``reverseVideo'' is present, handle that.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1243 Value is the new frame created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1244 (setq parameters (x-handle-named-frame-geometry parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1245 (let ((visibility-spec (assq 'visibility parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1246 (frame-list (frame-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1247 (frame (x-create-frame (cons '(visibility . nil) parameters)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1248 success)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1249 (unwind-protect
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1250 (progn
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1251 (x-handle-reverse-video frame parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1252 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1253 (face-set-after-frame-default frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1254 (if (or (null frame-list) (null visibility-spec))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1255 (make-frame-visible frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1256 (modify-frame-parameters frame (list visibility-spec)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1257 (setq success t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1258 (unless success
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1259 (delete-frame frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1260 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1261
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1262
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1263 (defun face-set-after-frame-default (frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1264 "Set frame-local faces of FRAME from face specs and resources."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1265 (dolist (face (face-list))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1266 (let ((spec (or (get face 'saved-face)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1267 (get face 'face-defface-spec))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1268 (when spec
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1269 (face-spec-set face spec frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1270 (internal-merge-in-global-face face frame)
25210
b145fd152286 (face-set-after-frame-default): Don't call
Eli Zaretskii <eliz@gnu.org>
parents: 25137
diff changeset
1271 (when (memq window-system '(x w32))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1272 (make-face-x-resource-internal face frame)))))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1273
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1274
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1275 (defun tty-create-frame-with-faces (&optional parameters)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1276 "Create a frame from optional frame parameters PARAMETERS.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1277 Parameters not specified by PARAMETERS are taken from
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1278 `default-frame-alist'. If either PARAMETERS or `default-frame-alist'
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1279 contains a `reverse' parameter, handle that. Value is the new frame
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1280 created."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1281 (let ((frame (make-terminal-frame parameters))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1282 success)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1283 (unwind-protect
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1284 (progn
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1285 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1286 (face-set-after-frame-default frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1287 (setq success t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1288 (unless success
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1289 (delete-frame frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1290 frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1291
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1292
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1293 ;; Called from C function init_display to initialize faces of the
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1294 ;; dumped terminal frame on startup.
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 (defun tty-set-up-initial-frame-faces ()
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1297 (let ((frame (selected-frame)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1298 (frame-set-background-mode frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1299 (face-set-after-frame-default frame)))
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
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1304 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1305 ;;; Compatiblity with 20.2
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1308 ;; Update a frame's faces when we change its default font.
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-faces (frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1311 nil)
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 ;; Update the colors of FACE, after FRAME's own colors have been
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1315 ;; changed.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1316
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1317 (defun frame-update-face-colors (frame)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1318 (frame-set-background-mode frame))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1319
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1320
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1321
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1322 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1323 ;;; Standard faces.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1324 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1325
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1326 ;; Make the standard faces. The C code knows faces `default',
25542
047532b73119 (tool-bar): Change face `toolbar' to `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents: 25494
diff changeset
1327 ;; `modeline', `tool-bar' and `region', so they must be the first faces
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1328 ;; made. Unspecified attributes of these three faces are filled-in
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1329 ;; from frame parameters in the C code.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1330
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1331 (defgroup basic-faces nil
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1332 "The standard faces of Emacs."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1333 :group 'faces)
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1336 (defface default
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1337 '((t nil))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1338 "Basic default face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1339 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1340
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1341
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1342 (defface modeline
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1343 '((((type x) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1344 (:box (:line-width 2 :style released-button) :background "grey75"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1345 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1346 (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1347 "Basic mode line face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1348 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1349
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1350
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1351 (defface top-line
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1352 '((((type x) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1353 (:box (:line-width 2 :style released-button) :background "grey75"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1354 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1355 (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1356 "Basic top line face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1357 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1358
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1359
25542
047532b73119 (tool-bar): Change face `toolbar' to `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents: 25494
diff changeset
1360 (defface tool-bar
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1361 '((((type x) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1362 (: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
1363 (((type x) (class mono))
4cd409210c7f (toolbar): Add face definition for mono displays.
Gerd Moellmann <gerd@gnu.org>
parents: 25070
diff changeset
1364 (:box (:line-width 1 :style released-button) :background "grey"))
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1365 (t
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1366 ()))
25542
047532b73119 (tool-bar): Change face `toolbar' to `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents: 25494
diff changeset
1367 "Basic tool-bar face."
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1368 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1369
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1370
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1371 (defface region
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1372 '((((type tty) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1373 (:background "blue" :foreground "white"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1374 (((type tty) (class mono))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1375 (:inverse-video t))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1376 (((class color) (background dark))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1377 (:background "blue"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1378 (((class color) (background light))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1379 (:background "lightblue"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1380 (t (:background "gray")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1381 "Basic face for highlight the region."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1382 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1383
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1384
25384
fdefa56606aa (margin): Renamed from bitmap-area.
Gerd Moellmann <gerd@gnu.org>
parents: 25265
diff changeset
1385 (defface margin
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1386 '((((class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1387 (:background "grey95"))
25070
b4b6828139fd (bitmap-area): Change background to white for mono displays.
Gerd Moellmann <gerd@gnu.org>
parents: 25012
diff changeset
1388 (t
b4b6828139fd (bitmap-area): Change background to white for mono displays.
Gerd Moellmann <gerd@gnu.org>
parents: 25012
diff changeset
1389 (:background "gray")))
25384
fdefa56606aa (margin): Renamed from bitmap-area.
Gerd Moellmann <gerd@gnu.org>
parents: 25265
diff changeset
1390 "Basic face for the margins to the left and right of windows under X."
25137
1bee9402f747 (bitmap-area): Add :version.
Dave Love <fx@gnu.org>
parents: 25090
diff changeset
1391 :version "21.1"
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1392 :group 'basic-faces)
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1395 (defface bold '((t (:weight bold)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1396 "Basic bold face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1397 :group 'basic-faces)
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1400 (defface italic '((t (:slant italic)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1401 "Basic italic font."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1402 :group 'basic-faces)
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1405 (defface bold-italic '((t (:weight bold :slant italic)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1406 "Basic bold-italic face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1407 :group 'basic-faces)
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1410 (defface underline '((t (:underline t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1411 "Basic underlined face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1412 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1413
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1414
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1415 (defface highlight
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1416 '((((type tty) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1417 (:background "green"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1418 (((class color) (background light))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1419 (:background "darkseagreen2"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1420 (((class color) (background dark))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1421 (:background "darkolivegreen"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1422 (t (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1423 "Basic face for highlighting.")
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1424
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1425
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1426 (defface secondary-selection
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1427 '((((type tty) (class color))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1428 (:background "cyan"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1429 (((class color) (background light))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1430 (:background "paleturquoise"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1431 (((class color) (background dark))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1432 (:background "darkslateblue"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1433 (t (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1434 "Basic face for displaying the secondary selection.")
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1437 (defface fixed-pitch '((t (:family "courier*")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1438 "The basic fixed-pitch face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1439 :group 'basic-faces)
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1442 (defface variable-pitch '((t (:family "helv*")))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1443 "The basic variable-pitch face."
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1444 :group 'basic-faces)
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1445
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1446
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1447 (defface trailing-whitespace
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1448 '((((class color) (background light))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1449 (:background "red"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1450 (((class color) (background dark))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1451 (:background "red"))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1452 (t (:inverse-video t)))
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1453 "Basic face for highlighting trailing whitespace.")
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
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1456
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1457 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1458 ;;; Manipulating font names.
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1459 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1460
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1461 ;; This is here for compatibilty with Emacs 20.2. For example,
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1462 ;; international/fontset.el uses these functions to manipulate font
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1463 ;; names. The following functions are not used in the face
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1464 ;; implementation itself.
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1465
16687
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
1466 (defvar x-font-regexp nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
1467 (defvar x-font-regexp-head nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
1468 (defvar x-font-regexp-weight nil)
049c87a96dca Change defconsts to defvars.
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
1469 (defvar x-font-regexp-slant nil)
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1470
12668
7660e82d0346 (x-font-regexp-weight-subnum, x-font-regexp-slant-subnum)
Karl Heuer <kwzh@gnu.org>
parents: 12651
diff changeset
1471 (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
1472 (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
1473 (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
1474 (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
1475
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1476 ;;; Regexps matching font names in "Host Portable Character Representation."
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1477 ;;;
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1478 (let ((- "[-?]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1479 (foundry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1480 (family "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1481 (weight "\\(bold\\|demibold\\|medium\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1482 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1483 (weight\? "\\([^-]*\\)") ; 1
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1484 (slant "\\([ior]\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1485 ; (slant\? "\\([ior?*]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1486 (slant\? "\\([^-]?\\)") ; 2
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1487 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1488 (swidth "\\([^-]*\\)") ; 3
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1489 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
12690
e2d3fa52d100 (x-font-regexp): Add \\(\\) for substring extraction.
Karl Heuer <kwzh@gnu.org>
parents: 12668
diff changeset
1490 (adstyle "\\([^-]*\\)") ; 4
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1491 (pixelsize "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1492 (pointsize "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1493 (resx "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1494 (resy "[0-9][0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1495 (spacing "[cmp?*]")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1496 (avgwidth "[0-9]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1497 (registry "[^-]+")
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1498 (encoding "[^-]+")
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
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1501 (concat "\\`\\*?[-?*]"
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1502 foundry - family - weight\? - slant\? - swidth - adstyle -
12475
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
1503 pixelsize - pointsize - resx - resy - spacing - avgwidth -
eb436b0c4ab3 (x-font-regexp): Include the avgwidth.
Richard M. Stallman <rms@gnu.org>
parents: 12460
diff changeset
1504 registry - encoding "\\*?\\'"
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1505 ))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1506 (setq x-font-regexp-head
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1507 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1508 "\\([-*?]\\|\\'\\)"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1509 (setq x-font-regexp-slant (concat - slant -))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1510 (setq x-font-regexp-weight (concat - weight -))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1511 nil)
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1512
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1513
3071
68de05fb5751 * faces.el (set-face-font): Call x-resolve-font-name on the font
Jim Blandy <jimb@redhat.com>
parents: 3049
diff changeset
1514 (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
1515 "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
1516 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
1517 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
1518 contains wildcards.
10170
5fc240a3e4a0 (face-initialize): Test for framep not t or nil.
Richard M. Stallman <rms@gnu.org>
parents: 10107
diff changeset
1519 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
1520 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
1521 (or (symbolp face)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
1522 (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
1523 (and (eq frame t)
28b2df35c33e (x-resolve-font-name): Allow symbol as FACE arg.
Richard M. Stallman <rms@gnu.org>
parents: 3182
diff changeset
1524 (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
1525 (if pattern
5092
36508a7c0a3f (x-resolve-font-name): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 5081
diff changeset
1526 ;; 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
1527 (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
1528 (or fonts
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
1529 (if face
10584
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1530 (if (string-match "\\*" pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1531 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1532 (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
1533 (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
1534 (if (null (face-font face))
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1535 (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
1536 pattern)
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1537 (error "Height of font `%s' doesn't match face `%s'"
f79a6ab2d0bd (facep): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10379
diff changeset
1538 pattern face)))
3353
8cbd38886eef (x-resolve-font-name): Clean up error messages.
Richard M. Stallman <rms@gnu.org>
parents: 3298
diff changeset
1539 (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
1540 (car fonts))
82c29bacb6b3 * faces.el (x-resolve-font-name): If PATTERN is nil, return the
Jim Blandy <jimb@redhat.com>
parents: 3071
diff changeset
1541 (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
1542
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1543
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1544 (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
1545 (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
1546 (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
1547 (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
1548 (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
1549 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
1550 (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
1551 (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
1552 ;; 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
1553 ;; 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
1554 ;; 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
1555 "*"
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 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
1557 ((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
1558 (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
1559 (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
1560 ((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
1561 (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
1562 (substring font (match-end 1)))))))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1563
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1564
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1565 (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
1566 (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
1567 (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
1568 (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
1569 (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
1570 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
1571 (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
1572 (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
1573 ;; 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
1574 ;; 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
1575 ;; 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
1576 "*"
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 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
1578 ((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
1579 (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
1580 (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
1581 ((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
1582 (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
1583 (substring font (match-end 1)))))))
2456
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-bold (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 bold 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 "bold"))
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-demibold (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 demibold 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 "demibold"))
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-unbold (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 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
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-weight font "medium"))
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-italic (font)
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 italic 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 "i"))
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-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
1611 "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
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 "o"))
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1614
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1615
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1616 (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
1617 "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
1618 If that can't be done, return nil."
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1619 (x-frob-font-slant font "r"))
17752
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
1620
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1621
17752
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
1622 (defun x-make-font-bold-italic (font)
2687f3d7c191 (x-make-font-bold-italic): New function.
Kenichi Handa <handa@m17n.org>
parents: 17560
diff changeset
1623 "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
1624 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
1625 (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
1626 (x-make-font-italic font)))
2456
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1627
39a58fdf2dee Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1628
2715
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
1629 (provide 'faces)
9caee9338229 * faces.el: Call internal-set-face-1, not internat-set-face-1.
Jim Blandy <jimb@redhat.com>
parents: 2714
diff changeset
1630
25012
583c6bc7fe82 Complete rewrite.
Gerd Moellmann <gerd@gnu.org>
parents: 24579
diff changeset
1631 ;;; end of faces.el