aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy1993-05-11 19:14:34 +0000
committerJim Blandy1993-05-11 19:14:34 +0000
commitbdda375433804a072ef362167656aaa502162c83 (patch)
tree3459dd064a743f4c98945d87463a238dcaaae9bf
parent18004d2b7f3bf740cf90fb507e318e3d83644048 (diff)
downloademacs-bdda375433804a072ef362167656aaa502162c83.tar.gz
emacs-bdda375433804a072ef362167656aaa502162c83.zip
Re-arranged stuff to put defsubst accessors at the top
-rw-r--r--lisp/faces.el155
1 files changed, 84 insertions, 71 deletions
diff --git a/lisp/faces.el b/lisp/faces.el
index a7a10d60796..39e56f0cbaa 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -24,6 +24,13 @@
24 24
25;;; Code: 25;;; Code:
26 26
27
28;;;; Functions for manipulating face vectors.
29
30;;; A face vector is a vector of the form:
31;;; [face ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE]
32
33;;; Type checkers.
27(defsubst internal-facep (x) 34(defsubst internal-facep (x)
28 (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face))) 35 (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face)))
29 36
@@ -31,38 +38,7 @@
31 (` (while (not (internal-facep (, face))) 38 (` (while (not (internal-facep (, face)))
32 (setq (, face) (signal 'wrong-type-argument (list 'internal-facep (, face))))))) 39 (setq (, face) (signal 'wrong-type-argument (list 'internal-facep (, face)))))))
33 40
34 41;;; Accessors.
35(defvar global-face-data nil "do not use this")
36
37(defun face-list ()
38 "Returns a list of all defined face names."
39 (mapcar 'car global-face-data))
40
41(defun internal-find-face (name &optional frame)
42 "Retrieve the face named NAME. Return nil if there is no such face.
43If the optional argument FRAME is given, this gets the face NAME for
44that frame; otherwise, it uses the selected frame.
45If FRAME is the symbol t, then the global, non-frame face is returned.
46If NAME is already a face, it is simply returned."
47 (if (and (eq frame t) (not (symbolp name)))
48 (setq name (face-name name)))
49 (if (symbolp name)
50 (cdr (assq name
51 (if (eq frame t)
52 global-face-data
53 (frame-face-alist (or frame (selected-frame))))))
54 (internal-check-face name)
55 name))
56
57(defun internal-get-face (name &optional frame)
58 "Retrieve the face named NAME; error if there is none.
59If the optional argument FRAME is given, this gets the face NAME for
60that frame; otherwise, it uses the selected frame.
61If FRAME is the symbol t, then the global, non-frame face is returned.
62If NAME is already a face, it is simply returned."
63 (or (internal-find-face name frame)
64 (internal-check-face name)))
65
66(defsubst face-name (face) 42(defsubst face-name (face)
67 "Return the name of face FACE." 43 "Return the name of face FACE."
68 (aref (internal-get-face face) 1)) 44 (aref (internal-get-face face) 1))
@@ -101,45 +77,8 @@ If the optional argument FRAME is given, report on face FACE in that frame.
101Otherwise report on the defaults for face FACE (for new frames)." 77Otherwise report on the defaults for face FACE (for new frames)."
102 (aref (internal-get-face face frame) 7)) 78 (aref (internal-get-face face frame) 7))
103 79
104 80
105(defun internal-set-face-1 (face name value index frame) 81;;; Mutators.
106 (let ((inhibit-quit t))
107 (if (null frame)
108 (let ((frames (frame-list)))
109 (while frames
110 (internal-set-face-1 (face-name face) name value index (car frames))
111 (setq frames (cdr frames)))
112 (aset (internal-get-face (if (symbolp face) face (face-name face)) t)
113 index value)
114 value)
115 (or (eq frame t)
116 (set-face-attribute-internal (face-id face) name value frame))
117 (aset (internal-get-face face frame) index value))))
118
119
120(defun read-face-name (prompt)
121 (let (face)
122 (while (= (length face) 0)
123 (setq face (completing-read prompt
124 (mapcar '(lambda (x) (list (symbol-name x)))
125 (face-list))
126 nil t)))
127 (intern face)))
128
129(defun internal-face-interactive (what &optional bool)
130 (let* ((fn (intern (concat "face-" what)))
131 (prompt (concat "Set " what " of face"))
132 (face (read-face-name (concat prompt ": ")))
133 (default (if (fboundp fn)
134 (or (funcall fn face (selected-frame))
135 (funcall fn 'default (selected-frame)))))
136 (value (if bool
137 (y-or-n-p (concat "Should face " (symbol-name face)
138 " be " bool "? "))
139 (read-string (concat prompt " " (symbol-name face) " to: ")
140 default))))
141 (list face (if (equal value "") nil value))))
142
143 82
144(defsubst set-face-font (face font &optional frame) 83(defsubst set-face-font (face font &optional frame)
145 "Change the font of face FACE to FONT (a string). 84 "Change the font of face FACE to FONT (a string).
@@ -183,6 +122,80 @@ in that frame; otherwise change each frame."
183 (interactive (internal-face-interactive "underline-p" "underlined")) 122 (interactive (internal-face-interactive "underline-p" "underlined"))
184 (internal-set-face-1 face 'underline underline-p 7 frame)) 123 (internal-set-face-1 face 'underline underline-p 7 frame))
185 124
125
126;;;; Associating face names (symbols) with their face vectors.
127
128(defvar global-face-data nil "do not use this")
129
130(defun face-list ()
131 "Returns a list of all defined face names."
132 (mapcar 'car global-face-data))
133
134(defun internal-find-face (name &optional frame)
135 "Retrieve the face named NAME. Return nil if there is no such face.
136If the optional argument FRAME is given, this gets the face NAME for
137that frame; otherwise, it uses the selected frame.
138If FRAME is the symbol t, then the global, non-frame face is returned.
139If NAME is already a face, it is simply returned."
140 (if (and (eq frame t) (not (symbolp name)))
141 (setq name (face-name name)))
142 (if (symbolp name)
143 (cdr (assq name
144 (if (eq frame t)
145 global-face-data
146 (frame-face-alist (or frame (selected-frame))))))
147 (internal-check-face name)
148 name))
149
150(defun internal-get-face (name &optional frame)
151 "Retrieve the face named NAME; error if there is none.
152If the optional argument FRAME is given, this gets the face NAME for
153that frame; otherwise, it uses the selected frame.
154If FRAME is the symbol t, then the global, non-frame face is returned.
155If NAME is already a face, it is simply returned."
156 (or (internal-find-face name frame)
157 (internal-check-face name)))
158
159
160(defun internal-set-face-1 (face name value index frame)
161 (let ((inhibit-quit t))
162 (if (null frame)
163 (let ((frames (frame-list)))
164 (while frames
165 (internal-set-face-1 (face-name face) name value index (car frames))
166 (setq frames (cdr frames)))
167 (aset (internal-get-face (if (symbolp face) face (face-name face)) t)
168 index value)
169 value)
170 (or (eq frame t)
171 (set-face-attribute-internal (face-id face) name value frame))
172 (aset (internal-get-face face frame) index value))))
173
174
175(defun read-face-name (prompt)
176 (let (face)
177 (while (= (length face) 0)
178 (setq face (completing-read prompt
179 (mapcar '(lambda (x) (list (symbol-name x)))
180 (face-list))
181 nil t)))
182 (intern face)))
183
184(defun internal-face-interactive (what &optional bool)
185 (let* ((fn (intern (concat "face-" what)))
186 (prompt (concat "Set " what " of face"))
187 (face (read-face-name (concat prompt ": ")))
188 (default (if (fboundp fn)
189 (or (funcall fn face (selected-frame))
190 (funcall fn 'default (selected-frame)))))
191 (value (if bool
192 (y-or-n-p (concat "Should face " (symbol-name face)
193 " be " bool "? "))
194 (read-string (concat prompt " " (symbol-name face) " to: ")
195 default))))
196 (list face (if (equal value "") nil value))))
197
198
186 199
187(defun make-face (name) 200(defun make-face (name)
188 "Define a new FACE on all frames. 201 "Define a new FACE on all frames.