Mercurial > hg > xemacs-beta
annotate lisp/faces.el @ 5934:e2fae7783046 cygwin
lots of use of EMACS_INT, a few others, to eliminate all pointer truncation warnings
| author | Henry Thompson <ht@markup.co.uk> |
|---|---|
| date | Sat, 12 Dec 2015 19:08:46 +0000 |
| 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 |