Mercurial > hg > xemacs-beta
annotate lisp/faces.el @ 5750:66d2f63df75f
Correct some spelling and formatting in behavior.el.
Mentioned in tracker issue 826, the third thing mentioned there (the file
name at the bottom of the file) had already been fixed.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* behavior.el:
(override-behavior):
Correct some spelling and formatting here, thank you Steven
Mitchell in tracker issue 826.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 05 Aug 2013 10:05:32 +0100 |
| parents | daf5accfe973 |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; faces.el --- Lisp interface to the C "face" structure |
| 2 | |
| 3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995 Board of Trustees, University of Illinois | |
| 3027 | 5 ;; Copyright (C) 1995, 1996, 2002, 2005 Ben Wing |
|
5080
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
6 ;; Copyright (C) 2010 Didier Verna |
| 428 | 7 |
| 8 ;; Author: Ben Wing <ben@xemacs.org> | |
| 9 ;; Keywords: faces, internal, dumped | |
| 10 | |
| 11 ;; This file is part of XEmacs. | |
| 12 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5080
diff
changeset
|
13 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5080
diff
changeset
|
14 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5080
diff
changeset
|
15 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5080
diff
changeset
|
16 ;; option) any later version. |
| 428 | 17 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5080
diff
changeset
|
18 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5080
diff
changeset
|
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5080
diff
changeset
|
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5080
diff
changeset
|
21 ;; for more details. |
| 428 | 22 |
| 23 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5080
diff
changeset
|
24 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 25 |
| 26 ;;; Synched up with: Not synched with FSF. Almost completely divergent. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file is dumped with XEmacs. | |
| 31 | |
| 32 ;; face implementation #1 (used Lisp vectors and parallel C vectors; | |
| 33 ;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@jwz.org> | |
| 34 ;; pre Lucid-Emacs 19.0. | |
| 35 | |
| 36 ;; face implementation #2 (used one face object per frame per face) | |
| 37 ;; authored by Jamie Zawinski for 19.9. | |
| 38 | |
| 39 ;; face implementation #3 (use one face object per face) originally | |
| 40 ;; authored for 19.12 by Chuck Thompson <cthomp@cs.uiuc.edu>, | |
| 41 ;; rewritten by Ben Wing with the advent of specifiers. | |
| 42 | |
| 43 | |
| 44 ;;; Some stuff in FSF's faces.el is in our x-faces.el. | |
| 45 | |
| 46 ;;; Code: | |
| 47 | |
| 771 | 48 ;; To elude the warnings for font functions. (Normally autoloaded when |
| 49 ;; font-create-object is called) | |
|
5284
d27c1ee1943b
Make the order of preloaded-file-list more sane.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5080
diff
changeset
|
50 (eval-when-compile (require 'font)) |
| 771 | 51 |
| 428 | 52 (defgroup faces nil |
| 53 "Support for multiple text attributes (fonts, colors, ...) | |
| 54 Such a collection of attributes is called a \"face\"." | |
| 55 :group 'emacs) | |
| 56 | |
| 57 (defun read-face-name (prompt) | |
| 58 (let (face) | |
|
5366
f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents:
5344
diff
changeset
|
59 (while (eql (length face) 0) ; nil or "" |
|
5666
daf5accfe973
Use #'test-completion, minibuf.el, instead of implementing same.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5624
diff
changeset
|
60 (setq face (completing-read prompt (face-list) nil t))) |
| 428 | 61 (intern face))) |
| 62 | |
| 63 (defun face-interactive (what &optional bool) | |
| 64 (let* ((fn (intern (concat "face-" what "-instance"))) | |
| 65 (face (read-face-name (format "Set %s of face: " what))) | |
| 66 (default (if (fboundp fn) | |
| 67 ;; #### we should distinguish here between | |
| 68 ;; explicitly setting the value to be the | |
| 69 ;; same as the default face's value, and | |
| 70 ;; not setting a value at all. | |
| 71 (funcall fn face))) | |
| 72 (value (if bool | |
| 73 (y-or-n-p (format "Should face %s be %s? " | |
| 74 (symbol-name face) bool)) | |
| 75 (read-string (format "Set %s of face %s to: " | |
| 76 what (symbol-name face)) | |
| 77 (cond ((font-instance-p default) | |
| 78 (font-instance-name default)) | |
| 79 ((color-instance-p default) | |
| 80 (color-instance-name default)) | |
| 81 ((image-instance-p default) | |
| 82 (image-instance-file-name default)) | |
|
5080
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
83 ((face-background-placement-instance-p default) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
84 (symbol-name default)) |
| 428 | 85 (t default)))))) |
| 86 (list face (if (equal value "") nil value)))) | |
| 87 | |
| 88 (defconst built-in-face-specifiers | |
| 89 (built-in-face-specifiers) | |
| 90 "A list of the built-in face properties that are specifiers.") | |
| 91 | |
| 92 (defun face-property (face property &optional locale tag-set exact-p) | |
| 93 "Return FACE's value of the given PROPERTY. | |
| 94 | |
| 3027 | 95 NOTE: If you are looking for the \"value\" of a built-in face property |
| 96 (`foreground', `background', `font', `background-pixmap', etc.), you | |
| 97 are probably better off calling `face-property-instance'. The return | |
| 98 value of `face-property' for built-in properties describes the original | |
| 99 specification used to determine the face property, which may be nil, | |
| 100 a list of instantiators, or something else that is unexpected. For | |
| 101 example, if you ask for a face property in a particular buffer (by | |
| 102 specifying a buffer for LOCALE), you will get a non-nil return value | |
| 103 only if a buffer-local specification for that particular buffer had | |
| 104 previously been given. | |
| 105 | |
| 106 For a full list of built-in property names and their semantics, see | |
| 107 `set-face-property'. | |
| 428 | 108 |
| 3027 | 109 If LOCALE is omitted, the FACE's actual value for PROPERTY will be |
| 110 returned. In this case, this function appears to behave rather | |
| 111 differently depending on whether PROPERTY is a built-in face property of | |
| 112 a user-defined face property. This is because the most basic value of a | |
| 113 user-defined property is simply whatever was set using | |
| 114 `set-face-property', but for a built-in property it's always a specifier, | |
| 115 which is an abstract object encapsulating all the specifications for that | |
| 116 particular property. | |
| 117 | |
| 118 LOCALE, if supplied, will generally be a buffer, frame or | |
| 119 `global' (for the global value), but there are other possibilities -- see | |
| 120 the following paragraph. This mostly applies to built-in properties. In | |
| 121 this case, the return value will not be a specifier object but the | |
| 122 specification(s) for the given locale or locale type will be returned | |
| 123 (equivalent to calling `specifier-specs' on the specifier). | |
| 124 (Technically, the same thing happens if the basic value of a user- | |
| 125 defined property is a specifier, although this usage is rare.) | |
| 428 | 126 |
| 127 The return value will be a list of instantiators (e.g. strings | |
| 128 specifying a font or color name), or a list of specifications, each | |
| 129 of which is a cons of a locale and a list of instantiators. | |
| 130 Specifically, if LOCALE is a particular locale (a buffer, window, | |
| 3027 | 131 frame, device, or `global'), a list of instantiators for that locale |
| 428 | 132 will be returned. Otherwise, if LOCALE is a locale type (one of |
| 3027 | 133 the symbols `buffer', `window', `frame', or `device'), the specifications |
| 428 | 134 for all locales of that type will be returned. Finally, if LOCALE is |
| 3027 | 135 `all', the specifications for all locales of all types will be returned. |
| 428 | 136 |
| 137 The specifications in a specifier determine what the value of | |
| 138 PROPERTY will be in a particular \"domain\" or set of circumstances, | |
| 3027 | 139 which is typically a particular Emacs window -- which in turn defines |
| 140 a buffer (the buffer in the window), a frame (the frame that the window | |
| 141 is in), and a device (the device that the frame is in). The value is | |
| 442 | 142 derived from the instantiator associated with the most specific |
| 3027 | 143 locale (in the order buffer, window, frame, device, and `global') |
| 428 | 144 that matches the domain in question. In other words, given a domain |
| 442 | 145 (i.e. an Emacs window, usually), the specifier for PROPERTY will |
| 146 first be searched for a specification whose locale is the buffer | |
| 147 contained within that window; then for a specification whose locale | |
| 148 is the window itself; then for a specification whose locale is the | |
| 149 frame that the window is contained within; etc. The first | |
| 150 instantiator that is valid for the domain (usually this means that | |
| 151 the instantiator is recognized by the device [i.e. MS Windows, the X | |
| 3027 | 152 server or TTY device]) will be \"instantiated\", which generates |
| 153 a Lisp object encapsulating the original instantiator and the underlying | |
| 154 window-system object describing the property. The function | |
| 155 `face-property-instance' actually does all this." | |
| 428 | 156 |
| 157 (setq face (get-face face)) | |
| 158 (let ((value (get face property))) | |
| 159 (if (and locale | |
| 160 (or (memq property built-in-face-specifiers) | |
| 161 (specifierp value))) | |
| 162 (setq value (specifier-specs value locale tag-set exact-p))) | |
| 163 value)) | |
| 164 | |
| 165 (defun convert-face-property-into-specifier (face property) | |
| 166 "Convert PROPERTY on FACE into a specifier, if it's not already." | |
| 167 (setq face (get-face face)) | |
| 168 (let ((specifier (get face property))) | |
| 169 ;; if a user-property does not have a specifier but a | |
| 170 ;; locale was specified, put a specifier there. | |
| 171 ;; If there was already a value there, convert it to a | |
| 3027 | 172 ;; specifier with the value as its `global' instantiator. |
| 428 | 173 (unless (specifierp specifier) |
| 174 (let ((new-specifier (make-specifier 'generic))) | |
| 175 (if (or (not (null specifier)) | |
| 176 ;; make sure the nil returned from `get' wasn't | |
| 177 ;; actually the value of the property | |
| 178 (null (get face property t))) | |
| 179 (add-spec-to-specifier new-specifier specifier)) | |
| 180 (setq specifier new-specifier) | |
| 181 (put face property specifier))))) | |
| 182 | |
| 183 (defun face-property-instance (face property | |
| 872 | 184 &optional domain default no-fallback) |
| 428 | 185 "Return the instance of FACE's PROPERTY in the specified DOMAIN. |
| 186 | |
| 187 Under most circumstances, DOMAIN will be a particular window, | |
| 188 and the returned instance describes how the specified property | |
| 189 actually is displayed for that window and the particular buffer | |
| 190 in it. Note that this may not be the same as how the property | |
| 191 appears when the buffer is displayed in a different window or | |
| 192 frame, or how the property appears in the same window if you | |
| 193 switch to another buffer in that window; and in those cases, | |
| 194 the returned instance would be different. | |
| 195 | |
| 196 The returned instance will typically be a color-instance, | |
| 3027 | 197 font-instance, or image-instance object, and you can query |
| 428 | 198 it using the appropriate object-specific functions. For example, |
| 199 you could use `color-instance-rgb-components' to find out the | |
| 3027 | 200 RGB (red, green, and blue) components of how the `background' |
| 201 property of the `highlight' face is displayed in a particular | |
| 428 | 202 window. The results might be different from the results |
| 203 you would get for another window (perhaps the user | |
| 204 specified a different color for the frame that window is on; | |
| 205 or perhaps the same color was specified but the window is | |
| 206 on a different X server, and that X server has different RGB | |
| 207 values for the color from this one). | |
| 208 | |
| 209 DOMAIN defaults to the selected window if omitted. | |
| 210 | |
| 211 DOMAIN can be a frame or device, instead of a window. The value | |
| 212 returned for a such a domain is used in special circumstances | |
| 213 when a more specific domain does not apply; for example, a frame | |
| 214 value might be used for coloring a toolbar, which is conceptually | |
| 215 attached to a frame rather than a particular window. The value | |
| 216 is also useful in determining what the value would be for a | |
| 217 particular window within the frame or device, if it is not | |
| 218 overridden by a more specific specification. | |
| 219 | |
| 220 If PROPERTY does not name a built-in property, its value will | |
| 221 simply be returned unless it is a specifier object, in which case | |
| 222 it will be instanced using `specifier-instance'. | |
| 223 | |
| 224 Optional arguments DEFAULT and NO-FALLBACK are the same as in | |
| 225 `specifier-instance'." | |
| 226 | |
| 227 (setq face (get-face face)) | |
| 228 (let ((value (get face property))) | |
| 229 (if (specifierp value) | |
| 230 (setq value (specifier-instance value domain default no-fallback))) | |
| 231 value)) | |
| 232 | |
| 233 (defun face-property-matching-instance (face property matchspec | |
| 872 | 234 &optional domain default |
| 235 no-fallback) | |
| 428 | 236 "Return the instance of FACE's PROPERTY matching MATCHSPEC in DOMAIN. |
| 5484 | 237 Currently MATCHSPEC is used only for the 'font property, when its value |
| 238 should be a cons \(CHARSET . STAGE) \(see `specifier-matching-instance' | |
| 239 for a full description of the matching process). This allows you to | |
| 240 retrieve a font that can be used to display a particular charset, rather | |
| 241 than just any font. For backward compatibility, MATCHSPEC may be a | |
| 242 charset, which is interpreted as \(CHARSET . final). | |
| 428 | 243 |
| 5484 | 244 See `face-property-instance' for usage of the other arguments." |
| 428 | 245 |
| 246 (setq face (get-face face)) | |
| 5484 | 247 ;; For compatibility with 21.4-oriented code, eg, x-symbol-mule.el. |
| 248 (when (charsetp matchspec) | |
| 249 (setq matchspec (cons matchspec 'final))) | |
| 428 | 250 (let ((value (get face property))) |
| 3659 | 251 (when (specifierp value) |
| 252 (setq value (specifier-matching-instance value matchspec domain | |
| 253 default no-fallback))) | |
| 428 | 254 value)) |
| 255 | |
| 256 (defun set-face-property (face property value &optional locale tag-set | |
| 872 | 257 how-to-add) |
| 428 | 258 "Change a property of FACE. |
| 259 | |
| 260 NOTE: If you want to remove a property from a face, use `remove-face-property' | |
| 261 rather than attempting to set a value of nil for the property. | |
| 262 | |
| 263 For built-in properties, the actual value of the property is a | |
| 264 specifier and you cannot change this; but you can change the | |
| 265 specifications within the specifier, and that is what this function | |
| 266 will do. For user-defined properties, you can use this function | |
| 267 to either change the actual value of the property or, if this value | |
| 268 is a specifier, change the specifications within it. | |
| 269 | |
| 270 If PROPERTY is a built-in property, the specifications to be added to | |
| 271 this property can be supplied in many different ways: | |
| 272 | |
| 273 -- If VALUE is a simple instantiator (e.g. a string naming a font or | |
| 274 color) or a list of instantiators, then the instantiator(s) will | |
| 275 be added as a specification of the property for the given LOCALE | |
| 3027 | 276 (which defaults to `global' if omitted). |
| 428 | 277 -- If VALUE is a list of specifications (each of which is a cons of |
| 278 a locale and a list of instantiators), then LOCALE must be nil | |
| 279 (it does not make sense to explicitly specify a locale in this | |
| 280 case), and specifications will be added as given. | |
| 281 -- If VALUE is a specifier (as would be returned by `face-property' | |
| 282 if no LOCALE argument is given), then some or all of the | |
| 283 specifications in the specifier will be added to the property. | |
| 284 In this case, the function is really equivalent to | |
| 285 `copy-specifier' and LOCALE has the same semantics (if it is | |
| 286 a particular locale, the specification for the locale will be | |
| 287 copied; if a locale type, specifications for all locales of | |
| 3027 | 288 that type will be copied; if nil or `all', then all |
| 428 | 289 specifications will be copied). |
| 290 | |
| 3027 | 291 HOW-TO-ADD should be either nil or one of the symbols `prepend', |
| 292 `append', `remove-tag-set-prepend', `remove-tag-set-append', `remove-locale', | |
| 293 `remove-locale-type', or `remove-all'. See `copy-specifier' and | |
| 428 | 294 `add-spec-to-specifier' for a description of what each of |
| 295 these means. Most of the time, you do not need to worry about | |
| 296 this argument; the default behavior usually is fine. | |
| 297 | |
| 298 In general, it is OK to pass an instance object (e.g. as returned | |
| 299 by `face-property-instance') as an instantiator in place of | |
| 300 an actual instantiator. In such a case, the instantiator used | |
| 301 to create that instance object will be used (for example, if | |
| 3027 | 302 you set a font-instance object as the value of the `font' |
| 428 | 303 property, then the font name used to create that object will |
| 304 be used instead). If some cases, however, doing this | |
| 305 conversion does not make sense, and this will be noted in | |
| 306 the documentation for particular types of instance objects. | |
| 307 | |
| 308 If PROPERTY is not a built-in property, then this function will | |
| 309 simply set its value if LOCALE is nil. However, if LOCALE is | |
| 310 given, then this function will attempt to add VALUE as the | |
| 311 instantiator for the given LOCALE, using `add-spec-to-specifier'. | |
| 312 If the value of the property is not a specifier, it will | |
| 3027 | 313 automatically be converted into a `generic' specifier. |
| 428 | 314 |
| 315 | |
| 316 The following symbols have predefined meanings: | |
| 317 | |
| 318 foreground The foreground color of the face. | |
| 442 | 319 For valid instantiators, see `make-color-specifier'. |
| 428 | 320 |
|
5624
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
321 foreback The foreground color of the face's background pixmap, |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
322 when the pixmap is a bitmap. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
323 Only used by faces on X and MS Windows devices. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
324 For valid instantiators, see `make-color-specifier'. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
325 |
| 428 | 326 background The background color of the face. |
| 442 | 327 For valid instantiators, see `make-color-specifier'. |
| 428 | 328 |
| 329 font The font used to display text covered by this face. | |
| 442 | 330 For valid instantiators, see `make-font-specifier'. |
| 428 | 331 |
| 332 display-table The display table of the face. | |
| 333 This should be a vector of 256 elements. | |
| 334 | |
| 335 background-pixmap The pixmap displayed in the background of the face. | |
| 442 | 336 Only used by faces on X and MS Windows devices. |
| 337 For valid instantiators, see `make-image-specifier'. | |
| 428 | 338 |
|
5080
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
339 background-placement The placement of the face's background pixmap. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
340 Only used by faces on X devices. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
341 For valid instantiators, |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
342 see `make-face-background-placement-specifier'. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
343 |
| 428 | 344 underline Underline all text covered by this face. |
| 442 | 345 For valid instantiators, see `make-face-boolean-specifier'. |
| 428 | 346 |
| 347 strikethru Draw a line through all text covered by this face. | |
| 442 | 348 For valid instantiators, see `make-face-boolean-specifier'. |
| 428 | 349 |
| 350 highlight Highlight all text covered by this face. | |
| 351 Only used by faces on TTY devices. | |
| 442 | 352 For valid instantiators, see `make-face-boolean-specifier'. |
| 428 | 353 |
| 354 dim Dim all text covered by this face. | |
| 442 | 355 For valid instantiators, see `make-face-boolean-specifier'. |
| 428 | 356 |
| 357 blinking Blink all text covered by this face. | |
| 358 Only used by faces on TTY devices. | |
| 442 | 359 For valid instantiators, see `make-face-boolean-specifier'. |
| 428 | 360 |
| 361 reverse Reverse the foreground and background colors. | |
| 362 Only used by faces on TTY devices. | |
| 442 | 363 For valid instantiators, see `make-face-boolean-specifier'. |
| 428 | 364 |
|
5619
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
365 shrink Shrink the face to the actual text on the line instead of |
|
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
366 covering the whole line until the right border of the |
|
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
367 window. The effect will only be visible if the face has |
|
5617
b0d712bbc2a6
The "flush" face property.
Didier Verna <didier@xemacs.org>
parents:
5597
diff
changeset
|
368 a non default background. |
|
b0d712bbc2a6
The "flush" face property.
Didier Verna <didier@xemacs.org>
parents:
5597
diff
changeset
|
369 For valid instantiators, see `make-face-boolean-specifier'. |
|
b0d712bbc2a6
The "flush" face property.
Didier Verna <didier@xemacs.org>
parents:
5597
diff
changeset
|
370 |
| 3027 | 371 inherit Face name or face object from which to inherit attributes, |
| 372 or a list of such elements. Attributes from inherited | |
| 373 faces are merged into the face like an underlying face | |
| 374 would be, with higher priority than underlying faces. | |
| 375 | |
| 428 | 376 doc-string Description of what the face's normal use is. |
| 377 NOTE: This is not a specifier, unlike all | |
| 378 the other built-in properties, and cannot | |
| 379 contain locale-specific values." | |
| 380 | |
| 381 (setq face (get-face face)) | |
| 382 (if (memq property built-in-face-specifiers) | |
| 383 (set-specifier (get face property) value locale tag-set how-to-add) | |
| 384 | |
| 385 ;; This section adds user defined properties. | |
| 386 (if (not locale) | |
| 387 (put face property value) | |
| 388 (convert-face-property-into-specifier face property) | |
| 389 (add-spec-to-specifier (get face property) value locale tag-set | |
| 390 how-to-add))) | |
| 391 value) | |
| 392 | |
| 393 (defun remove-face-property (face property &optional locale tag-set exact-p) | |
| 394 "Remove a property from FACE. | |
| 395 For built-in properties, this is analogous to `remove-specifier'. | |
| 396 See `remove-specifier' for the meaning of the LOCALE, TAG-SET, and EXACT-P | |
| 397 arguments." | |
| 398 (or locale (setq locale 'all)) | |
| 399 (if (memq property built-in-face-specifiers) | |
| 400 (remove-specifier (face-property face property) locale tag-set exact-p) | |
| 401 (if (eq locale 'all) | |
| 402 (remprop (get-face face) property) | |
| 403 (convert-face-property-into-specifier face property) | |
| 404 (remove-specifier (face-property face property) locale tag-set | |
| 405 exact-p)))) | |
| 406 | |
| 407 (defun reset-face (face &optional locale tag-set exact-p) | |
| 408 "Clear all existing built-in specifications from FACE. | |
| 3027 | 409 This makes FACE inherit all its display properties from `default'. |
| 428 | 410 WARNING: Be absolutely sure you want to do this!!! It is a dangerous |
| 411 operation and is not undoable. | |
| 412 | |
| 413 The arguments LOCALE, TAG-SET and EXACT-P are the same as for | |
| 414 `remove-specifier'." | |
| 3918 | 415 ;; Don't reset the default face. |
| 416 (unless (eq 'default face) | |
| 417 (dolist (x built-in-face-specifiers nil) | |
| 418 (remove-specifier (face-property face x) locale tag-set exact-p)))) | |
| 428 | 419 |
| 420 (defun set-face-parent (face parent &optional locale tag-set how-to-add) | |
| 421 "Set the parent of FACE to PARENT, for all properties. | |
| 422 This makes all properties of FACE inherit from PARENT." | |
| 423 (setq parent (get-face parent)) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4764
diff
changeset
|
424 (mapc (lambda (x) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4764
diff
changeset
|
425 (set-face-property face x (vector parent) locale tag-set |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4764
diff
changeset
|
426 how-to-add)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4764
diff
changeset
|
427 (set-difference built-in-face-specifiers |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4764
diff
changeset
|
428 '(display-table background-pixmap inherit))) |
|
5344
2a54dfbe434f
Don't quote keywords, they've been self-quoting for well over a decade.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5284
diff
changeset
|
429 (set-face-background-pixmap face (vector 'inherit :face parent) |
| 428 | 430 locale tag-set how-to-add) |
| 431 nil) | |
| 432 | |
| 433 (defun face-doc-string (face) | |
| 434 "Return the documentation string for FACE." | |
| 435 (face-property face 'doc-string)) | |
| 436 | |
| 437 (defun set-face-doc-string (face doc-string) | |
| 438 "Change the documentation string of FACE to DOC-STRING." | |
| 439 (interactive (face-interactive "doc-string")) | |
| 440 (set-face-property face 'doc-string doc-string)) | |
| 441 | |
| 442 (defun face-font-name (face &optional domain charset) | |
| 443 "Return the font name of FACE in DOMAIN, or nil if it is unspecified. | |
| 3027 | 444 DOMAIN is as in `face-font-instance'. |
| 445 | |
| 446 Font names are strings, as described in `make-font-specifier'." | |
| 428 | 447 (let ((f (face-font-instance face domain charset))) |
| 448 (and f (font-instance-name f)))) | |
| 449 | |
| 450 (defun face-font (face &optional locale tag-set exact-p) | |
| 3027 | 451 "Return the font spec of FACE in LOCALE, or nil if it is unspecified. |
| 452 | |
| 453 NOTE: This returns a locale-specific specification, not any sort of value | |
| 454 corresponding to the actual font being used. If you want to know the | |
| 455 actual font used in a particular domain, use `face-font-instance', or | |
| 456 `face-font-name' for its name (i.e. the instantiator used to create it). | |
| 428 | 457 |
| 458 FACE may be either a face object or a symbol representing a face. | |
| 459 | |
| 460 LOCALE may be a locale (the instantiators for that particular locale | |
| 461 will be returned), a locale type (the specifications for all locales | |
| 3027 | 462 of that type will be returned), `all' (all specifications will be |
| 428 | 463 returned), or nil (the actual specifier object will be returned). |
| 464 | |
| 465 See `face-property' for more information." | |
| 466 (face-property face 'font locale tag-set exact-p)) | |
| 467 | |
| 468 (defun face-font-instance (face &optional domain charset) | |
| 469 "Return the instance of FACE's font in DOMAIN. | |
| 470 | |
| 3027 | 471 Return value will be a font instance object; query its properties using |
| 472 `font-instance-name', `font-instance-height', `font-instance-width', etc. | |
| 473 | |
| 428 | 474 FACE may be either a face object or a symbol representing a face. |
| 475 | |
| 476 Normally DOMAIN will be a window or nil (meaning the selected window), | |
| 477 and an instance object describing how the font appears in that | |
| 478 particular window and buffer will be returned. | |
| 479 | |
| 3659 | 480 CHARSET is a Mule charset (meaning return the font used for that charset) or |
| 481 nil (meaning return the font used for ASCII.) | |
| 482 | |
| 428 | 483 See `face-property-instance' for more information." |
| 3659 | 484 (if (null charset) |
| 485 (face-property-instance face 'font domain) | |
| 486 (let (matchspec) | |
| 487 ;; get-charset signals an error if its argument doesn't have an | |
| 488 ;; associated charset. | |
|
5368
ed74d2ca7082
Use ', not #', when a given symbol may not have a function binding at read time
Aidan Kehoe <kehoea@parhasard.net>
parents:
5366
diff
changeset
|
489 (setq charset (if-fboundp 'get-charset |
| 4222 | 490 (get-charset charset) |
| 491 (error 'unimplemented "Charset support not available")) | |
| 3659 | 492 matchspec (cons charset nil)) |
| 493 (or (null (setcdr matchspec 'initial)) | |
| 494 (face-property-matching-instance | |
| 495 face 'font matchspec domain) | |
| 496 (null (setcdr matchspec 'final)) | |
| 497 (face-property-matching-instance | |
| 498 face 'font matchspec domain))))) | |
| 428 | 499 |
| 500 (defun set-face-font (face font &optional locale tag-set how-to-add) | |
| 501 "Change the font of FACE to FONT in LOCALE. | |
| 502 | |
| 503 FACE may be either a face object or a symbol representing a face. | |
| 504 | |
| 3659 | 505 FONT should be an instantiator (see `make-font-specifier'; a common |
| 506 instantiator is a platform-dependent string naming the font), a list | |
| 507 of instantiators, an alist of specifications (each mapping a locale | |
| 508 to an instantiator list), or a font specifier object. | |
| 428 | 509 |
| 3659 | 510 If FONT is an alist, LOCALE must be omitted. If FONT is a specifier |
| 511 object, LOCALE can be a locale, a locale type, `all', or nil; see | |
| 512 `copy-specifier' for its semantics. Common LOCALEs are buffer | |
| 513 objects, window objects, device objects and `global'. Otherwise | |
| 514 LOCALE specifies the locale under which the specified | |
| 515 instantiator(s) will be added, and defaults to `global'. | |
| 428 | 516 |
| 517 See `set-face-property' for more information." | |
| 518 (interactive (face-interactive "font")) | |
| 519 (set-face-property face 'font font locale tag-set how-to-add)) | |
| 520 | |
| 521 (defun face-foreground (face &optional locale tag-set exact-p) | |
| 3027 | 522 "Return the foreground spec of FACE in LOCALE, or nil if it is unspecified. |
| 523 | |
| 524 NOTE: This returns a locale-specific specification, not any sort of value | |
| 525 corresponding to the actual foreground being used. If you want to know the | |
| 526 actual foreground color used in a particular domain, use | |
| 527 `face-foreground-instance', or `face-foreground-name' for its name | |
| 528 \(i.e. the instantiator used to create it). | |
| 428 | 529 |
| 530 FACE may be either a face object or a symbol representing a face. | |
| 531 | |
| 532 LOCALE may be a locale (the instantiators for that particular locale | |
| 533 will be returned), a locale type (the specifications for all locales | |
| 3027 | 534 of that type will be returned), `all' (all specifications will be |
| 428 | 535 returned), or nil (the actual specifier object will be returned). |
| 536 | |
| 537 See `face-property' for more information." | |
| 538 (face-property face 'foreground locale tag-set exact-p)) | |
| 539 | |
| 540 (defun face-foreground-instance (face &optional domain default no-fallback) | |
| 541 "Return the instance of FACE's foreground in DOMAIN. | |
| 542 | |
| 3027 | 543 Return value will be a color instance object; query its properties using |
| 544 `color-instance-name' or `color-instance-rgb-properties'. | |
| 545 | |
| 428 | 546 FACE may be either a face object or a symbol representing a face. |
| 547 | |
| 548 Normally DOMAIN will be a window or nil (meaning the selected window), | |
| 549 and an instance object describing how the foreground appears in that | |
| 550 particular window and buffer will be returned. | |
| 551 | |
| 552 See `face-property-instance' for more information." | |
| 553 (face-property-instance face 'foreground domain default no-fallback)) | |
| 554 | |
| 555 (defun face-foreground-name (face &optional domain default no-fallback) | |
| 556 "Return the name of FACE's foreground color in DOMAIN. | |
| 557 | |
| 558 FACE may be either a face object or a symbol representing a face. | |
| 559 | |
| 560 Normally DOMAIN will be a window or nil (meaning the selected window), | |
|
5622
4b4b37ddb7fd
Fix 'face-foreground-name docstring typo.
Didier Verna <didier@xemacs.org>
parents:
5621
diff
changeset
|
561 and an instance object describing how the foreground appears in that |
| 428 | 562 particular window and buffer will be returned. |
| 563 | |
| 564 See `face-property-instance' for more information." | |
| 565 (color-instance-name (face-foreground-instance | |
| 566 face domain default no-fallback))) | |
| 567 | |
| 568 (defun set-face-foreground (face color &optional locale tag-set how-to-add) | |
| 569 "Change the foreground color of FACE to COLOR in LOCALE. | |
| 570 | |
| 571 FACE may be either a face object or a symbol representing a face. | |
| 572 | |
| 442 | 573 COLOR should be an instantiator (see `make-color-specifier'), a list of |
| 428 | 574 instantiators, an alist of specifications (each mapping a locale to |
| 575 an instantiator list), or a color specifier object. | |
| 576 | |
| 577 If COLOR is an alist, LOCALE must be omitted. If COLOR is a | |
| 3027 | 578 specifier object, LOCALE can be a locale, a locale type, `all', |
| 428 | 579 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE |
| 580 specifies the locale under which the specified instantiator(s) | |
| 3027 | 581 will be added, and defaults to `global'. |
| 428 | 582 |
| 583 See `set-face-property' for more information." | |
| 584 (interactive (face-interactive "foreground")) | |
| 585 (set-face-property face 'foreground color locale tag-set how-to-add)) | |
| 586 | |
|
5624
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
587 (defun face-foreback (face &optional locale tag-set exact-p) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
588 "Return the foreback spec of FACE in LOCALE, or nil if it is unspecified. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
589 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
590 NOTE: This returns a locale-specific specification, not any sort of value |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
591 corresponding to the actual foreback being used. If you want to know the |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
592 actual foreback color used in a particular domain, use |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
593 `face-foreback-instance', or `face-foreback-name' for its name |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
594 \(i.e. the instantiator used to create it). |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
595 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
596 FACE may be either a face object or a symbol representing a face. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
597 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
598 LOCALE may be a locale (the instantiators for that particular locale |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
599 will be returned), a locale type (the specifications for all locales |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
600 of that type will be returned), `all' (all specifications will be |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
601 returned), or nil (the actual specifier object will be returned). |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
602 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
603 See `face-property' for more information." |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
604 (face-property face 'foreback locale tag-set exact-p)) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
605 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
606 (defun face-foreback-instance (face &optional domain default no-fallback) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
607 "Return the instance of FACE's foreback in DOMAIN. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
608 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
609 Return value will be a color instance object; query its properties using |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
610 `color-instance-name' or `color-instance-rgb-properties'. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
611 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
612 FACE may be either a face object or a symbol representing a face. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
613 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
614 Normally DOMAIN will be a window or nil (meaning the selected window), |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
615 and an instance object describing how the foreback appears in that |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
616 particular window and buffer will be returned. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
617 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
618 See `face-property-instance' for more information." |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
619 (face-property-instance face 'foreback domain default no-fallback)) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
620 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
621 (defun face-foreback-name (face &optional domain default no-fallback) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
622 "Return the name of FACE's foreback color in DOMAIN. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
623 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
624 FACE may be either a face object or a symbol representing a face. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
625 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
626 Normally DOMAIN will be a window or nil (meaning the selected window), |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
627 and an instance object describing how the foreback appears in that |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
628 particular window and buffer will be returned. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
629 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
630 See `face-property-instance' for more information." |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
631 (color-instance-name (face-foreback-instance |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
632 face domain default no-fallback))) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
633 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
634 (defun set-face-foreback (face color &optional locale tag-set how-to-add) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
635 "Change the foreback color of FACE to COLOR in LOCALE. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
636 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
637 FACE may be either a face object or a symbol representing a face. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
638 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
639 COLOR should be an instantiator (see `make-color-specifier'), a list of |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
640 instantiators, an alist of specifications (each mapping a locale to |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
641 an instantiator list), or a color specifier object. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
642 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
643 If COLOR is an alist, LOCALE must be omitted. If COLOR is a |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
644 specifier object, LOCALE can be a locale, a locale type, `all', |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
645 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
646 specifies the locale under which the specified instantiator(s) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
647 will be added, and defaults to `global'. |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
648 |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
649 See `set-face-property' for more information." |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
650 (interactive (face-interactive "foreback")) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
651 (set-face-property face 'foreback color locale tag-set how-to-add)) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
652 |
| 428 | 653 (defun face-background (face &optional locale tag-set exact-p) |
| 654 "Return the background color of FACE in LOCALE, or nil if it is unspecified. | |
| 655 | |
| 3027 | 656 NOTE: This returns a locale-specific specification, not any sort of value |
| 657 corresponding to the actual background being used. If you want to know the | |
| 658 actual background color used in a particular domain, use | |
| 659 `face-background-instance', or `face-background-name' for its name | |
| 660 \(i.e. the instantiator used to create it). | |
| 661 | |
| 428 | 662 FACE may be either a face object or a symbol representing a face. |
| 663 | |
| 664 LOCALE may be a locale (the instantiators for that particular locale | |
| 665 will be returned), a locale type (the specifications for all locales | |
| 3027 | 666 of that type will be returned), `all' (all specifications will be |
| 428 | 667 returned), or nil (the actual specifier object will be returned). |
| 668 | |
| 669 See `face-property' for more information." | |
| 670 (face-property face 'background locale tag-set exact-p)) | |
| 671 | |
| 672 (defun face-background-instance (face &optional domain default no-fallback) | |
| 673 "Return the instance of FACE's background in DOMAIN. | |
| 674 | |
| 3027 | 675 Return value will be a color instance object; query its properties using |
| 676 `color-instance-name' or `color-instance-rgb-properties'. | |
| 677 | |
| 428 | 678 FACE may be either a face object or a symbol representing a face. |
| 679 | |
| 680 Normally DOMAIN will be a window or nil (meaning the selected window), | |
| 681 and an instance object describing how the background appears in that | |
| 682 particular window and buffer will be returned. | |
| 683 | |
| 684 See `face-property-instance' for more information." | |
| 685 (face-property-instance face 'background domain default no-fallback)) | |
| 686 | |
| 687 (defun face-background-name (face &optional domain default no-fallback) | |
| 688 "Return the name of FACE's background color in DOMAIN. | |
| 689 | |
| 690 FACE may be either a face object or a symbol representing a face. | |
| 691 | |
| 692 Normally DOMAIN will be a window or nil (meaning the selected window), | |
| 693 and an instance object describing how the background appears in that | |
| 694 particular window and buffer will be returned. | |
| 695 | |
| 696 See `face-property-instance' for more information." | |
| 697 (color-instance-name (face-background-instance | |
| 698 face domain default no-fallback))) | |
| 699 | |
| 700 (defun set-face-background (face color &optional locale tag-set how-to-add) | |
| 701 "Change the background color of FACE to COLOR in LOCALE. | |
| 702 | |
| 703 FACE may be either a face object or a symbol representing a face. | |
| 704 | |
| 442 | 705 COLOR should be an instantiator (see `make-color-specifier'), a list of |
| 428 | 706 instantiators, an alist of specifications (each mapping a locale to |
| 707 an instantiator list), or a color specifier object. | |
| 708 | |
| 709 If COLOR is an alist, LOCALE must be omitted. If COLOR is a | |
| 3027 | 710 specifier object, LOCALE can be a locale, a locale type, `all', |
| 428 | 711 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE |
| 712 specifies the locale under which the specified instantiator(s) | |
| 3027 | 713 will be added, and defaults to `global'. |
| 428 | 714 |
| 715 See `set-face-property' for more information." | |
| 716 (interactive (face-interactive "background")) | |
| 717 (set-face-property face 'background color locale tag-set how-to-add)) | |
| 718 | |
| 719 (defun face-background-pixmap (face &optional locale tag-set exact-p) | |
| 3027 | 720 "Return the background pixmap spec of FACE in LOCALE, or nil if unspecified. |
| 428 | 721 This property is only used on window system devices. |
| 722 | |
| 3027 | 723 NOTE: This returns a locale-specific specification, not any sort of value |
| 724 corresponding to the actual background pixmap being used. If you want to | |
| 725 know the actual background pixmap used in a particular domain, use | |
| 726 `face-background-pixmap-instance'. | |
| 727 | |
| 428 | 728 FACE may be either a face object or a symbol representing a face. |
| 729 | |
| 730 LOCALE may be a locale (the instantiators for that particular locale | |
| 731 will be returned), a locale type (the specifications for all locales | |
| 3027 | 732 of that type will be returned), `all' (all specifications will be |
| 428 | 733 returned), or nil (the actual specifier object will be returned). |
| 734 | |
| 735 See `face-property' for more information." | |
| 736 (face-property face 'background-pixmap locale tag-set exact-p)) | |
| 737 | |
| 738 (defun face-background-pixmap-instance (face &optional domain default | |
| 739 no-fallback) | |
| 740 "Return the instance of FACE's background pixmap in DOMAIN. | |
| 741 | |
| 3027 | 742 Return value will be an image instance object; query its properties using |
| 743 `image-instance-instantiator' (the original instantiator used to create | |
| 744 the image, which may be a complex beast -- see `make-image-specifier'), | |
| 745 `image-instance-file-name' (the file, if any, from which the image was | |
| 746 created), `image-instance-height', etc. | |
| 747 | |
| 428 | 748 FACE may be either a face object or a symbol representing a face. |
| 749 | |
| 750 Normally DOMAIN will be a window or nil (meaning the selected window), | |
| 751 and an instance object describing how the background appears in that | |
| 752 particular window and buffer will be returned. | |
| 753 | |
| 754 See `face-property-instance' for more information." | |
| 755 (face-property-instance face 'background-pixmap domain default no-fallback)) | |
| 756 | |
| 757 (defun set-face-background-pixmap (face pixmap &optional locale tag-set | |
| 758 how-to-add) | |
| 759 "Change the background pixmap of FACE to PIXMAP in LOCALE. | |
| 760 This property is only used on window system devices. | |
| 761 | |
| 762 FACE may be either a face object or a symbol representing a face. | |
| 763 | |
| 442 | 764 PIXMAP should be an instantiator (see `make-image-specifier'), a list |
| 428 | 765 of instantiators, an alist of specifications (each mapping a locale |
| 766 to an instantiator list), or an image specifier object. | |
| 767 | |
| 768 If PIXMAP is an alist, LOCALE must be omitted. If PIXMAP is a | |
| 3027 | 769 specifier object, LOCALE can be a locale, a locale type, `all', |
| 428 | 770 or nil; see `copy-specifier' for its semantics. Otherwise LOCALE |
| 771 specifies the locale under which the specified instantiator(s) | |
| 3027 | 772 will be added, and defaults to `global'. |
| 428 | 773 |
| 774 See `set-face-property' for more information." | |
| 775 (interactive (face-interactive "background-pixmap")) | |
| 776 (set-face-property face 'background-pixmap pixmap locale tag-set how-to-add)) | |
| 777 | |
| 1137 | 778 (defvar background-pixmap-file-history nil |
| 779 ;; History for `set-face-background-pixmap-file' | |
| 780 ) | |
| 781 | |
| 782 (defun set-face-background-pixmap-file (face file) | |
| 783 "Read (and set) the background pixmap of FACE from FILE. | |
| 784 This function is a simplified version of `set-face-background-pixmap', | |
| 785 designed for interactive use." | |
| 786 (interactive | |
| 787 (let* ((face (read-face-name "Set background pixmap of face: ")) | |
| 1139 | 788 (default (and (face-background-pixmap-instance face) |
|
4670
5a54ce6dc945
Remove some extra parentheses, #'set-face-background-pixmap-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4222
diff
changeset
|
789 (image-instance-file-name |
|
5a54ce6dc945
Remove some extra parentheses, #'set-face-background-pixmap-file.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4222
diff
changeset
|
790 (face-background-pixmap-instance face)))) |
| 1137 | 791 (file (read-file-name |
| 792 (format "Set background pixmap of face %s to: " | |
| 793 (symbol-name face)) | |
| 1139 | 794 nil default t nil |
| 1137 | 795 'background-pixmap-file-history))) |
| 796 (list face (if (equal file "") nil file)))) | |
| 797 (set-face-property face 'background-pixmap file)) | |
| 798 | |
|
5080
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
799 (defun face-background-placement (face &optional domain default no-fallback) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
800 "Return FACE's background placement in DOMAIN. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
801 See `face-property-instance' for the semantics of the DOMAIN argument." |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
802 (face-property face 'background-placement domain default no-fallback)) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
803 |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
804 (defun set-face-background-placement (face placement &optional locale tag-set |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
805 how-to-add) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
806 "Change the background-placement property of FACE to PLACEMENT. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
807 PLACEMENT is normally a background-placement instantiator; see |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
808 `make-face-background-placement-specifier'. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
809 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
810 HOW-TO-ADD arguments." |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
811 (interactive (face-interactive "background placement")) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
812 ;; When called non-interactively (for example via custom), PLACEMENT is |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
813 ;; expected to be a symbol. -- dvl |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
814 (unless (symbolp placement) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
815 (setq placement (intern placement))) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
816 (set-face-property face 'background-placement placement locale tag-set |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
817 how-to-add)) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
818 |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
819 (defun face-background-placement-instance (face &optional domain default |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
820 no-fallback) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
821 "Return FACE's background-placement instance in DOMAIN. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
822 Return value will be a background-placement instance object. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
823 |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
824 FACE may be either a face object or a symbol representing a face. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
825 |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
826 Normally DOMAIN will be a window or nil (meaning the selected window), |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
827 and an instance object describing the background placement in that particular |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
828 window and buffer will be returned. |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
829 |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
830 See `face-property-instance' for more information." |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
831 (face-property-instance face 'background-placement domain default |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
832 no-fallback)) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
833 |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
834 (defun face-background-placement-instance-p (object) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
835 "Return t if OBJECT is a face-background-placement instance." |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
836 (or (eq object 'absolute) (eq object 'relative))) |
|
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
837 |
| 428 | 838 (defun face-display-table (face &optional locale tag-set exact-p) |
| 3027 | 839 "Return the display table spec of FACE in LOCALE, or nil if unspecified.. |
| 428 | 840 |
| 3027 | 841 NOTE: This returns a locale-specific specification, not any sort of value |
| 842 corresponding to the actual display table being used. If you want to | |
| 843 know the actual display table used in a particular domain, use | |
| 844 `face-display-table-instance'. | |
| 845 | |
| 846 FACE may be either a face object or a symbol representing a face. | |
| 428 | 847 |
| 848 LOCALE may be a locale (the instantiators for that particular locale | |
| 849 will be returned), a locale type (the specifications for all locales | |
| 3027 | 850 of that type will be returned), `all' (all specifications will be |
| 428 | 851 returned), or nil (the actual specifier object will be returned). |
| 852 | |
| 853 See `face-property' for more information." | |
| 854 (face-property face 'display-table locale tag-set exact-p)) | |
| 855 | |
| 856 (defun face-display-table-instance (face &optional domain default no-fallback) | |
| 857 "Return the instance of FACE's display table in DOMAIN. | |
| 3027 | 858 |
| 859 Return value will be a vector, char table or range table; see | |
| 860 `current-display-table'. | |
| 861 | |
| 862 FACE may be either a face object or a symbol representing a face. | |
| 428 | 863 |
| 3027 | 864 Normally DOMAIN will be a window or nil (meaning the selected window), |
| 865 and the actual display table used in that particular window and buffer | |
| 866 will be returned. | |
| 867 | |
| 868 See `face-property-instance' for more information." | |
| 428 | 869 (face-property-instance face 'display-table domain default no-fallback)) |
| 870 | |
| 871 (defun set-face-display-table (face display-table &optional locale tag-set | |
| 872 | 872 how-to-add) |
| 428 | 873 "Change the display table of FACE to DISPLAY-TABLE in LOCALE. |
| 874 DISPLAY-TABLE should be a vector as returned by `make-display-table'. | |
| 875 | |
| 876 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and | |
| 877 HOW-TO-ADD arguments." | |
| 878 (interactive (face-interactive "display-table")) | |
| 879 (set-face-property face 'display-table display-table locale tag-set | |
| 880 how-to-add)) | |
| 881 | |
| 882 ;; The following accessors and mutators are, IMHO, good | |
| 883 ;; implementation. Cf. with `make-face-bold'. | |
| 884 | |
| 885 (defun face-underline-p (face &optional domain default no-fallback) | |
| 886 "Return t if FACE is underlined in DOMAIN. | |
| 887 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 888 (face-property-instance face 'underline domain default no-fallback)) | |
| 889 | |
| 890 (defun set-face-underline-p (face underline-p &optional locale tag-set | |
| 872 | 891 how-to-add) |
| 428 | 892 "Change the underline property of FACE to UNDERLINE-P. |
| 893 UNDERLINE-P is normally a face-boolean instantiator; see | |
| 442 | 894 `make-face-boolean-specifier'. |
| 428 | 895 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
| 896 HOW-TO-ADD arguments." | |
| 897 (interactive (face-interactive "underline-p" "underlined")) | |
| 898 (set-face-property face 'underline underline-p locale tag-set how-to-add)) | |
| 899 | |
| 900 (defun face-strikethru-p (face &optional domain default no-fallback) | |
| 901 "Return t if FACE is strikethru-d (i.e. struck through) in DOMAIN. | |
| 902 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 903 (face-property-instance face 'strikethru domain default no-fallback)) | |
| 904 | |
| 905 (defun set-face-strikethru-p (face strikethru-p &optional locale tag-set | |
| 872 | 906 how-to-add) |
| 428 | 907 "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE. |
| 908 STRIKETHRU-P is normally a face-boolean instantiator; see | |
| 442 | 909 `make-face-boolean-specifier'. |
| 428 | 910 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
| 911 HOW-TO-ADD arguments." | |
| 912 (interactive (face-interactive "strikethru-p" "strikethru-d")) | |
| 913 (set-face-property face 'strikethru strikethru-p locale tag-set how-to-add)) | |
| 914 | |
| 915 (defun face-highlight-p (face &optional domain default no-fallback) | |
| 916 "Return t if FACE is highlighted in DOMAIN (TTY domains only). | |
| 917 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 918 (face-property-instance face 'highlight domain default no-fallback)) | |
| 919 | |
| 920 (defun set-face-highlight-p (face highlight-p &optional locale tag-set | |
| 872 | 921 how-to-add) |
| 428 | 922 "Change whether FACE is highlighted in LOCALE (TTY locales only). |
| 923 HIGHLIGHT-P is normally a face-boolean instantiator; see | |
| 442 | 924 `make-face-boolean-specifier'. |
| 428 | 925 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
| 926 HOW-TO-ADD arguments." | |
| 927 (interactive (face-interactive "highlight-p" "highlighted")) | |
| 928 (set-face-property face 'highlight highlight-p locale tag-set how-to-add)) | |
| 929 | |
| 930 (defun face-dim-p (face &optional domain default no-fallback) | |
| 931 "Return t if FACE is dimmed in DOMAIN. | |
| 932 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 933 (face-property-instance face 'dim domain default no-fallback)) | |
| 934 | |
| 935 (defun set-face-dim-p (face dim-p &optional locale tag-set how-to-add) | |
| 936 "Change whether FACE is dimmed in LOCALE. | |
| 937 DIM-P is normally a face-boolean instantiator; see | |
| 442 | 938 `make-face-boolean-specifier'. |
| 428 | 939 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
| 940 HOW-TO-ADD arguments." | |
| 941 (interactive (face-interactive "dim-p" "dimmed")) | |
| 942 (set-face-property face 'dim dim-p locale tag-set how-to-add)) | |
| 943 | |
| 944 (defun face-blinking-p (face &optional domain default no-fallback) | |
| 945 "Return t if FACE is blinking in DOMAIN (TTY domains only). | |
| 946 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 947 (face-property-instance face 'blinking domain default no-fallback)) | |
| 948 | |
| 949 (defun set-face-blinking-p (face blinking-p &optional locale tag-set | |
| 872 | 950 how-to-add) |
| 428 | 951 "Change whether FACE is blinking in LOCALE (TTY locales only). |
| 952 BLINKING-P is normally a face-boolean instantiator; see | |
| 442 | 953 `make-face-boolean-specifier'. |
| 428 | 954 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
| 955 HOW-TO-ADD arguments." | |
| 956 (interactive (face-interactive "blinking-p" "blinking")) | |
| 957 (set-face-property face 'blinking blinking-p locale tag-set how-to-add)) | |
| 958 | |
| 959 (defun face-reverse-p (face &optional domain default no-fallback) | |
| 960 "Return t if FACE is reversed in DOMAIN (TTY domains only). | |
| 961 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 962 (face-property-instance face 'reverse domain default no-fallback)) | |
| 963 | |
| 964 (defun set-face-reverse-p (face reverse-p &optional locale tag-set how-to-add) | |
| 965 "Change whether FACE is reversed in LOCALE (TTY locales only). | |
| 966 REVERSE-P is normally a face-boolean instantiator; see | |
| 442 | 967 `make-face-boolean-specifier'. |
| 428 | 968 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
| 969 HOW-TO-ADD arguments." | |
| 970 (interactive (face-interactive "reverse-p" "reversed")) | |
| 971 (set-face-property face 'reverse reverse-p locale tag-set how-to-add)) | |
| 972 | |
|
5619
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
973 (defun face-shrink-p (face &optional domain default no-fallback) |
|
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
974 "Return t if FACE is shrinked in DOMAIN. |
|
5617
b0d712bbc2a6
The "flush" face property.
Didier Verna <didier@xemacs.org>
parents:
5597
diff
changeset
|
975 See `face-property-instance' for the semantics of the DOMAIN argument." |
|
5619
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
976 (face-property-instance face 'shrink domain default no-fallback)) |
|
5617
b0d712bbc2a6
The "flush" face property.
Didier Verna <didier@xemacs.org>
parents:
5597
diff
changeset
|
977 |
|
5619
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
978 (defun set-face-shrink-p (face shrink-p &optional locale tag-set how-to-add) |
|
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
979 "Change whether FACE is shrinked in LOCALE. |
|
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
980 SHRINK-P is normally a face-boolean instantiator; see |
|
5617
b0d712bbc2a6
The "flush" face property.
Didier Verna <didier@xemacs.org>
parents:
5597
diff
changeset
|
981 `make-face-boolean-specifier'. |
|
b0d712bbc2a6
The "flush" face property.
Didier Verna <didier@xemacs.org>
parents:
5597
diff
changeset
|
982 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and |
|
b0d712bbc2a6
The "flush" face property.
Didier Verna <didier@xemacs.org>
parents:
5597
diff
changeset
|
983 HOW-TO-ADD arguments." |
|
5619
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
984 (interactive (face-interactive "shrink-p" "shrinked")) |
|
75ad4969a16d
Replace the 'flush face property with the opposite 'shrink one.
Didier Verna <didier@xemacs.org>
parents:
5617
diff
changeset
|
985 (set-face-property face 'shrink shrink-p locale tag-set how-to-add)) |
|
5617
b0d712bbc2a6
The "flush" face property.
Didier Verna <didier@xemacs.org>
parents:
5597
diff
changeset
|
986 |
| 428 | 987 |
| 988 (defun face-property-equal (face1 face2 prop domain) | |
| 989 (equal (face-property-instance face1 prop domain) | |
| 990 (face-property-instance face2 prop domain))) | |
| 991 | |
| 992 (defun face-equal-loop (props face1 face2 domain) | |
| 993 (while (and props | |
| 994 (face-property-equal face1 face2 (car props) domain)) | |
| 995 (setq props (cdr props))) | |
| 996 (null props)) | |
| 997 | |
| 998 (defun face-equal (face1 face2 &optional domain) | |
| 999 "Return t if FACE1 and FACE2 will display in the same way in DOMAIN. | |
| 1000 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 1001 (if (null domain) (setq domain (selected-window))) | |
| 1002 (if (not (valid-specifier-domain-p domain)) | |
| 1003 (error "Invalid specifier domain")) | |
| 1004 (let ((device (dfw-device domain)) | |
|
5624
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
1005 (common-props '(foreground background |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
1006 font display-table underline |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
1007 dim inherit shrink)) |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
1008 (win-props '(foreback background-pixmap background-placement |
|
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
1009 strikethru)) |
| 428 | 1010 (tty-props '(highlight blinking reverse))) |
| 1011 | |
| 1012 ;; First check the properties which are used in common between the | |
| 1013 ;; x and tty devices. Then, check those properties specific to | |
| 1014 ;; the particular device type. | |
| 1015 (and (face-equal-loop common-props face1 face2 domain) | |
| 1016 (cond ((eq 'tty (device-type device)) | |
| 1017 (face-equal-loop tty-props face1 face2 domain)) | |
| 872 | 1018 ((console-on-window-system-p (device-console device)) |
| 428 | 1019 (face-equal-loop win-props face1 face2 domain)) |
| 1020 (t t))))) | |
| 1021 | |
| 1022 (defun face-differs-from-default-p (face &optional domain) | |
| 1023 "Return t if FACE will display differently from the default face in DOMAIN. | |
| 1024 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 1025 (not (face-equal face 'default domain))) | |
| 1026 | |
| 1027 (defun try-font-name (name &optional device) | |
| 872 | 1028 "Return NAME if it's a valid font name on DEVICE, else nil." |
| 428 | 1029 ;; yes, name really should be here twice. |
| 1030 (and name (make-font-instance name device t) name)) | |
| 1031 | |
| 1032 | |
| 872 | 1033 |
| 1034 (defcustom face-frob-from-locale-first nil | |
| 1035 "*If non nil, use kludgy way of frobbing fonts suitable for non-mule | |
| 1036 multi-charset environments." | |
| 1037 :group 'faces | |
| 1038 :type 'boolean) | |
| 1039 | |
| 428 | 1040 ;; This function is a terrible, disgusting hack!!!! Need to |
| 1041 ;; separate out the font elements as separate face properties! | |
| 1042 | |
| 1043 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1044 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1045 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1046 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1047 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1048 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1049 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1050 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1051 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1052 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1053 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1054 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1055 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1056 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 1057 ;; WE DEMAND LEXICAL SCOPING!!! | |
| 872 | 1058 |
| 1059 ;; When we are initializing a device, it won't be selected; we communicate | |
| 1060 ;; the device to consider as selected using this variable. | |
| 1061 (defvar Face-frob-property-device-considered-current nil) | |
| 428 | 1062 |
| 872 | 1063 (defun Face-frob-property (face locale tag-set exact-p |
| 1064 unfrobbed-face frobbed-face | |
| 1065 win-prop tty-props | |
| 1066 frob-mapping standard-face-mapping) | |
| 1067 ;; implement the semantics of `make-face-bold' et al. FACE, LOCALE, TAG-SET | |
| 1068 ;; and EXACT-P are as in that call. UNFROBBED-FACE and FROBBED-FACE are | |
| 1069 ;; what we expect the original face and the result to look like, | |
| 1070 ;; respectively. TTY-PROPS is a list of face properties to frob in place | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1071 ;; of `font' for TTYs. FROB-MAPPING is either a plist mapping device |
| 872 | 1072 ;; types to functions of two args (NAME DEVICE) that will frob the |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1073 ;; instantiator to NAME as appropriate for DEVICE's type (this includes |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1074 ;; TTYs #### TTYs are not passed the device, just the symbol 'tty), or a |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1075 ;; function to handle the mapping for all device types. |
| 872 | 1076 ;; STANDARD-FACE-MAPPING is an alist of mappings of inheritance |
| 1077 ;; instantiators to be replaced with other inheritance instantiators, meant | |
| 1078 ;; for e.g. converting [bold] into [bold-italic]. | |
| 1079 | |
| 1080 ;; #### it would be nice if this function could be generalized to be | |
| 1081 ;; a general specifier frobber. but so much of what it does is specific | |
| 1082 ;; to faces -- e.g. handling of inheritance, standard faces, | |
| 1083 ;; special-casing in various ways for tty's, etc. i've already extracted | |
| 1084 ;; as much of the functionality as i can into subfunctions in the | |
| 1085 ;; heuristic section of specifier.el. | |
| 442 | 1086 |
| 872 | 1087 ;; #### Note: The old code was totally different (and there was much less |
| 1088 ;; of it). It didn't bother with trying to frob all the instantiators, | |
| 1089 ;; or handle inheritance vectors as instantiators, or do something | |
| 1090 ;; sensible with buffer locales, or many other things. (It always, or | |
| 1091 ;; usually, did a specifier-instance and frobbed the result.) But it did | |
| 1092 ;; do three things we don't: | |
| 1093 ;; | |
| 1094 ;; (1) Map over all devices when processing global or buffer locales. | |
| 1095 ;; Should we be doing this in stages 2 and/or 3? The fact that we | |
| 1096 ;; now process all fallback instantiators seems to make this less | |
| 1097 ;; necessary, at least for global locales. | |
| 1098 ;; | |
| 1099 ;; (2) Remove all instantiators tagged with `default' when putting the | |
| 1100 ;; instantiators back. I don't see why this is necessary, but maybe | |
| 1101 ;; it is. | |
| 1102 ;; | |
| 1103 ;; (3) Pay attention to the face-frob-from-locale-first variable. #### | |
| 1104 ;; I don't understand its purpose. Undocumented hacks like this, | |
| 1105 ;; clearly added after-the-fact, don't deserve to live. DOCUMENT | |
| 1106 ;; THIS SHIT! | |
| 428 | 1107 |
|
5567
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5484
diff
changeset
|
1108 (labels |
| 872 | 1109 ( |
| 1110 | |
| 1111 ;; non-nil if either instantiator non-nil, or nil instantiators allowed. | |
| 1112 (nil-instantiator-ok (inst devtype-spec) | |
| 1113 (or inst (eq devtype-spec 'tty))) | |
| 1114 | |
| 1115 ;; if LOCALE is a global locale (all, nil, global), return 'global, | |
| 1116 ;; else nil. | |
| 1117 (global-locale (locale) | |
| 1118 (and (memq locale '(all nil global)) 'global)) | |
| 444 | 1119 |
| 872 | 1120 ;; Given a locale and the inst-list from that locale, frob the |
| 1121 ;; instantiators according to FROB-MAPPING, a plist mapping device | |
| 1122 ;; types to functions that frob instantiators of that device type. | |
| 1123 ;; NOTE: TAG-SET and FROB-MAPPING from environment. | |
| 1124 (frob-face-inst-list (locale inst-list prop devtype-spec) | |
| 1125 (let* ((ffpdev Face-frob-property-device-considered-current) | |
| 1126 (results | |
| 1127 ;; for each inst-pair, frob it (the result will be 0 or | |
| 1128 ;; more inst-pairs; we may get more than one if, e.g. the | |
| 1129 ;; instantiator specifies inheritance and we expand the | |
| 1130 ;; inheritance); then nconc the results together | |
| 1131 (loop for (tag-set . x) in inst-list | |
| 1132 for devtype = (derive-device-type-from-locale-and-tag-set | |
| 1133 locale tag-set devtype-spec ffpdev) | |
| 1134 ;; devtype may be nil if it fails to match DEVTYPE-SPEC | |
| 1135 if devtype | |
| 3360 | 1136 if (let* ((mapper |
| 1137 (cond ((functionp frob-mapping) frob-mapping) | |
| 1138 ((plist-get frob-mapping devtype)) | |
| 1139 (t (error 'unimplemented "mapper" devtype)))) | |
| 872 | 1140 (result |
| 1141 (cond | |
| 1142 ;; if a vector ... | |
| 1143 ((vectorp x) | |
| 1144 (let ((change-to | |
| 1145 (cdr (assoc x standard-face-mapping)))) | |
| 1146 (cond | |
| 1147 ;; (1) handle standard mappings/null vectors | |
| 1148 ((or change-to (null (length x))) | |
| 1149 (list (cons tag-set | |
| 1150 (cond ((eq change-to t) x) | |
| 1151 (change-to) | |
| 1152 (t x))))) | |
| 1153 ;; (2) inheritance vectors. retrieve the | |
| 1154 ;; inherited value and recursively frob. | |
| 1155 ;; stick the tag-set into the result. | |
| 1156 (t (let* | |
| 1157 ((subprop | |
| 1158 (if (> (length x) 1) (elt x 1) | |
| 1159 prop)) | |
| 1160 (subinsts | |
| 1161 (frob-face-inst-list | |
| 1162 locale | |
| 1163 (cdar | |
| 1164 (specifier-spec-list | |
| 1165 (face-property (elt x 0) | |
| 1166 subprop))) | |
| 1167 subprop devtype-spec))) | |
| 1168 ;; #### we don't currently handle | |
| 1169 ;; the "reverse the sense" flag on | |
| 1170 ;; tty inheritance vectors. | |
| 1171 (add-tag-to-inst-list subinsts | |
| 1172 tag-set)))))) | |
| 1173 ;; (3) not a vector. just process it. | |
| 1174 (t | |
| 1175 (let ((value | |
| 1176 (if (eq devtype-spec 'tty) | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1177 ;; #### not quite right but need |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1178 ;; two args to match documentation |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1179 ;; mostly we just ignore TTYs so |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1180 ;; for now just pass the devtype |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1181 (funcall mapper x 'tty) |
| 872 | 1182 (funcall mapper x |
| 1183 (derive-domain-from-locale | |
| 1184 locale devtype-spec | |
| 1185 ffpdev))))) | |
| 1186 (and (nil-instantiator-ok value devtype-spec) | |
| 1187 (list (cons tag-set value)))))))) | |
| 1188 ;; if we're adding to a tty, we need to tag our | |
| 1189 ;; additions with `tty'; see [note 1] below. we leave | |
| 1190 ;; the old spec in place, however -- if e.g. we're | |
| 1191 ;; italicizing a font that was always set to be | |
| 1192 ;; underlined, even on window systems, then we still | |
| 1193 ;; want the underline there. unless we put the old | |
| 1194 ;; spec back, the underline will disappear, since | |
| 1195 ;; the new specs are all tagged with `tty'. this | |
| 1196 ;; doesn't apply to the [note 1] situations below | |
| 1197 ;; because there we're just adding, not substituting. | |
| 1198 (if (and (eq 'tty devtype-spec) | |
| 1199 (not (or (eq 'tty tag-set) | |
| 1200 (memq 'tty tag-set)))) | |
| 1201 (nconc (add-tag-to-inst-list result 'tty) | |
| 1202 (list (cons tag-set x))) | |
| 1203 result)) | |
| 1204 nconc it))) | |
| 1205 (delete-duplicates results :test #'equal))) | |
| 428 | 1206 |
| 872 | 1207 ;; Frob INST-LIST, which came from LOCALE, and put the new value back |
| 1208 ;; into SP at LOCALE. THUNK is a cons of (PROP . DEVTYPE-SPEC), the | |
| 1209 ;; property being processed and whether this is a TTY property or a | |
| 1210 ;; win property. | |
| 1211 (frob-locale (sp locale inst-list thunk) | |
| 1212 (let ((newinst (frob-face-inst-list locale inst-list | |
| 1213 (car thunk) (cdr thunk)))) | |
| 1214 (remove-specifier sp locale tag-set exact-p) | |
| 1215 (add-spec-list-to-specifier sp (list (cons locale newinst)))) | |
| 1216 ;; map-specifier should keep going | |
| 1217 nil) | |
| 428 | 1218 |
| 872 | 1219 ;; map over all specified locales in LOCALE; for each locale, |
| 1220 ;; frob the instantiators in that locale in the specifier in both | |
| 1221 ;; WIN-PROP and TTY-PROPS in FACE. Takes values from environment. | |
| 1222 (map-over-locales (locale) | |
| 1223 (map-specifier (get face win-prop) #'frob-locale locale | |
| 1224 (cons win-prop 'window-system) | |
| 1225 tag-set exact-p) | |
| 1226 (loop for prop in tty-props do | |
| 1227 (map-specifier (get face prop) #'frob-locale locale | |
| 1228 (cons prop 'tty) | |
| 1229 tag-set exact-p))) | |
| 1230 | |
|
5567
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5484
diff
changeset
|
1231 ;; end of labels |
| 872 | 1232 ) |
| 1233 | |
|
5576
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5567
diff
changeset
|
1234 (declare (inline global-locale nil-instantiator-ok)) |
| 872 | 1235 ;; the function itself |
| 452 | 1236 |
| 872 | 1237 (let* ((ffpdev Face-frob-property-device-considered-current) |
| 1238 (do-later-stages | |
| 1239 (or (global-locale locale) | |
| 1240 (valid-specifier-domain-p locale) | |
| 1241 (bufferp locale))) | |
| 1242 (domain (and do-later-stages | |
| 1243 (derive-domain-from-locale locale 'window-system | |
| 1244 ffpdev))) | |
| 1245 (check-differences | |
| 1246 (and unfrobbed-face frobbed-face domain | |
| 1247 (not (memq (face-name face) | |
| 1248 '(default bold italic bold-italic))))) | |
| 1249 (orig-instance | |
| 1250 (and check-differences | |
| 1251 (face-property-instance face win-prop domain)))) | |
| 1252 | |
| 1253 ;; first do the frobbing | |
| 1254 (setq face (get-face face)) | |
| 1255 (map-over-locales locale) | |
| 1256 | |
| 1257 (when do-later-stages | |
| 1258 | |
| 1259 (if (global-locale locale) (setq locale 'global)) | |
| 428 | 1260 |
| 872 | 1261 ;; now do the second stage -- if there's nothing there, try |
| 1262 ;; harder to find an instantiator, and frob it. | |
| 1263 (let (do-something) | |
| 1264 (loop for prop in (cons win-prop tty-props) | |
| 1265 for propspec = (get face prop) | |
| 1266 for devtype-spec = (if (eq prop win-prop) 'window-system 'tty) | |
| 1267 if propspec | |
| 1268 do | |
| 1269 (or (specifier-spec-list propspec locale) | |
| 1270 (let ((doit (derive-specifier-specs-from-locale | |
| 1271 propspec locale devtype-spec ffpdev | |
| 1272 ;; #### does this make sense? When no tags | |
| 1273 ;; given, frob the whole list of fallbacks when | |
| 1274 ;; global, else just retrieve a current-device | |
| 1275 ;; value. this tries to mirror normal practices, | |
| 1276 ;; where with no tags you want everything frobbed, | |
| 1277 ;; but with a tag you want only the tag frobbed | |
| 1278 ;; and hence you probably don't want lots and lots | |
| 1279 ;; of items there. (#### Perhaps the best way -- | |
| 1280 ;; or at least a way with some theoretical | |
| 1281 ;; justifiability -- is to fetch the fallbacks | |
| 1282 ;; that match the TAG-SET/EXACT-P, and if none, | |
| 1283 ;; fall back onto doing the selected-device | |
| 1284 ;; trick.) | |
| 1285 (and (not tag-set) (not exact-p))))) | |
| 1286 (if (and (not doit) (eq locale 'global)) | |
| 1287 (error | |
| 1288 "No fallback for specifier property %s in face %s???" | |
| 1289 prop face)) | |
| 1290 ;; [note 1] whenever we add to a tty property, | |
| 1291 ;; make sure we tag our additions with `tty' to | |
| 1292 ;; avoid accidentally messing things up on window | |
| 1293 ;; systems (e.g. when making things italic we | |
| 1294 ;; don't want to set the underline property on | |
| 1295 ;; window systems) | |
| 1296 (when doit | |
| 1297 (add-spec-list-to-specifier | |
| 1298 propspec | |
| 1299 (list (cons locale | |
| 1300 (add-tag-to-inst-list | |
| 1301 doit | |
| 1302 (append (if (listp tag-set) tag-set | |
| 1303 (list tag-set)) | |
| 1304 (if (eq devtype-spec 'tty) '(tty))) | |
| 1305 )))) | |
| 1306 (setq do-something t))))) | |
| 1307 (when do-something | |
| 1308 (map-over-locales (or (global-locale locale) locale)))) | |
| 1309 | |
| 1310 ;; then do the third stage -- check for whether we have to do | |
| 1311 ;; the inheritance trick. | |
| 1312 | |
| 1313 (when (and check-differences | |
| 1314 (let ((new-instance | |
| 1315 (face-property-instance face win-prop domain))) | |
| 1316 (and | |
| 1317 (equal orig-instance new-instance) | |
| 1318 (equal orig-instance | |
| 1319 (face-property-instance unfrobbed-face win-prop | |
| 1320 domain))))) | |
| 1321 (set-face-property face win-prop (vector frobbed-face) | |
| 1322 (or (global-locale locale) locale) tag-set)))))) | |
| 428 | 1323 |
| 707 | 1324 ;; WE DEMAND FOUNDRY FROBBING! |
| 1325 | |
| 1326 ;; Family frobbing | |
| 1327 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> | |
| 1328 ;; Brainlessly derived from make-face-size by Stephen; don't blame Jan. | |
| 1329 ;; I'm long since flown to Rio, it does you little good to blame me, either. | |
| 872 | 1330 (defun make-face-family (face family &optional locale tags exact-p) |
| 1331 "Set FACE's family to FAMILY in LOCALE, if possible." | |
| 1332 (interactive (list (read-face-name "Set family of which face: ") | |
| 1333 (read-string "Family to set: "))) | |
| 707 | 1334 |
| 872 | 1335 (Face-frob-property face locale tags exact-p |
| 1336 nil nil 'font nil | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1337 ;; #### this code is duplicated in make-face-size |
| 872 | 1338 `(lambda (f d) |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1339 ;; keep the dependency on font.el for now |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1340 ;; #### The filter on null d is a band-aid. |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1341 ;; Frob-face-property should not be passing in |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1342 ;; null devices. |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1343 (unless (or (null d) (eq d 'tty)) |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1344 (let ((fo (font-create-object f d))) |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1345 (set-font-family fo ,family) |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1346 (font-create-name fo d)))) |
| 872 | 1347 nil)) |
| 707 | 1348 |
| 1349 ;; Style (ie, typographical face) frobbing | |
| 872 | 1350 (defun make-face-bold (face &optional locale tags exact-p) |
| 428 | 1351 "Make FACE bold in LOCALE, if possible. |
| 872 | 1352 This will attempt to make the font bold for window-system locales and will |
| 1353 set the highlight flag for TTY locales. | |
| 1354 | |
| 1355 The actual behavior of this function is somewhat messy, in an attempt to | |
| 1356 get more intuitive behavior in quite a lot of different circumstances. (You | |
| 1357 might view this as indicative of design failures with specifiers, but in | |
| 1358 fact almost all code that attempts to interface to humans and produce | |
| 1359 \"intuitive\" results gets messy, particularly with a system as complicated | |
| 1360 as specifiers, whose complexity results from an attempt to work well in | |
| 1361 many different circumstances.) | |
| 1362 | |
| 1363 The meaning of LOCALE is the same as for `specifier-spec-list', i.e.: | |
| 1364 | |
| 1365 -- If LOCALE is nil, omitted, or `all', this will attempt to \"frob\" all | |
| 1366 font specifications for FACE to make them appear bold (i.e. the | |
| 1367 specifications are replaced with equivalent specifications, where the | |
| 1368 font names have been changed to the closest bold font). | |
| 1369 | |
| 1370 -- If LOCALE is a locale type \(`buffer', `window', etc.), this frobs all | |
| 1371 font specifications for locales of that type. | |
| 1372 | |
| 1373 -- If LOCALE is a particular locale, this frobs all font specifications for | |
| 1374 that locale. | |
| 428 | 1375 |
| 872 | 1376 If TAGS is given, this only processes instantiators whose tag set includes |
| 1377 all tags mentioned in TAGS. In addition, if EXACT-P is non-nil, only | |
| 1378 instantiators whose tag set exactly matches TAGS are processed; otherwise, | |
| 1379 additional tags may be present in the instantiator's tag set. | |
| 1380 | |
| 1381 This function proceeeds in three stages. | |
| 1382 | |
| 1383 STAGE 1: Frob the settings that are already present. | |
| 1384 STAGE 2: (if called for) Ensure that *some* setting exists in the locale | |
| 1385 that was given, finding it in various ways and frobbing it as in | |
| 1386 stage 1. This ensures that there is an actual setting for | |
| 1387 the locale, so you will get the expected buffer-local/frame-local | |
| 1388 behavior -- changes to the global value, to other locales, won't | |
| 1389 affect this locale, (b) the face will actually look bold in | |
| 1390 the locale. | |
| 1137 | 1391 STAGE 3: (if called for) |
| 872 | 1392 |
| 1393 The way the frobbing works depends on the device type -- first on whether | |
| 1394 or not it's TTY, and second, if it's a window-system device type, on which | |
| 1395 particular window-system device type. For locales with a specific device | |
| 1396 type, we do the frobbing in the context of that device type -- this means | |
| 1397 that for TTY device types we set the highlight flag, and for window-system | |
| 1398 device types we modify the font spec according to the rules for font specs | |
| 1399 of that device type. For global locales, we may process both the highlight | |
| 1400 flag and the font specs (depending on the device types compiled into this | |
| 1401 XEmacs). When processing font specs, we check the tag set associated with | |
| 1402 each font spec to see if it's specific to a particular device type; if so, | |
| 1403 we frob it in the context of that type, else we use the type of the current | |
| 1404 device. (A hack, but works well in practice -- and if a new device is | |
| 1405 created, we will automatically frob all the standard fonts to make sure | |
| 1406 they display OK on that device.) | |
| 1407 | |
| 1408 If LOCALE is not a locale type, and both TAGS and EXACT-P are omitted, we | |
| 1409 do further frobbing in an attempt to give more intuitive behavior. | |
| 428 | 1410 |
| 872 | 1411 First, if there are no specifications in LOCALE (if LOCALE is `all', we act |
| 1412 as if it were `global' for this step), we do our utmost to put a | |
| 1413 specification there; otherwise, this function will have no effect. For | |
| 1414 device, frame, or window locales, the face's font is instantiated using the | |
| 1415 locale as a domain, and the resulting font is frobbed and added back as a | |
| 1416 specification for this locale. If LOCALE is `global', we retrieve the | |
| 1417 fallback specs and frob them. If LOCALE is a buffer, things get tricky | |
| 1418 since you can't instantiate a specifier in a buffer domain \(the buffer can | |
| 1419 appear in multiple places, or in different places over time, so this | |
| 1420 operation is not well-defined). We used to signal an error in this case, | |
| 1421 but now we instead try to do something logical so that we work somewhat | |
| 1422 similarly to buffer-local variables. Specifically, we use | |
| 1423 `get-buffer-window' to find a window viewing the buffer, and if there is | |
| 1424 one, use this as a domain to instantiate the font, and frob the resulting | |
| 1425 value. Otherwise, we use the selected window for the same purpose. | |
| 1426 | |
| 1427 Finally, if the frobbing didn't actually make the font look any different | |
| 1428 in whatever domain we instantiated the font in (this happens, for example, | |
| 1429 if your font specification is already bold or has no bold equivalent; note | |
| 1430 that in this step, we use the selected device in place of `global' or `all' | |
| 1431 -- another hack, but works well in practice since there's usually only one | |
| 1432 device), and the font currently looks like the font of the `default' face, | |
| 1433 it is set to inherit from the `bold' face. | |
| 1434 | |
| 1435 NOTE: For the other functions defined below, the identity of these two | |
| 1436 standard faces mentioned in the previous paragraph, and the TTY properties | |
| 1437 that are modified, may be different, and whether the TTY property or | |
| 1438 properties are set or unset may be different. For example, for | |
| 1439 `make-face-unitalic', the last sentence in the previous paragraph would | |
| 1440 read \"... and the font currently looks like the font of the `italic' face, | |
| 1441 it is set to inherit from the `default' face.\", and the second sentence in | |
| 1442 the first paragraph would read \"This will attempt to make the font | |
| 1443 non-italic for window-system locales and will unset the underline flag for | |
| 1444 TTY locales.\" | |
| 1445 | |
| 1446 Here's a table indicating the behavior differences with the different | |
| 1447 functions: | |
| 1448 | |
| 1449 function face1 face2 tty-props tty-val | |
| 1450 ---------------------------------------------------------------------------- | |
| 1451 make-face-bold default bold highlight t | |
| 1452 make-face-italic default italic underline t | |
| 1453 make-face-bold-italic default bold-italic highlight,underline t | |
| 1454 make-face-unbold bold default highlight nil | |
| 1455 make-face-unitalic italic default underline nil | |
| 1456 " | |
| 428 | 1457 (interactive (list (read-face-name "Make which face bold: "))) |
| 872 | 1458 (Face-frob-property face locale tags exact-p |
| 1459 'default 'bold 'font '(highlight) | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1460 '(tty (lambda (f d) t) |
| 872 | 1461 x x-make-font-bold |
| 1462 gtk gtk-make-font-bold | |
| 1463 mswindows mswindows-make-font-bold | |
| 1464 msprinter mswindows-make-font-bold) | |
| 1465 '(([default] . [bold]) | |
| 1466 ([bold] . t) | |
| 1467 ([italic] . [bold-italic]) | |
| 1468 ([bold-italic] . t)))) | |
| 428 | 1469 |
| 872 | 1470 (defun make-face-italic (face &optional locale tags exact-p) |
| 428 | 1471 "Make FACE italic in LOCALE, if possible. |
| 442 | 1472 This will attempt to make the font italic for X/MS Windows locales and |
| 1473 will set the underline flag for TTY locales. See `make-face-bold' for | |
| 1474 the semantics of the LOCALE argument and for more specifics on exactly | |
| 1475 how this function works." | |
| 428 | 1476 (interactive (list (read-face-name "Make which face italic: "))) |
| 872 | 1477 (Face-frob-property face locale tags exact-p |
| 1478 'default 'italic 'font '(underline) | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1479 '(tty (lambda (f d) t) |
| 872 | 1480 x x-make-font-italic |
| 1481 gtk gtk-make-font-italic | |
| 1482 mswindows mswindows-make-font-italic | |
| 1483 msprinter mswindows-make-font-italic) | |
| 1484 '(([default] . [italic]) | |
| 1485 ([bold] . [bold-italic]) | |
| 1486 ([italic] . t) | |
| 1487 ([bold-italic] . t)))) | |
| 428 | 1488 |
| 872 | 1489 (defun make-face-bold-italic (face &optional locale tags exact-p) |
| 428 | 1490 "Make FACE bold and italic in LOCALE, if possible. |
| 442 | 1491 This will attempt to make the font bold-italic for X/MS Windows |
| 1492 locales and will set the highlight and underline flags for TTY | |
| 1493 locales. See `make-face-bold' for the semantics of the LOCALE | |
| 1494 argument and for more specifics on exactly how this function works." | |
| 428 | 1495 (interactive (list (read-face-name "Make which face bold-italic: "))) |
| 872 | 1496 (Face-frob-property face locale tags exact-p |
| 1497 'default 'bold-italic 'font '(underline highlight) | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1498 '(tty (lambda (f d) t) |
| 872 | 1499 x x-make-font-bold-italic |
| 1500 gtk gtk-make-font-bold-italic | |
| 1501 mswindows mswindows-make-font-bold-italic | |
| 1502 msprinter mswindows-make-font-bold-italic) | |
| 1503 '(([default] . [italic]) | |
| 1504 ([bold] . [bold-italic]) | |
| 1505 ([italic] . [bold-italic]) | |
| 1506 ([bold-italic] . t)))) | |
| 428 | 1507 |
| 872 | 1508 |
| 1509 (defun make-face-unbold (face &optional locale tags exact-p) | |
| 428 | 1510 "Make FACE non-bold in LOCALE, if possible. |
| 442 | 1511 This will attempt to make the font non-bold for X/MS Windows locales |
| 1512 and will unset the highlight flag for TTY locales. See | |
| 1513 `make-face-bold' for the semantics of the LOCALE argument and for more | |
| 1514 specifics on exactly how this function works." | |
| 428 | 1515 (interactive (list (read-face-name "Make which face non-bold: "))) |
| 872 | 1516 (Face-frob-property face locale tags exact-p |
| 1517 'bold 'default 'font '(highlight) | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1518 '(tty (lambda (f d) nil) |
| 872 | 1519 x x-make-font-unbold |
| 1520 gtk gtk-make-font-unbold | |
| 1521 mswindows mswindows-make-font-unbold | |
| 1522 msprinter mswindows-make-font-unbold) | |
| 1523 '(([default] . t) | |
| 1524 ([bold] . [default]) | |
| 1525 ([italic] . t) | |
| 1526 ([bold-italic] . [italic])))) | |
| 428 | 1527 |
| 872 | 1528 (defun make-face-unitalic (face &optional locale tags exact-p) |
| 428 | 1529 "Make FACE non-italic in LOCALE, if possible. |
| 442 | 1530 This will attempt to make the font non-italic for X/MS Windows locales |
| 1531 and will unset the underline flag for TTY locales. See | |
| 1532 `make-face-bold' for the semantics of the LOCALE argument and for more | |
| 1533 specifics on exactly how this function works." | |
| 428 | 1534 (interactive (list (read-face-name "Make which face non-italic: "))) |
| 872 | 1535 (Face-frob-property face locale tags exact-p |
| 1536 'italic 'default 'font '(underline) | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1537 '(tty (lambda (f d) nil) |
| 872 | 1538 x x-make-font-unitalic |
| 1539 gtk gtk-make-font-unitalic | |
| 1540 mswindows mswindows-make-font-unitalic | |
| 1541 msprinter mswindows-make-font-unitalic) | |
| 1542 '(([default] . t) | |
| 1543 ([bold] . t) | |
| 1544 ([italic] . [default]) | |
| 1545 ([bold-italic] . [bold])))) | |
| 428 | 1546 |
| 1547 | |
| 707 | 1548 ;; Size frobbing |
| 1549 ;; Thx Jan Vroonhof, Ref xemacs-beta <87oflypbum.fsf@petteflet.ntlworld.com> | |
| 1137 | 1550 ;; Jan had a separate helper function |
| 872 | 1551 (defun make-face-size (face size &optional locale tags exact-p) |
| 1552 "Adjust FACE to SIZE in LOCALE, if possible." | |
| 1553 (interactive (list (read-face-name "Set size of which face: ") | |
| 1554 (read-number "Size to set: " t 10))) | |
| 1555 (Face-frob-property face locale tags exact-p | |
| 1556 nil nil 'font nil | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1557 ;; #### this code is duplicated in make-face-family |
| 872 | 1558 `(lambda (f d) |
| 1559 ;; keep the dependency on font.el for now | |
|
4764
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1560 ;; #### The filter on null d is a band-aid. |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1561 ;; Frob-face-property should not be passing in |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1562 ;; null devices. |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1563 (unless (or (null d) (eq d 'tty)) |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1564 (let ((fo (font-create-object f d))) |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1565 (set-font-size fo ,size) |
|
dec62ca5a899
Prevent font frobbers from operating on TTY specs.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4741
diff
changeset
|
1566 (font-create-name fo d)))) |
| 872 | 1567 nil)) |
| 707 | 1568 |
| 428 | 1569 ;; Why do the following two functions lose so badly in so many |
| 1570 ;; circumstances? | |
| 1571 | |
| 872 | 1572 (defun make-face-smaller (face &optional locale tags exact-p) |
| 428 | 1573 "Make the font of FACE be smaller, if possible. |
| 1574 LOCALE works as in `make-face-bold' et al., but the ``inheriting- | |
| 1575 from-the-bold-face'' operations described there are not done | |
| 1576 because they don't make sense in this context." | |
| 1577 (interactive (list (read-face-name "Shrink which face: "))) | |
| 872 | 1578 (Face-frob-property face locale tags exact-p |
| 1579 nil nil 'font nil | |
| 1580 '(x x-find-smaller-font | |
| 1581 gtk gtk-find-smaller-font | |
| 1582 mswindows mswindows-find-smaller-font | |
| 1583 msprinter mswindows-find-smaller-font) | |
| 1584 nil)) | |
| 428 | 1585 |
| 872 | 1586 (defun make-face-larger (face &optional locale tags exact-p) |
| 428 | 1587 "Make the font of FACE be larger, if possible. |
| 1588 See `make-face-smaller' for the semantics of the LOCALE argument." | |
| 1589 (interactive (list (read-face-name "Enlarge which face: "))) | |
| 872 | 1590 (Face-frob-property face locale tags exact-p |
| 1591 nil nil 'font nil | |
| 1592 '(x x-find-larger-font | |
| 1593 gtk gtk-find-larger-font | |
| 1594 mswindows mswindows-find-larger-font | |
| 1595 msprinter mswindows-find-larger-font) | |
| 1596 nil)) | |
| 428 | 1597 |
| 1598 (defun invert-face (face &optional locale) | |
| 1599 "Swap the foreground and background colors of the face." | |
| 1600 (interactive (list (read-face-name "Invert face: "))) | |
| 1601 (if (valid-specifier-domain-p locale) | |
| 1602 (let ((foreface (face-foreground-instance face locale))) | |
| 1603 (set-face-foreground face (face-background-instance face locale) | |
| 1604 locale) | |
| 1605 (set-face-background face foreface locale)) | |
| 1606 (let ((forespec (copy-specifier (face-foreground face) nil locale))) | |
| 1607 (copy-specifier (face-background face) (face-foreground face) locale) | |
| 1608 (copy-specifier forespec (face-background face) locale)))) | |
| 1609 | |
| 1610 | |
| 1611 ;;; Convenience functions | |
| 1612 | |
| 1613 (defun face-ascent (face &optional domain charset) | |
| 1614 "Return the ascent of FACE in DOMAIN. | |
| 1615 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 1616 (font-ascent (face-font face) domain charset)) | |
| 1617 | |
| 1618 (defun face-descent (face &optional domain charset) | |
| 1619 "Return the descent of FACE in DOMAIN. | |
| 1620 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 1621 (font-descent (face-font face) domain charset)) | |
| 1622 | |
| 1623 (defun face-width (face &optional domain charset) | |
| 1624 "Return the width of FACE in DOMAIN. | |
| 1625 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 1626 (font-width (face-font face) domain charset)) | |
| 1627 | |
| 1628 (defun face-height (face &optional domain charset) | |
| 1629 "Return the height of FACE in DOMAIN. | |
| 1630 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 1631 (+ (face-ascent face domain charset) (face-descent face domain charset))) | |
| 1632 | |
| 1633 (defun face-proportional-p (face &optional domain charset) | |
| 1634 "Return t if FACE is proportional in DOMAIN. | |
| 1635 See `face-property-instance' for the semantics of the DOMAIN argument." | |
| 1636 (font-proportional-p (face-font face) domain charset)) | |
| 1637 | |
| 1638 | |
| 1639 ;; Functions that used to be in cus-face.el, but logically go here. | |
| 1640 | |
| 1641 (defcustom frame-background-mode nil | |
| 1642 "*The brightness of the background. | |
| 1643 Set this to the symbol dark if your background color is dark, light if | |
| 1644 your background is light, or nil (default) if you want Emacs to | |
| 1645 examine the brightness for you." | |
| 1646 :group 'faces | |
| 1647 :type '(choice (choice-item dark) | |
| 1648 (choice-item light) | |
| 1649 (choice-item :tag "Auto" nil))) | |
| 1650 | |
| 1651 ;; The old variable that many people still have in .emacs files. | |
| 1652 (define-obsolete-variable-alias 'custom-background-mode | |
| 1653 'frame-background-mode) | |
| 1654 | |
| 1655 (defun get-frame-background-mode (frame) | |
| 1656 "Detect background mode for FRAME." | |
| 1657 (let* ((color-instance (face-background-instance 'default frame)) | |
| 1658 (mode (condition-case nil | |
| 1659 (if (< (apply '+ (color-instance-rgb-components | |
| 1660 color-instance)) 65536) | |
| 1661 'dark 'light) | |
| 872 | 1662 ;; Here, we get an error on a TTY (Return value from |
| 1663 ;; color-instance-rgb-components is nil), and on the | |
| 1664 ;; initial stream device (Return value from | |
| 1665 ;; face-background-instance is nil). As we don't have a | |
| 1666 ;; good way of detecting whether a TTY is light or dark, | |
| 1667 ;; we'll guess it's dark. | |
| 428 | 1668 (error 'dark)))) |
| 1669 (set-frame-property frame 'background-mode mode) | |
| 1670 mode)) | |
| 1671 | |
| 1672 (defun extract-custom-frame-properties (frame) | |
| 1673 "Return a plist with the frame properties of FRAME used by custom." | |
| 1674 (list 'type (or (frame-property frame 'display-type) | |
| 1675 (device-type (frame-device frame))) | |
| 1676 'class (device-class (frame-device frame)) | |
| 1677 'background (or frame-background-mode | |
| 1678 (get-frame-background-mode frame)))) | |
| 1679 | |
| 1680 (defcustom init-face-from-resources t | |
| 1681 "If non nil, attempt to initialize faces from the resource database." | |
| 1682 :group 'faces | |
| 1683 :type 'boolean) | |
| 1684 | |
| 1685 ;; Old name, used by custom. Also, FSFmacs name. | |
| 1686 (defvaralias 'initialize-face-resources 'init-face-from-resources) | |
| 1687 | |
| 1688 ;; Make sure all custom setting are added with this tag so we can | |
| 1689 ;; identify-them | |
| 1690 (define-specifier-tag 'custom) | |
| 1691 | |
| 1692 (defun face-spec-set (face spec &optional frame tags) | |
| 1693 "Set FACE's face attributes according to the first matching entry in SPEC. | |
| 1694 If optional FRAME is non-nil, set it for that frame only. | |
| 1695 If it is nil, then apply SPEC to each frame individually. | |
| 1696 See `defface' for information about SPEC." | |
| 1697 (if frame | |
| 1698 (progn | |
| 1699 (reset-face face frame tags) | |
| 1700 (face-display-set face spec frame tags) | |
| 1701 (init-face-from-resources face frame)) | |
| 1702 (let ((frames (relevant-custom-frames))) | |
| 1703 (reset-face face nil tags) | |
| 1704 ;; This should not be needed. We only remove our own specifiers | |
| 1705 ;; (if (and (eq 'default face) (featurep 'x)) | |
| 1706 ;; (x-init-global-faces)) | |
| 1707 (face-display-set face spec nil tags) | |
| 1708 (while frames | |
| 1709 (face-display-set face spec (car frames) tags) | |
| 1710 (pop frames)) | |
| 1711 (init-face-from-resources face)))) | |
| 1712 | |
| 1713 (defun face-display-set (face spec &optional frame tags) | |
| 1714 "Set FACE to the attributes to the first matching entry in SPEC. | |
| 1715 Iff optional FRAME is non-nil, set it for that frame only. | |
| 1716 See `defface' for information about SPEC." | |
| 1717 (while spec | |
| 1718 (let ((display (caar spec)) | |
| 1719 (atts (cadar spec))) | |
| 1720 (pop spec) | |
| 1721 (when (face-spec-set-match-display display frame) | |
| 1722 ;; Avoid creating frame local duplicates of the global face. | |
| 1723 (unless (and frame (eq display (get face 'custom-face-display))) | |
| 1724 (apply 'face-custom-attributes-set face frame tags atts)) | |
| 1725 (unless frame | |
| 1726 (put face 'custom-face-display display)) | |
| 1727 (setq spec nil))))) | |
| 1728 | |
| 1729 (defvar default-custom-frame-properties nil | |
| 1730 "The frame properties used for the global faces. | |
| 442 | 1731 Frames not matching these properties should have frame local faces. |
| 428 | 1732 The value should be nil, if uninitialized, or a plist otherwise. |
| 1733 See `defface' for a list of valid keys and values for the plist.") | |
| 1734 | |
| 1735 (defun get-custom-frame-properties (&optional frame) | |
| 1736 "Return a plist with the frame properties of FRAME used by custom. | |
| 1737 If FRAME is nil, return the default frame properties." | |
|
5597
79a1a759ec3d
Prevent bogus caching of background in custom-properties
Vin Shelton <acs@xemacs.org>
parents:
5576
diff
changeset
|
1738 (cond (frame (extract-custom-frame-properties frame)) |
| 428 | 1739 (default-custom-frame-properties) |
| 1740 (t | |
| 1741 (setq default-custom-frame-properties | |
| 1742 (extract-custom-frame-properties (selected-frame)))))) | |
| 1743 | |
| 1744 (defun face-spec-update-all-matching (spec display plist) | |
| 1745 "Update all entries in the face spec that could match display to | |
| 444 | 1746 have the entries from the new plist and return the new spec." |
| 428 | 1747 (mapcar |
| 1748 (lambda (e) | |
| 1749 (let ((entries (car e)) | |
| 1750 (options (cadr e)) | |
| 1751 (match t) | |
| 1752 dplist | |
| 1753 (new-options plist) | |
| 1754 ) | |
| 1755 (unless (eq display t) | |
| 1756 (mapc (lambda (arg) | |
| 1757 (setq dplist (plist-put dplist (car arg) (cadr arg)))) | |
| 1758 display)) | |
| 1759 (unless (eq entries t) | |
| 1760 (mapc (lambda (arg) | |
| 1761 (setq match (and match (eq (cadr arg) | |
| 1762 (plist-get | |
| 1763 dplist (car arg) | |
| 1764 (cadr arg)))))) | |
| 1765 entries)) | |
| 1766 (if (not match) | |
| 1767 e | |
| 1768 (while new-options | |
| 1769 (setq options | |
| 1770 (plist-put options (car new-options) (cadr new-options))) | |
| 1771 (setq new-options (cddr new-options))) | |
| 1772 (list entries options)))) | |
| 1773 (copy-sequence spec))) | |
| 444 | 1774 |
| 1775 | |
| 428 | 1776 |
| 1777 (defun face-spec-set-match-display (display &optional frame) | |
| 1778 "Return non-nil if DISPLAY matches FRAME. | |
| 1779 DISPLAY is part of a spec such as can be used in `defface'. | |
| 1780 If FRAME is nil or omitted, the selected frame is used." | |
| 1781 (if (eq display t) | |
| 1782 t | |
| 1783 (let* ((props (get-custom-frame-properties frame)) | |
| 1784 (type (plist-get props 'type)) | |
| 1785 (class (plist-get props 'class)) | |
| 1786 (background (plist-get props 'background)) | |
| 1787 (match t) | |
| 1788 (entries display) | |
| 1789 entry req options) | |
| 1790 (while (and entries match) | |
| 1791 (setq entry (car entries) | |
| 1792 entries (cdr entries) | |
| 1793 req (car entry) | |
| 1794 options (cdr entry) | |
| 1795 match (case req | |
| 1796 (type (memq type options)) | |
| 1797 (class (memq class options)) | |
| 1798 (background (memq background options)) | |
|
5378
4f0a1f4cc111
Improve support for min-colors req in `defface'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5373
diff
changeset
|
1799 ;; `display-color-cells' can return nil (eg, TTYs). |
|
4f0a1f4cc111
Improve support for min-colors req in `defface'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5373
diff
changeset
|
1800 ;; If so, assume monochrome. |
|
4f0a1f4cc111
Improve support for min-colors req in `defface'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5373
diff
changeset
|
1801 (min-colors (>= (or (display-color-cells frame) 2) |
|
5373
b6e59ea11533
Add min-colors specifier to defface, and document it.
Jeff Sparkes <jsparkes@gmail.com>
parents:
5368
diff
changeset
|
1802 (car options))) |
| 428 | 1803 (t (warn "Unknown req `%S' with options `%S'" |
| 1804 req options) | |
| 1805 nil)))) | |
| 1806 match))) | |
| 1807 | |
| 1808 (defun relevant-custom-frames () | |
| 1809 "List of frames whose custom properties differ from the default." | |
| 1810 (let ((relevant nil) | |
| 1811 (default (get-custom-frame-properties)) | |
| 1812 (frames (frame-list)) | |
| 1813 frame) | |
| 1814 (while frames | |
| 1815 (setq frame (car frames) | |
| 1816 frames (cdr frames)) | |
| 1817 (unless (equal default (get-custom-frame-properties frame)) | |
| 1818 (push frame relevant))) | |
| 1819 relevant)) | |
| 1820 | |
| 1821 (defun initialize-custom-faces (&optional frame) | |
| 1822 "Initialize all custom faces for FRAME. | |
| 1823 If FRAME is nil or omitted, initialize them for all frames." | |
| 1824 (mapc (lambda (symbol) | |
| 1825 (let ((spec (or (get symbol 'saved-face) | |
| 1826 (get symbol 'face-defface-spec)))) | |
| 1827 (when spec | |
| 1828 ;; No need to init-face-from-resources -- code in | |
| 1829 ;; `init-frame-faces' does it already. | |
| 1830 (face-display-set symbol spec frame)))) | |
| 1831 (face-list))) | |
| 1832 | |
| 1833 (defun custom-initialize-frame (frame) | |
| 1834 "Initialize frame-local custom faces for FRAME if necessary." | |
| 1835 (unless (equal (get-custom-frame-properties) | |
| 1836 (get-custom-frame-properties frame)) | |
| 1837 (initialize-custom-faces frame))) | |
| 1838 | |
| 440 | 1839 (defun startup-initialize-custom-faces () |
| 1840 "Reset faces created by defface. Only called at startup. | |
| 1841 Don't use this function in your program." | |
| 1842 (when default-custom-frame-properties | |
| 1843 ;; Reset default value to the actual frame, not stream. | |
| 1844 (setq default-custom-frame-properties | |
| 1845 (extract-custom-frame-properties (selected-frame))) | |
| 1846 ;; like initialize-custom-faces but removes property first. | |
| 1847 (mapc (lambda (symbol) | |
| 1848 (let ((spec (or (get symbol 'saved-face) | |
| 1849 (get symbol 'face-defface-spec)))) | |
| 1850 (when spec | |
| 1851 ;; Reset faces created during auto-autoloads loading. | |
| 1852 (reset-face symbol) | |
| 1853 ;; And set it according to the spec. | |
| 1854 (face-display-set symbol spec nil)))) | |
| 1855 (face-list)))) | |
| 1856 | |
| 428 | 1857 |
| 1858 (defun make-empty-face (name &optional doc-string temporary) | |
| 1859 "Like `make-face', but doesn't query the resource database." | |
| 1860 (let ((init-face-from-resources nil)) | |
| 1861 (make-face name doc-string temporary))) | |
| 1862 | |
| 1863 (defun init-face-from-resources (face &optional locale) | |
| 1864 "Initialize FACE from the resource database. | |
| 3027 | 1865 If LOCALE is specified, it should be a frame, device, or `global', and |
| 428 | 1866 the face will be resourced over that locale. Otherwise, the face will |
| 1867 be resourced over all possible locales (i.e. all frames, all devices, | |
| 3027 | 1868 and `global')." |
| 428 | 1869 (cond ((null init-face-from-resources) |
| 1870 ;; Do nothing. | |
| 1871 ) | |
| 1872 ((not locale) | |
| 1873 ;; Global, set for all frames. | |
| 1874 (progn | |
| 1875 (init-face-from-resources face 'global) | |
| 1876 (let ((devices (device-list))) | |
| 1877 (while devices | |
| 1878 (init-face-from-resources face (car devices)) | |
| 1879 (setq devices (cdr devices)))) | |
| 1880 (let ((frames (frame-list))) | |
| 1881 (while frames | |
| 1882 (init-face-from-resources face (car frames)) | |
| 1883 (setq frames (cdr frames)))))) | |
| 1884 (t | |
| 1885 ;; Specific. | |
| 1886 (let ((devtype (cond ((devicep locale) (device-type locale)) | |
| 1887 ((framep locale) (frame-type locale)) | |
| 1888 (t nil)))) | |
| 1889 (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype)) | |
| 502 | 1890 (declare-fboundp (x-init-face-from-resources face locale))) |
| 428 | 1891 ((or (not devtype) (eq 'tty devtype)) |
| 1892 ;; Nothing to do for TTYs? | |
| 1893 )))))) | |
| 1894 | |
| 1895 (defun init-device-faces (device) | |
| 1896 ;; First, add any device-local face resources. | |
| 1897 (when init-face-from-resources | |
| 1898 (loop for face in (face-list) do | |
| 1899 (init-face-from-resources face device)) | |
| 1900 ;; Then do any device-specific initialization. | |
| 1901 (cond ((eq 'x (device-type device)) | |
| 502 | 1902 (declare-fboundp (x-init-device-faces device))) |
| 462 | 1903 ((eq 'gtk (device-type device)) |
| 502 | 1904 (declare-fboundp (gtk-init-device-faces device))) |
| 428 | 1905 ((eq 'mswindows (device-type device)) |
| 502 | 1906 (declare-fboundp (mswindows-init-device-faces device))) |
| 428 | 1907 ;; Nothing to do for TTYs? |
| 1908 ) | |
| 1909 (or (eq 'stream (device-type device)) | |
| 1910 (init-other-random-faces device)))) | |
| 1911 | |
| 1912 (defun init-frame-faces (frame) | |
| 1913 (when init-face-from-resources | |
| 1914 ;; First, add any frame-local face resources. | |
| 1915 (loop for face in (face-list) do | |
| 1916 (init-face-from-resources face frame)) | |
| 1917 ;; Then do any frame-specific initialization. | |
| 1918 (cond ((eq 'x (frame-type frame)) | |
| 502 | 1919 (declare-fboundp (x-init-frame-faces frame))) |
| 462 | 1920 ((eq 'gtk (frame-type frame)) |
| 502 | 1921 (declare-fboundp (gtk-init-frame-faces frame))) |
| 428 | 1922 ((eq 'mswindows (frame-type frame)) |
| 502 | 1923 (declare-fboundp (mswindows-init-frame-faces frame))) |
| 428 | 1924 ;; Is there anything which should be done for TTY's? |
| 1925 ))) | |
| 1926 | |
| 872 | 1927 ;; Called when the first device created. |
| 428 | 1928 |
| 872 | 1929 (defun init-global-faces (device) |
| 1930 (let ((Face-frob-property-device-considered-current device)) | |
| 1931 ;; Look for global face resources. | |
| 1932 (loop for face in (face-list) do | |
| 1933 (init-face-from-resources face 'global)) | |
| 1934 ;; Further frobbing. | |
| 1935 (and (featurep 'x) (declare-fboundp (x-init-global-faces))) | |
| 1936 (and (featurep 'gtk) (declare-fboundp (gtk-init-global-faces))) | |
| 1937 (and (featurep 'mswindows) (declare-fboundp (mswindows-init-global-faces))) | |
| 462 | 1938 |
| 872 | 1939 ;; for bold and the like, make the global specification be bold etc. |
| 1940 ;; if the user didn't already specify a value. These will also be | |
| 1941 ;; frobbed further in init-other-random-faces. | |
| 1942 (unless (face-font 'bold 'global) | |
| 1943 (make-face-bold 'bold 'global)) | |
| 1944 ;; | |
| 1945 (unless (face-font 'italic 'global) | |
| 1946 (make-face-italic 'italic 'global)) | |
| 1947 ;; | |
| 428 | 1948 (unless (face-font 'bold-italic 'global) |
| 872 | 1949 (make-face-bold-italic 'bold-italic 'global) |
| 1950 (unless (face-font 'bold-italic 'global) | |
| 1951 (copy-face 'bold 'bold-italic) | |
| 1952 (make-face-italic 'bold-italic))) | |
| 428 | 1953 |
| 872 | 1954 (when (face-equal 'bold 'bold-italic device) |
| 1955 (copy-face 'italic 'bold-italic) | |
| 1956 (make-face-bold 'bold-italic)))) | |
| 428 | 1957 |
| 1958 | |
| 1959 ;; These warnings are there for a reason. Just specify your fonts | |
| 1960 ;; correctly. Deal with it. Additionally, one can use | |
| 1961 ;; `log-warning-minimum-level' instead of this. | |
| 1962 ;(defvar inhibit-font-complaints nil | |
| 1963 ; "Whether to suppress complaints about incomplete sets of fonts.") | |
| 1964 | |
| 1965 (defun face-complain-about-font (face device) | |
| 1966 (if (symbolp face) (setq face (symbol-name face))) | |
| 1967 ;; (if (not inhibit-font-complaints) | |
| 707 | 1968 ;; complaining for printers is generally annoying. |
| 1969 (unless (device-printer-p device) | |
| 1970 (display-warning | |
| 1971 'font | |
| 1972 (let ((default-name (face-font-name 'default device))) | |
| 1973 (format "%s: couldn't deduce %s %s version of the font | |
| 428 | 1974 %S. |
| 1975 | |
| 1976 Please specify X resources to make the %s face | |
| 1977 visually distinguishable from the default face. | |
| 1978 For example, you could add one of the following to $HOME/Emacs: | |
| 1979 | |
| 2703 | 1980 XEmacs.%s.attributeFont: -dt-*-medium-i-* |
| 428 | 1981 or |
| 2703 | 1982 XEmacs.%s.attributeForeground: hotpink\n" |
| 707 | 1983 invocation-name |
| 1984 (if (string-match "\\`[aeiouAEIOU]" face) "an" "a") | |
| 1985 face | |
| 1986 default-name | |
| 1987 face | |
| 1988 face | |
| 1989 face | |
| 1990 ))))) | |
| 428 | 1991 |
| 1992 | |
| 1993 ;; #### This is quite a mess. We should use the custom mechanism for | |
| 1994 ;; most of this stuff. Currently we don't do it, because Custom | |
| 1995 ;; doesn't use specifiers (yet.) FSF does it the Right Way. | |
| 1996 | |
| 1997 ;; For instance, the definition of `bold' should be something like | |
| 1998 ;; (defface bold ((t (:bold t))) "Bold text.") -- and `:bold t' should | |
| 1999 ;; make sure that everything works properly. | |
| 2000 | |
| 2001 (defun init-other-random-faces (device) | |
| 2002 "Initialize the colors and fonts of the bold, italic, bold-italic, | |
| 2003 zmacs-region, list-mode-item-selected, highlight, primary-selection, | |
| 2004 secondary-selection, and isearch faces when each device is created. If | |
| 2005 you want to add code to do stuff like this, use the create-device-hook." | |
| 2006 | |
| 2007 ;; try to make 'bold look different from the default on this device. | |
| 2008 ;; If that doesn't work at all, then issue a warning. | |
| 2009 (unless (face-differs-from-default-p 'bold device) | |
| 2010 (make-face-bold 'bold device) | |
| 2011 (unless (face-differs-from-default-p 'bold device) | |
| 2012 (make-face-unbold 'bold device) | |
| 2013 (unless (face-differs-from-default-p 'bold device) | |
| 2014 ;; the luser specified one of the bogus font names | |
| 2015 (face-complain-about-font 'bold device)))) | |
| 2016 | |
| 2017 ;; Similar for italic. | |
| 2018 ;; It's unreasonable to expect to be able to make a font italic all | |
| 2019 ;; the time. For many languages, italic is an alien concept. | |
| 2020 ;; Basically, because italic is not a globally meaningful concept, | |
| 440 | 2021 ;; the use of the italic face should really be obsoleted. |
| 428 | 2022 |
| 2023 ;; I disagree with above. In many languages, the concept of capital | |
| 2024 ;; letters is just as alien, and yet we use them. Italic is here to | |
| 2025 ;; stay. -hniksic | |
| 2026 | |
| 2027 ;; In a Solaris Japanese environment, there just aren't any italic | |
| 2028 ;; fonts - period. CDE recognizes this reality, and fonts | |
| 2029 ;; -dt-interface user-medium-r-normal-*-*-*-*-*-*-*-*-* don't come | |
| 2030 ;; in italic versions. So we first try to make the font bold before | |
| 2031 ;; complaining. | |
| 2032 (unless (face-differs-from-default-p 'italic device) | |
| 2033 (make-face-italic 'italic device) | |
| 2034 (unless (face-differs-from-default-p 'italic device) | |
| 2035 (make-face-bold 'italic device) | |
| 2036 (unless (face-differs-from-default-p 'italic device) | |
| 2037 (face-complain-about-font 'italic device)))) | |
| 2038 | |
| 2039 ;; similar for bold-italic. | |
| 2040 (unless (face-differs-from-default-p 'bold-italic device) | |
| 2041 (make-face-bold-italic 'bold-italic device) | |
| 2042 ;; if we couldn't get a bold-italic version, try just bold. | |
| 2043 (unless (face-differs-from-default-p 'bold-italic device) | |
| 2044 (make-face-bold 'bold-italic device) | |
| 2045 ;; if we couldn't get bold or bold-italic, then that's probably because | |
| 2046 ;; the default font is bold, so make the `bold-italic' face be unbold. | |
| 2047 (unless (face-differs-from-default-p 'bold-italic device) | |
| 2048 (make-face-unbold 'bold-italic device) | |
| 2049 (make-face-italic 'bold-italic device) | |
| 2050 (unless (face-differs-from-default-p 'bold-italic device) | |
| 2051 ;; if that didn't work, try plain italic | |
| 2052 ;; (can this ever happen? what the hell.) | |
| 2053 (make-face-italic 'bold-italic device) | |
| 2054 (unless (face-differs-from-default-p 'bold-italic device) | |
| 2055 ;; then bitch and moan. | |
| 2056 (face-complain-about-font 'bold-italic device)))))) | |
| 2057 | |
| 2058 ;; Set the text-cursor colors unless already specified. | |
| 2059 (when (and (not (eq 'tty (device-type device))) | |
| 2060 (not (face-background 'text-cursor 'global)) | |
| 2061 (face-property-equal 'text-cursor 'default 'background device)) | |
| 2062 (set-face-background 'text-cursor [default foreground] 'global | |
| 2063 nil 'append)) | |
| 2064 (when (and (not (eq 'tty (device-type device))) | |
| 2065 (not (face-foreground 'text-cursor 'global)) | |
| 2066 (face-property-equal 'text-cursor 'default 'foreground device)) | |
| 2067 (set-face-foreground 'text-cursor [default background] 'global | |
| 2068 nil 'append)) | |
|
4741
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2069 |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2070 ;; The faces buffers-tab, modeline-mousable and modeline-buffer-id all |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2071 ;; inherit directly from modeline; they require that modeline's details be |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2072 ;; specified, that it not use fallbacks, otherwise *they* use the general |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2073 ;; fallback of the default face instead, which clashes with the gui |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2074 ;; element faces. So take the modeline face information from its |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2075 ;; fallbacks, themselves ultimately set up in faces.c: |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2076 (loop |
|
5624
c39052c921b5
New "foreback" face property.
Didier Verna <didier@xemacs.org>
parents:
5622
diff
changeset
|
2077 for face-property in '(foreground foreback background |
|
5080
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
4783
diff
changeset
|
2078 background-pixmap background-placement) |
|
4741
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2079 do (when (and (setq face-property (face-property 'modeline face-property)) |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2080 (null (specifier-instance face-property device nil t)) |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2081 (specifier-instance face-property device)) |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2082 (set-specifier face-property |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2083 (or (specifier-specs (specifier-fallback |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2084 face-property)) |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2085 ;; This will error at startup if the |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2086 ;; corresponding C fallback doesn't exist, |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2087 ;; which is well and good. |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2088 (specifier-fallback (specifier-fallback |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2089 face-property)))))) |
|
e14f9fdd5096
Fix modeline-mousable, other faces that inherit from modeline, on startup.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4676
diff
changeset
|
2090 nil) |
| 428 | 2091 |
| 442 | 2092 ;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle |
| 2093 ;; Jones and Hrvoje Niksic. | |
| 428 | 2094 (defun set-face-stipple (face pixmap &optional frame) |
| 2095 "Change the stipple pixmap of FACE to PIXMAP. | |
| 2096 This is an Emacs compatibility function; consider using | |
| 2097 set-face-background-pixmap instead. | |
| 2098 | |
| 2099 PIXMAP should be a string, the name of a file of pixmap data. | |
| 442 | 2100 The directories listed in the variables `x-bitmap-file-path' and |
| 2101 `mswindows-bitmap-file-path' under X and MS Windows respectively | |
| 2102 are searched. | |
| 428 | 2103 |
| 2104 Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT | |
| 2105 DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is | |
| 2106 a string, containing the raw bits of the bitmap. XBM data is | |
| 2107 expected in this case, other types of image data will not work. | |
| 2108 | |
| 2109 If the optional FRAME argument is provided, change only | |
| 2110 in that frame; otherwise change each frame." | |
| 2111 (while (not (find-face face)) | |
| 446 | 2112 (setq face (wrong-type-argument 'facep face))) |
| 502 | 2113 (let ((bitmap-path |
| 2114 (ecase (console-type) | |
| 2115 (x (declare-boundp x-bitmap-file-path)) | |
| 2116 (mswindows (declare-boundp mswindows-bitmap-file-path)))) | |
| 442 | 2117 instantiator) |
| 2118 (while | |
| 2119 (null | |
| 2120 (setq instantiator | |
| 2121 (cond ((stringp pixmap) | |
| 2122 (let ((file (if (file-name-absolute-p pixmap) | |
| 2123 pixmap | |
| 2124 (locate-file pixmap bitmap-path | |
| 2125 '(".xbm" ""))))) | |
| 2126 (and file | |
| 2127 `[xbm :file ,file]))) | |
|
5366
f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
Aidan Kehoe <kehoea@parhasard.net>
parents:
5344
diff
changeset
|
2128 ((and (listp pixmap) (eql (length pixmap) 3)) |
| 442 | 2129 `[xbm :data ,pixmap]) |
| 2130 (t nil)))) | |
| 2131 ;; We're signaling a continuable error; let's make sure the | |
| 2132 ;; function `stipple-pixmap-p' at least exists. | |
|
5567
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5484
diff
changeset
|
2133 (labels ((stipple-pixmap-p (pixmap) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5484
diff
changeset
|
2134 (or (stringp pixmap) |
|
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5484
diff
changeset
|
2135 (and (listp pixmap) (eql (length pixmap) 3))))) |
| 442 | 2136 (setq pixmap (signal 'wrong-type-argument |
|
5567
3bc58dc9d688
Replace #'flet by #'labels where appropriate, core code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5484
diff
changeset
|
2137 (list #'stipple-pixmap-p pixmap))))) |
| 446 | 2138 (check-type frame (or null frame)) |
| 442 | 2139 (set-face-background-pixmap face instantiator frame))) |
| 428 | 2140 |
| 2141 | |
| 2142 ;; Create the remaining standard faces now. This way, packages that we dump | |
| 2143 ;; can reference these faces as parents. | |
| 2144 ;; | |
| 2145 ;; The default, modeline, left-margin, right-margin, text-cursor, | |
| 2146 ;; and pointer faces are created in C. | |
| 2147 | |
| 2148 (make-face 'bold "Bold text.") | |
| 2149 (make-face 'italic "Italic text.") | |
| 2150 (make-face 'bold-italic "Bold-italic text.") | |
| 2151 (make-face 'underline "Underlined text.") | |
| 2152 (or (face-differs-from-default-p 'underline) | |
| 2153 (set-face-underline-p 'underline t 'global '(default))) | |
| 735 | 2154 (make-face 'zmacs-region "Used on highlighted region between point and mark.") |
| 428 | 2155 (make-face 'isearch "Used on region matched by isearch.") |
| 2156 (make-face 'isearch-secondary "Face to use for highlighting all matches.") | |
| 2157 (make-face 'list-mode-item-selected | |
| 2158 "Face for the selected list item in list-mode.") | |
| 2159 (make-face 'highlight "Highlight face.") | |
| 2160 (make-face 'primary-selection "Primary selection face.") | |
| 2161 (make-face 'secondary-selection "Secondary selection face.") | |
| 2162 | |
| 2163 ;; Several useful color faces. | |
| 2164 (dolist (color '(red green blue yellow)) | |
| 2165 (make-face color (concat (symbol-name color) " text.")) | |
| 2166 (set-face-foreground color (symbol-name color) nil 'color)) | |
| 2167 | |
| 2168 ;; Make some useful faces. This happens very early, before creating | |
| 2169 ;; the first non-stream device. | |
| 2170 | |
| 2171 (set-face-background 'text-cursor | |
| 711 | 2172 '(((win default) . "Red3")) |
| 428 | 2173 'global) |
| 2174 | |
| 2175 ;; some older X servers don't recognize "darkseagreen2" | |
| 2176 (set-face-background 'highlight | |
| 711 | 2177 '(((win default color) . "darkseagreen2") |
| 2178 ((win default color) . "green") | |
| 2179 ((win default grayscale) . "gray53")) | |
| 428 | 2180 'global) |
| 2181 (set-face-background-pixmap 'highlight | |
| 711 | 2182 '(((win default mono) . "gray1")) |
| 428 | 2183 'global) |
| 2184 | |
|
5621
8265913e617b
Explicitely set zmacs-region to not shrink.
Didier Verna <didier@xemacs.org>
parents:
5619
diff
changeset
|
2185 ;; We need to set this face to not shrink *explicitely* in order to force |
|
8265913e617b
Explicitely set zmacs-region to not shrink.
Didier Verna <didier@xemacs.org>
parents:
5619
diff
changeset
|
2186 ;; covering a shrinked selection. -- dvl |
|
8265913e617b
Explicitely set zmacs-region to not shrink.
Didier Verna <didier@xemacs.org>
parents:
5619
diff
changeset
|
2187 (set-face-shrink-p 'zmacs-region nil) |
| 428 | 2188 (set-face-background 'zmacs-region |
| 711 | 2189 '(((win default color) . "gray65") |
| 2190 ((win default grayscale) . "gray65")) | |
| 428 | 2191 'global) |
| 2192 (set-face-background-pixmap 'zmacs-region | |
| 711 | 2193 '(((win default mono) . "gray3")) |
| 428 | 2194 'global) |
| 2195 | |
| 2196 (set-face-background 'list-mode-item-selected | |
| 711 | 2197 '(((win default color) . "gray68") |
| 2198 ((win default grayscale) . "gray68") | |
| 2199 ((win default mono) . [default foreground])) | |
| 428 | 2200 'global) |
| 2201 (set-face-foreground 'list-mode-item-selected | |
| 711 | 2202 '(((win default mono) . [default background])) |
| 428 | 2203 'global) |
| 2204 | |
| 2205 (set-face-background 'primary-selection | |
| 711 | 2206 '(((win default color) . "gray65") |
| 2207 ((win default grayscale) . "gray65")) | |
| 428 | 2208 'global) |
| 2209 (set-face-background-pixmap 'primary-selection | |
| 711 | 2210 '(((win default mono) . "gray3")) |
| 428 | 2211 'global) |
| 2212 | |
| 2213 (set-face-background 'secondary-selection | |
| 711 | 2214 '(((win default color) . "paleturquoise") |
| 2215 ((win default color) . "green") | |
| 2216 ((win default grayscale) . "gray53")) | |
| 428 | 2217 'global) |
| 2218 (set-face-background-pixmap 'secondary-selection | |
| 711 | 2219 '(((win default mono) . "gray1")) |
| 428 | 2220 'global) |
| 2221 | |
| 2222 (set-face-background 'isearch | |
| 711 | 2223 '(((win default color) . "paleturquoise") |
| 2224 ((win default color) . "green")) | |
| 428 | 2225 'global) |
| 2226 | |
| 2227 ;; #### This should really, I mean *really*, be converted to some form | |
| 2228 ;; of `defface' one day. | |
| 2229 (set-face-foreground 'isearch-secondary | |
| 711 | 2230 '(((win default color) . "red3")) |
| 428 | 2231 'global) |
| 2232 | |
| 2233 ;; Define some logical color names to be used when reading the pixmap files. | |
| 4222 | 2234 (and-boundp |
| 2235 'xpm-color-symbols | |
| 2236 (featurep 'xpm) | |
| 2237 (setq xpm-color-symbols | |
| 2238 (list | |
| 2239 '("foreground" (face-foreground 'default)) | |
| 2240 '("background" (face-background 'default)) | |
|
4676
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2241 `("backgroundToolBarColor" |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2242 ,(if (featurep 'x) |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2243 '(or (x-get-resource "backgroundToolBarColor" |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2244 "BackgroundToolBarColor" 'string |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2245 nil nil 'warn) |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2246 (face-background 'toolbar)) |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2247 '(face-background 'toolbar))) |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2248 `("foregroundToolBarColor" |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2249 ,(if (featurep 'x) |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2250 '(or (x-get-resource "foregroundToolBarColor" |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2251 "ForegroundToolBarColor" 'string |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2252 nil nil 'warn) |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2253 (face-foreground 'toolbar)) |
|
e3feb329bda9
Make the initialisation of xpm-color-symbols a bit more reasonable.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4670
diff
changeset
|
2254 '(face-foreground 'toolbar)))))) |
| 428 | 2255 |
| 2256 (when (featurep 'tty) | |
| 2257 (set-face-highlight-p 'bold t 'global '(default tty)) | |
| 2258 (set-face-underline-p 'italic t 'global '(default tty)) | |
| 2259 (set-face-highlight-p 'bold-italic t 'global '(default tty)) | |
| 2260 (set-face-underline-p 'bold-italic t 'global '(default tty)) | |
| 2261 (set-face-highlight-p 'highlight t 'global '(default tty)) | |
| 2262 (set-face-reverse-p 'text-cursor t 'global '(default tty)) | |
| 2263 (set-face-reverse-p 'modeline t 'global '(default tty)) | |
| 2264 (set-face-reverse-p 'zmacs-region t 'global '(default tty)) | |
| 2265 (set-face-reverse-p 'primary-selection t 'global '(default tty)) | |
| 2266 (set-face-underline-p 'secondary-selection t 'global '(default tty)) | |
| 2267 (set-face-reverse-p 'list-mode-item-selected t 'global '(default tty)) | |
| 2268 (set-face-reverse-p 'isearch t 'global '(default tty)) | |
| 2269 ) | |
| 2270 | |
| 2271 ;;; faces.el ends here |