git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/faces.el

   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
   5 ;; Copyright (C) 1995, 1996 Ben Wing
   6
   7 ;; Author: Ben Wing <ben@xemacs.org>
   8 ;; Keywords: faces, internal, dumped
   9
  10 ;; This file is part of XEmacs.
  11
  12 ;; XEmacs is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XEmacs is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Synched up with: Not synched with FSF.  Almost completely divergent.
  28
  29 ;;; Commentary:
  30
  31 ;; This file is dumped with XEmacs.
  32
  33 ;; face implementation #1 (used Lisp vectors and parallel C vectors;
  34 ;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@netscape.com>
  35 ;; pre Lucid-Emacs 19.0.
  36
  37 ;; face implementation #2 (used one face object per frame per face)
  38 ;; authored by Jamie Zawinski for 19.9.
  39
  40 ;; face implementation #3 (use one face object per face) originally
  41 ;; authored for 19.12 by Chuck Thompson <cthomp@cs.uiuc.edu>,
  42 ;; rewritten by Ben Wing with the advent of specifiers.
  43
  44
  45 ;;; Some stuff in FSF's faces.el is in our x-faces.el.
  46
  47 ;;; Code:
  48
  49 (defgroup faces nil
  50   "Support for multiple text attributes (fonts, colors, ...)
  51 Such a collection of attributes is called a \"face\"."
  52   :group 'emacs)
  53
  54
  55 (defun read-face-name (prompt)
  56   (let (face)
  57     (while (= (length face) 0) ; nil or ""
  58       (setq face (completing-read prompt
  59                                   (mapcar (lambda (x) (list (symbol-name x)))
  60                                           (face-list))
  61                                   nil t)))
  62     (intern face)))
  63
  64 (defun face-interactive (what &optional bool)
  65   (let* ((fn (intern (concat "face-" what "-instance")))
  66          (face (read-face-name (format "Set %s of face: " what)))
  67          (default (if (fboundp fn)
  68                       ;; #### we should distinguish here between
  69                       ;; explicitly setting the value to be the
  70                       ;; same as the default face's value, and
  71                       ;; not setting a value at all.
  72                       (funcall fn face)))
  73          (value (if bool
  74                     (y-or-n-p (format "Should face %s be %s? "
  75                                       (symbol-name face) bool))
  76                   (read-string (format "Set %s of face %s to: "
  77                                        what (symbol-name face))
  78                    (cond ((font-instance-p default)
  79                           (font-instance-name default))
  80                          ((color-instance-p default)
  81                           (color-instance-name default))
  82                          ((image-instance-p default)
  83                           (image-instance-file-name default))
  84                          (t default))))))
  85     (list face (if (equal value "") nil value))))
  86
  87 (defconst built-in-face-specifiers
  88   (built-in-face-specifiers)
  89   "A list of the built-in face properties that are specifiers.")
  90
  91 (defun face-property (face property &optional locale tag-set exact-p)
  92   "Return FACE's value of the given PROPERTY.
  93
  94 If LOCALE is omitted, the FACE's actual value for PROPERTY will be
  95   returned.  For built-in properties, this will be a specifier object
  96   of a type appropriate to the property (e.g. a font or color
  97   specifier).  For other properties, this could be anything.
  98
  99 If LOCALE is supplied, then instead of returning the actual value,
 100   the specification(s) for the given locale or locale type will
 101   be returned.  This will only work if the actual value of
 102   PROPERTY is a specifier (this will always be the case for built-in
 103   properties, but not or not may apply to user-defined properties).
 104   If the actual value of PROPERTY is not a specifier, this value
 105   will simply be returned regardless of LOCALE.
 106
 107 The return value will be a list of instantiators (e.g. strings
 108   specifying a font or color name), or a list of specifications, each
 109   of which is a cons of a locale and a list of instantiators.
 110   Specifically, if LOCALE is a particular locale (a buffer, window,
 111   frame, device, or 'global), a list of instantiators for that locale
 112   will be returned.  Otherwise, if LOCALE is a locale type (one of
 113   the symbols 'buffer, 'window, 'frame, or 'device), the specifications
 114   for all locales of that type will be returned.  Finally, if LOCALE is
 115   'all, the specifications for all locales of all types will be returned.
 116
 117 The specifications in a specifier determine what the value of
 118   PROPERTY will be in a particular \"domain\" or set of circumstances,
 119   which is typically a particular Emacs window along with the buffer
 120   it contains and the frame and device it lies within.  The value
 121   is derived from the instantiator associated with the most specific
 122   locale (in the order buffer, window, frame, device, and 'global)
 123   that matches the domain in question.  In other words, given a domain
 124   (i.e. an Emacs window, usually), the specifier for PROPERTY will first
 125   be searched for a specification whose locale is the buffer contained
 126   within that window; then for a specification whose locale is the window
 127   itself; then for a specification whose locale is the frame that the
 128   window is contained within; etc.  The first instantiator that is
 129   valid for the domain (usually this means that the instantiator is
 130   recognized by the device [i.e. the X server or TTY device] that the
 131   domain is on.  The function `face-property-instance' actually does
 132   all this, and is used to determine how to display the face.
 133
 134 See `set-face-property' for the built-in property-names."
 135
 136   (setq face (get-face face))
 137   (let ((value (get face property)))
 138     (if (and locale
 139              (or (memq property built-in-face-specifiers)
 140                  (specifierp value)))
 141         (setq value (specifier-specs value locale tag-set exact-p)))
 142     value))
 143
 144 (defun convert-face-property-into-specifier (face property)
 145   "Convert PROPERTY on FACE into a specifier, if it's not already."
 146   (setq face (get-face face))
 147   (let ((specifier (get face property)))
 148     ;; if a user-property does not have a specifier but a
 149     ;; locale was specified, put a specifier there.
 150     ;; If there was already a value there, convert it to a
 151     ;; specifier with the value as its 'global instantiator.
 152     (unless (specifierp specifier)
 153       (let ((new-specifier (make-specifier 'generic)))
 154         (if (or (not (null specifier))
 155                 ;; make sure the nil returned from `get' wasn't
 156                 ;; actually the value of the property
 157                 (null (get face property t)))
 158             (add-spec-to-specifier new-specifier specifier))
 159         (setq specifier new-specifier)
 160         (put face property specifier)))))
 161
 162 (defun face-property-instance (face property
 163                                     &optional domain default no-fallback)
 164   "Return the instance of FACE's PROPERTY in the specified DOMAIN.
 165
 166 Under most circumstances, DOMAIN will be a particular window,
 167   and the returned instance describes how the specified property
 168   actually is displayed for that window and the particular buffer
 169   in it.  Note that this may not be the same as how the property
 170   appears when the buffer is displayed in a different window or
 171   frame, or how the property appears in the same window if you
 172   switch to another buffer in that window; and in those cases,
 173   the returned instance would be different.
 174
 175 The returned instance will typically be a color-instance,
 176   font-instance, or pixmap-instance object, and you can query
 177   it using the appropriate object-specific functions.  For example,
 178   you could use `color-instance-rgb-components' to find out the
 179   RGB (red, green, and blue) components of how the 'background
 180   property of the 'highlight face is displayed in a particular
 181   window.  The results might be different from the results
 182   you would get for another window (perhaps the user
 183   specified a different color for the frame that window is on;
 184   or perhaps the same color was specified but the window is
 185   on a different X server, and that X server has different RGB
 186   values for the color from this one).
 187
 188 DOMAIN defaults to the selected window if omitted.
 189
 190 DOMAIN can be a frame or device, instead of a window.  The value
 191   returned for a such a domain is used in special circumstances
 192   when a more specific domain does not apply; for example, a frame
 193   value might be used for coloring a toolbar, which is conceptually
 194   attached to a frame rather than a particular window.  The value
 195   is also useful in determining what the value would be for a
 196   particular window within the frame or device, if it is not
 197   overridden by a more specific specification.
 198
 199 If PROPERTY does not name a built-in property, its value will
 200   simply be returned unless it is a specifier object, in which case
 201   it will be instanced using `specifier-instance'.
 202
 203 Optional arguments DEFAULT and NO-FALLBACK are the same as in
 204   `specifier-instance'."
 205
 206   (setq face (get-face face))
 207   (let ((value (get face property)))
 208     (if (specifierp value)
 209         (setq value (specifier-instance value domain default no-fallback)))
 210     value))
 211
 212 (defun face-property-matching-instance (face property matchspec
 213                                              &optional domain default
 214                                              no-fallback)
 215   "Return the instance of FACE's PROPERTY matching MATCHSPEC in DOMAIN.
 216 Currently the only useful value for MATCHSPEC is a charset, when used
 217 in conjunction with the face's font; this allows you to retrieve a
 218 font that can be used to display a particular charset, rather than just
 219 any font.
 220
 221 Other than MATCHSPEC, this function is identical to `face-property-instance'.
 222 See also `specifier-matching-instance' for a fuller description of the
 223 matching process."
 224
 225   (setq face (get-face face))
 226   (let ((value (get face property)))
 227     (if (specifierp value)
 228         (setq value (specifier-matching-instance value matchspec domain
 229                                                  default no-fallback)))
 230     value))
 231
 232 (defun set-face-property (face property value &optional locale tag-set
 233                                how-to-add)
 234   "Change a property of FACE.
 235
 236 NOTE: If you want to remove a property from a face, use `remove-face-property'
 237   rather than attempting to set a value of nil for the property.
 238
 239 For built-in properties, the actual value of the property is a
 240   specifier and you cannot change this; but you can change the
 241   specifications within the specifier, and that is what this function
 242   will do.  For user-defined properties, you can use this function
 243   to either change the actual value of the property or, if this value
 244   is a specifier, change the specifications within it.
 245
 246 If PROPERTY is a built-in property, the specifications to be added to
 247   this property can be supplied in many different ways:
 248
 249   -- If VALUE is a simple instantiator (e.g. a string naming a font or
 250      color) or a list of instantiators, then the instantiator(s) will
 251      be added as a specification of the property for the given LOCALE
 252      (which defaults to 'global if omitted).
 253   -- If VALUE is a list of specifications (each of which is a cons of
 254      a locale and a list of instantiators), then LOCALE must be nil
 255      (it does not make sense to explicitly specify a locale in this
 256      case), and specifications will be added as given.
 257   -- If VALUE is a specifier (as would be returned by `face-property'
 258      if no LOCALE argument is given), then some or all of the
 259      specifications in the specifier will be added to the property.
 260      In this case, the function is really equivalent to
 261      `copy-specifier' and LOCALE has the same semantics (if it is
 262      a particular locale, the specification for the locale will be
 263      copied; if a locale type, specifications for all locales of
 264      that type will be copied; if nil or 'all, then all
 265      specifications will be copied).
 266
 267 HOW-TO-ADD should be either nil or one of the symbols 'prepend,
 268   'append, 'remove-tag-set-prepend, 'remove-tag-set-append, 'remove-locale,
 269   'remove-locale-type, or 'remove-all.  See `copy-specifier' and
 270   `add-spec-to-specifier' for a description of what each of
 271   these means.  Most of the time, you do not need to worry about
 272   this argument; the default behavior usually is fine.
 273
 274 In general, it is OK to pass an instance object (e.g. as returned
 275   by `face-property-instance') as an instantiator in place of
 276   an actual instantiator.  In such a case, the instantiator used
 277   to create that instance object will be used (for example, if
 278   you set a font-instance object as the value of the 'font
 279   property, then the font name used to create that object will
 280   be used instead).  If some cases, however, doing this
 281   conversion does not make sense, and this will be noted in
 282   the documentation for particular types of instance objects.
 283
 284 If PROPERTY is not a built-in property, then this function will
 285   simply set its value if LOCALE is nil.  However, if LOCALE is
 286   given, then this function will attempt to add VALUE as the
 287   instantiator for the given LOCALE, using `add-spec-to-specifier'.
 288   If the value of the property is not a specifier, it will
 289   automatically be converted into a 'generic specifier.
 290
 291
 292 The following symbols have predefined meanings:
 293
 294  foreground         The foreground color of the face.
 295                     For valid instantiators, see `color-specifier-p'.
 296
 297  background         The background color of the face.
 298                     For valid instantiators, see `color-specifier-p'.
 299
 300  font               The font used to display text covered by this face.
 301                     For valid instantiators, see `font-specifier-p'.
 302
 303  display-table      The display table of the face.
 304                     This should be a vector of 256 elements.
 305
 306  background-pixmap  The pixmap displayed in the background of the face.
 307                     Only used by faces on X devices.
 308                     For valid instantiators, see `image-specifier-p'.
 309
 310  underline          Underline all text covered by this face.
 311                     For valid instantiators, see `face-boolean-specifier-p'.
 312
 313  strikethru         Draw a line through all text covered by this face.
 314                     For valid instantiators, see `face-boolean-specifier-p'.
 315
 316  highlight          Highlight all text covered by this face.
 317                     Only used by faces on TTY devices.
 318                     For valid instantiators, see `face-boolean-specifier-p'.
 319
 320  dim                Dim all text covered by this face.
 321                     Only used by faces on TTY devices.
 322                     For valid instantiators, see `face-boolean-specifier-p'.
 323
 324  blinking           Blink all text covered by this face.
 325                     Only used by faces on TTY devices.
 326                     For valid instantiators, see `face-boolean-specifier-p'.
 327
 328  reverse            Reverse the foreground and background colors.
 329                     Only used by faces on TTY devices.
 330                     For valid instantiators, see `face-boolean-specifier-p'.
 331
 332  doc-string         Description of what the face's normal use is.
 333                     NOTE: This is not a specifier, unlike all
 334                     the other built-in properties, and cannot
 335                     contain locale-specific values."
 336
 337   (setq face (get-face face))
 338   (if (memq property built-in-face-specifiers)
 339       (set-specifier (get face property) value locale tag-set how-to-add)
 340
 341     ;; This section adds user defined properties.
 342     (if (not locale)
 343         (put face property value)
 344       (convert-face-property-into-specifier face property)
 345       (add-spec-to-specifier (get face property) value locale tag-set
 346                              how-to-add)))
 347   value)
 348
 349 (defun remove-face-property (face property &optional locale tag-set exact-p)
 350   "Remove a property from FACE.
 351 For built-in properties, this is analogous to `remove-specifier'.
 352 See `remove-specifier' for the meaning of the LOCALE, TAG-SET, and EXACT-P
 353 arguments."
 354   (or locale (setq locale 'all))
 355   (if (memq property built-in-face-specifiers)
 356       (remove-specifier (face-property face property) locale tag-set exact-p)
 357     (if (eq locale 'all)
 358         (remprop (get-face face) property)
 359       (convert-face-property-into-specifier face property)
 360       (remove-specifier (face-property face property) locale tag-set
 361                         exact-p))))
 362
 363 (defun reset-face (face &optional locale tag-set exact-p)
 364   "Clear all existing built-in specifications from FACE.
 365 This makes FACE inherit all its display properties from 'default.
 366 WARNING: Be absolutely sure you want to do this!!!  It is a dangerous
 367 operation and is not undoable.
 368
 369 The arguments LOCALE, TAG-SET and EXACT-P are the same as for
 370 `remove-specifier'."
 371   (mapc (lambda (x)
 372           (remove-specifier (face-property face x) locale tag-set exact-p))
 373         built-in-face-specifiers)
 374   nil)
 375
 376 (defun set-face-parent (face parent &optional locale tag-set how-to-add)
 377   "Set the parent of FACE to PARENT, for all properties.
 378 This makes all properties of FACE inherit from PARENT."
 379   (setq parent (get-face parent))
 380   (mapcar (lambda (x)
 381             (set-face-property face x (vector parent) locale tag-set
 382                                how-to-add))
 383           (delq 'display-table
 384                 (delq 'background-pixmap
 385                       (copy-sequence built-in-face-specifiers))))
 386   (set-face-background-pixmap face (vector 'inherit ':face parent)
 387                               locale tag-set how-to-add)
 388   nil)
 389
 390 (defun face-doc-string (face)
 391   "Return the documentation string for FACE."
 392   (face-property face 'doc-string))
 393
 394 (defun set-face-doc-string (face doc-string)
 395   "Change the documentation string of FACE to DOC-STRING."
 396   (interactive (face-interactive "doc-string"))
 397   (set-face-property face 'doc-string doc-string))
 398
 399 (defun face-font-name (face &optional domain charset)
 400   "Return the font name of FACE in DOMAIN, or nil if it is unspecified.
 401 DOMAIN is as in `face-font-instance'."
 402   (let ((f (face-font-instance face domain charset)))
 403     (and f (font-instance-name f))))
 404
 405 (defun face-font (face &optional locale tag-set exact-p)
 406   "Return the font of FACE in LOCALE, or nil if it is unspecified.
 407
 408 FACE may be either a face object or a symbol representing a face.
 409
 410 LOCALE may be a locale (the instantiators for that particular locale
 411   will be returned), a locale type (the specifications for all locales
 412   of that type will be returned), 'all (all specifications will be
 413   returned), or nil (the actual specifier object will be returned).
 414
 415 See `face-property' for more information."
 416   (face-property face 'font locale tag-set exact-p))
 417
 418 (defun face-font-instance (face &optional domain charset)
 419   "Return the instance of FACE's font in DOMAIN.
 420
 421 FACE may be either a face object or a symbol representing a face.
 422
 423 Normally DOMAIN will be a window or nil (meaning the selected window),
 424   and an instance object describing how the font appears in that
 425   particular window and buffer will be returned.
 426
 427 See `face-property-instance' for more information."
 428   (if charset
 429       (face-property-matching-instance face 'font charset domain)
 430     (face-property-instance face 'font domain)))
 431
 432 (defun set-face-font (face font &optional locale tag-set how-to-add)
 433   "Change the font of FACE to FONT in LOCALE.
 434
 435 FACE may be either a face object or a symbol representing a face.
 436
 437 FONT should be an instantiator (see `font-specifier-p'), a list of
 438   instantiators, an alist of specifications (each mapping a
 439   locale to an instantiator list), or a font specifier object.
 440
 441 If FONT is an alist, LOCALE must be omitted.  If FONT is a
 442   specifier object, LOCALE can be a locale, a locale type, 'all,
 443   or nil; see `copy-specifier' for its semantics.  Otherwise LOCALE
 444   specifies the locale under which the specified instantiator(s)
 445   will be added, and defaults to 'global.
 446
 447 See `set-face-property' for more information."
 448   (interactive (face-interactive "font"))
 449   (set-face-property face 'font font locale tag-set how-to-add))
 450
 451 (defun face-foreground (face &optional locale tag-set exact-p)
 452   "Return the foreground of FACE in LOCALE, or nil if it is unspecified.
 453
 454 FACE may be either a face object or a symbol representing a face.
 455
 456 LOCALE may be a locale (the instantiators for that particular locale
 457   will be returned), a locale type (the specifications for all locales
 458   of that type will be returned), 'all (all specifications will be
 459   returned), or nil (the actual specifier object will be returned).
 460
 461 See `face-property' for more information."
 462   (face-property face 'foreground locale tag-set exact-p))
 463
 464 (defun face-foreground-instance (face &optional domain default no-fallback)
 465   "Return the instance of FACE's foreground in DOMAIN.
 466
 467 FACE may be either a face object or a symbol representing a face.
 468
 469 Normally DOMAIN will be a window or nil (meaning the selected window),
 470   and an instance object describing how the foreground appears in that
 471   particular window and buffer will be returned.
 472
 473 See `face-property-instance' for more information."
 474   (face-property-instance face 'foreground domain default no-fallback))
 475
 476 (defun face-foreground-name (face &optional domain default no-fallback)
 477   "Return the name of FACE's foreground color in DOMAIN.
 478
 479 FACE may be either a face object or a symbol representing a face.
 480
 481 Normally DOMAIN will be a window or nil (meaning the selected window),
 482   and an instance object describing how the background appears in that
 483   particular window and buffer will be returned.
 484
 485 See `face-property-instance' for more information."
 486   (color-instance-name (face-foreground-instance
 487                         face domain default no-fallback)))
 488
 489 (defun set-face-foreground (face color &optional locale tag-set how-to-add)
 490   "Change the foreground color of FACE to COLOR in LOCALE.
 491
 492 FACE may be either a face object or a symbol representing a face.
 493
 494 COLOR should be an instantiator (see `color-specifier-p'), a list of
 495   instantiators, an alist of specifications (each mapping a locale to
 496   an instantiator list), or a color specifier object.
 497
 498 If COLOR is an alist, LOCALE must be omitted.  If COLOR is a
 499   specifier object, LOCALE can be a locale, a locale type, 'all,
 500   or nil; see `copy-specifier' for its semantics.  Otherwise LOCALE
 501   specifies the locale under which the specified instantiator(s)
 502   will be added, and defaults to 'global.
 503
 504 See `set-face-property' for more information."
 505   (interactive (face-interactive "foreground"))
 506   (set-face-property face 'foreground color locale tag-set how-to-add))
 507
 508 (defun face-background (face &optional locale tag-set exact-p)
 509   "Return the background color of FACE in LOCALE, or nil if it is unspecified.
 510
 511 FACE may be either a face object or a symbol representing a face.
 512
 513 LOCALE may be a locale (the instantiators for that particular locale
 514   will be returned), a locale type (the specifications for all locales
 515   of that type will be returned), 'all (all specifications will be
 516   returned), or nil (the actual specifier object will be returned).
 517
 518 See `face-property' for more information."
 519   (face-property face 'background locale tag-set exact-p))
 520
 521 (defun face-background-instance (face &optional domain default no-fallback)
 522   "Return the instance of FACE's background in DOMAIN.
 523
 524 FACE may be either a face object or a symbol representing a face.
 525
 526 Normally DOMAIN will be a window or nil (meaning the selected window),
 527   and an instance object describing how the background appears in that
 528   particular window and buffer will be returned.
 529
 530 See `face-property-instance' for more information."
 531   (face-property-instance face 'background domain default no-fallback))
 532
 533 (defun face-background-name (face &optional domain default no-fallback)
 534   "Return the name of FACE's background color in DOMAIN.
 535
 536 FACE may be either a face object or a symbol representing a face.
 537
 538 Normally DOMAIN will be a window or nil (meaning the selected window),
 539   and an instance object describing how the background appears in that
 540   particular window and buffer will be returned.
 541
 542 See `face-property-instance' for more information."
 543   (color-instance-name (face-background-instance
 544                         face domain default no-fallback)))
 545
 546 (defun set-face-background (face color &optional locale tag-set how-to-add)
 547   "Change the background color of FACE to COLOR in LOCALE.
 548
 549 FACE may be either a face object or a symbol representing a face.
 550
 551 COLOR should be an instantiator (see `color-specifier-p'), a list of
 552   instantiators, an alist of specifications (each mapping a locale to
 553   an instantiator list), or a color specifier object.
 554
 555 If COLOR is an alist, LOCALE must be omitted.  If COLOR is a
 556   specifier object, LOCALE can be a locale, a locale type, 'all,
 557   or nil; see `copy-specifier' for its semantics.  Otherwise LOCALE
 558   specifies the locale under which the specified instantiator(s)
 559   will be added, and defaults to 'global.
 560
 561 See `set-face-property' for more information."
 562   (interactive (face-interactive "background"))
 563   (set-face-property face 'background color locale tag-set how-to-add))
 564
 565 (defun face-background-pixmap (face &optional locale tag-set exact-p)
 566   "Return the background pixmap of FACE in LOCALE, or nil if it is unspecified.
 567 This property is only used on window system devices.
 568
 569 FACE may be either a face object or a symbol representing a face.
 570
 571 LOCALE may be a locale (the instantiators for that particular locale
 572   will be returned), a locale type (the specifications for all locales
 573   of that type will be returned), 'all (all specifications will be
 574   returned), or nil (the actual specifier object will be returned).
 575
 576 See `face-property' for more information."
 577   (face-property face 'background-pixmap locale tag-set exact-p))
 578
 579 (defun face-background-pixmap-instance (face &optional domain default
 580                                              no-fallback)
 581   "Return the instance of FACE's background pixmap in DOMAIN.
 582
 583 FACE may be either a face object or a symbol representing a face.
 584
 585 Normally DOMAIN will be a window or nil (meaning the selected window),
 586   and an instance object describing how the background appears in that
 587   particular window and buffer will be returned.
 588
 589 See `face-property-instance' for more information."
 590   (face-property-instance face 'background-pixmap domain default no-fallback))
 591
 592 (defun set-face-background-pixmap (face pixmap &optional locale tag-set
 593                                         how-to-add)
 594   "Change the background pixmap of FACE to PIXMAP in LOCALE.
 595 This property is only used on window system devices.
 596
 597 FACE may be either a face object or a symbol representing a face.
 598
 599 PIXMAP should be an instantiator (see `image-specifier-p'), a list
 600   of instantiators, an alist of specifications (each mapping a locale
 601   to an instantiator list), or an image specifier object.
 602
 603 If PIXMAP is an alist, LOCALE must be omitted.  If PIXMAP is a
 604   specifier object, LOCALE can be a locale, a locale type, 'all,
 605   or nil; see `copy-specifier' for its semantics.  Otherwise LOCALE
 606   specifies the locale under which the specified instantiator(s)
 607   will be added, and defaults to 'global.
 608
 609 See `set-face-property' for more information."
 610   (interactive (face-interactive "background-pixmap"))
 611   (set-face-property face 'background-pixmap pixmap locale tag-set how-to-add))
 612
 613 (defun face-display-table (face &optional locale tag-set exact-p)
 614   "Return the display table of FACE in LOCALE.
 615
 616 A vector (as returned by `make-display-table') will be returned.
 617
 618 LOCALE may be a locale (the instantiators for that particular locale
 619   will be returned), a locale type (the specifications for all locales
 620   of that type will be returned), 'all (all specifications will be
 621   returned), or nil (the actual specifier object will be returned).
 622
 623 See `face-property' for more information."
 624   (face-property face 'display-table locale tag-set exact-p))
 625
 626 (defun face-display-table-instance (face &optional domain default no-fallback)
 627   "Return the instance of FACE's display table in DOMAIN.
 628 A vector (as returned by `make-display-table') will be returned.
 629
 630 See `face-property-instance' for the semantics of the DOMAIN argument."
 631   (face-property-instance face 'display-table domain default no-fallback))
 632
 633 (defun set-face-display-table (face display-table &optional locale tag-set
 634                                     how-to-add)
 635   "Change the display table of FACE to DISPLAY-TABLE in LOCALE.
 636 DISPLAY-TABLE should be a vector as returned by `make-display-table'.
 637
 638 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 639   HOW-TO-ADD arguments."
 640   (interactive (face-interactive "display-table"))
 641   (set-face-property face 'display-table display-table locale tag-set
 642                      how-to-add))
 643
 644 ;; The following accessors and mutators are, IMHO, good
 645 ;; implementation.  Cf. with `make-face-bold'.
 646
 647 (defun face-underline-p (face &optional domain default no-fallback)
 648   "Return t if FACE is underlined in DOMAIN.
 649 See `face-property-instance' for the semantics of the DOMAIN argument."
 650   (face-property-instance face 'underline domain default no-fallback))
 651
 652 (defun set-face-underline-p (face underline-p &optional locale tag-set
 653                                   how-to-add)
 654   "Change the underline property of FACE to UNDERLINE-P.
 655 UNDERLINE-P is normally a face-boolean instantiator; see
 656  `face-boolean-specifier-p'.
 657 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 658  HOW-TO-ADD arguments."
 659   (interactive (face-interactive "underline-p" "underlined"))
 660   (set-face-property face 'underline underline-p locale tag-set how-to-add))
 661
 662 (defun face-strikethru-p (face &optional domain default no-fallback)
 663   "Return t if FACE is strikethru-d (i.e. struck through) in DOMAIN.
 664 See `face-property-instance' for the semantics of the DOMAIN argument."
 665   (face-property-instance face 'strikethru domain default no-fallback))
 666
 667 (defun set-face-strikethru-p (face strikethru-p &optional locale tag-set
 668                                   how-to-add)
 669   "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE.
 670 STRIKETHRU-P is normally a face-boolean instantiator; see
 671  `face-boolean-specifier-p'.
 672 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 673  HOW-TO-ADD arguments."
 674   (interactive (face-interactive "strikethru-p" "strikethru-d"))
 675   (set-face-property face 'strikethru strikethru-p locale tag-set how-to-add))
 676
 677 (defun face-highlight-p (face &optional domain default no-fallback)
 678   "Return t if FACE is highlighted in DOMAIN (TTY domains only).
 679 See `face-property-instance' for the semantics of the DOMAIN argument."
 680   (face-property-instance face 'highlight domain default no-fallback))
 681
 682 (defun set-face-highlight-p (face highlight-p &optional locale tag-set
 683                                   how-to-add)
 684   "Change whether FACE is highlighted in LOCALE (TTY locales only).
 685 HIGHLIGHT-P is normally a face-boolean instantiator; see
 686  `face-boolean-specifier-p'.
 687 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 688  HOW-TO-ADD arguments."
 689   (interactive (face-interactive "highlight-p" "highlighted"))
 690   (set-face-property face 'highlight highlight-p locale tag-set how-to-add))
 691
 692 (defun face-dim-p (face &optional domain default no-fallback)
 693   "Return t if FACE is dimmed in DOMAIN (TTY domains only).
 694 See `face-property-instance' for the semantics of the DOMAIN argument."
 695   (face-property-instance face 'dim domain default no-fallback))
 696
 697 (defun set-face-dim-p (face dim-p &optional locale tag-set how-to-add)
 698   "Change whether FACE is dimmed in LOCALE (TTY locales only).
 699 DIM-P is normally a face-boolean instantiator; see
 700  `face-boolean-specifier-p'.
 701 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 702  HOW-TO-ADD arguments."
 703   (interactive (face-interactive "dim-p" "dimmed"))
 704   (set-face-property face 'dim dim-p locale tag-set how-to-add))
 705
 706 (defun face-blinking-p (face &optional domain default no-fallback)
 707   "Return t if FACE is blinking in DOMAIN (TTY domains only).
 708 See `face-property-instance' for the semantics of the DOMAIN argument."
 709   (face-property-instance face 'blinking domain default no-fallback))
 710
 711 (defun set-face-blinking-p (face blinking-p &optional locale tag-set
 712                                  how-to-add)
 713   "Change whether FACE is blinking in LOCALE (TTY locales only).
 714 BLINKING-P is normally a face-boolean instantiator; see
 715  `face-boolean-specifier-p'.
 716 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 717  HOW-TO-ADD arguments."
 718   (interactive (face-interactive "blinking-p" "blinking"))
 719   (set-face-property face 'blinking blinking-p locale tag-set how-to-add))
 720
 721 (defun face-reverse-p (face &optional domain default no-fallback)
 722   "Return t if FACE is reversed in DOMAIN (TTY domains only).
 723 See `face-property-instance' for the semantics of the DOMAIN argument."
 724   (face-property-instance face 'reverse domain default no-fallback))
 725
 726 (defun set-face-reverse-p (face reverse-p &optional locale tag-set how-to-add)
 727   "Change whether FACE is reversed in LOCALE (TTY locales only).
 728 REVERSE-P is normally a face-boolean instantiator; see
 729  `face-boolean-specifier-p'.
 730 See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 731  HOW-TO-ADD arguments."
 732   (interactive (face-interactive "reverse-p" "reversed"))
 733   (set-face-property face 'reverse reverse-p locale tag-set how-to-add))
 734
 735 \f
 736 (defun face-property-equal (face1 face2 prop domain)
 737   (equal (face-property-instance face1 prop domain)
 738          (face-property-instance face2 prop domain)))
 739
 740 (defun face-equal-loop (props face1 face2 domain)
 741   (while (and props
 742               (face-property-equal face1 face2 (car props) domain))
 743     (setq props (cdr props)))
 744   (null props))
 745
 746 (defun face-equal (face1 face2 &optional domain)
 747   "Return t if FACE1 and FACE2 will display in the same way in DOMAIN.
 748 See `face-property-instance' for the semantics of the DOMAIN argument."
 749   (if (null domain) (setq domain (selected-window)))
 750   (if (not (valid-specifier-domain-p domain))
 751       (error "Invalid specifier domain"))
 752   (let ((device (dfw-device domain))
 753         (common-props '(foreground background font display-table underline))
 754         (win-props '(background-pixmap strikethru))
 755         (tty-props '(highlight dim blinking reverse)))
 756
 757     ;; First check the properties which are used in common between the
 758     ;; x and tty devices.  Then, check those properties specific to
 759     ;; the particular device type.
 760     (and (face-equal-loop common-props face1 face2 domain)
 761          (cond ((eq 'tty (device-type device))
 762                 (face-equal-loop tty-props face1 face2 domain))
 763                ((or (eq 'x (device-type device))
 764                     (eq 'mswindows (device-type device)))
 765                 (face-equal-loop win-props face1 face2 domain))
 766                (t t)))))
 767
 768 (defun face-differs-from-default-p (face &optional domain)
 769   "Return t if FACE will display differently from the default face in DOMAIN.
 770 See `face-property-instance' for the semantics of the DOMAIN argument."
 771   (not (face-equal face 'default domain)))
 772
 773 ; moved from x-faces.el
 774 (defun try-font-name (name &optional device)
 775   ;; yes, name really should be here twice.
 776   (and name (make-font-instance name device t) name))
 777
 778 \f
 779 ;; This function is a terrible, disgusting hack!!!!  Need to
 780 ;; separate out the font elements as separate face properties!
 781
 782 ;; WE DEMAND LEXICAL SCOPING!!!
 783 ;; WE DEMAND LEXICAL SCOPING!!!
 784 ;; WE DEMAND LEXICAL SCOPING!!!
 785 ;; WE DEMAND LEXICAL SCOPING!!!
 786 ;; WE DEMAND LEXICAL SCOPING!!!
 787 ;; WE DEMAND LEXICAL SCOPING!!!
 788 ;; WE DEMAND LEXICAL SCOPING!!!
 789 ;; WE DEMAND LEXICAL SCOPING!!!
 790 ;; WE DEMAND LEXICAL SCOPING!!!
 791 ;; WE DEMAND LEXICAL SCOPING!!!
 792 ;; WE DEMAND LEXICAL SCOPING!!!
 793 ;; WE DEMAND LEXICAL SCOPING!!!
 794 ;; WE DEMAND LEXICAL SCOPING!!!
 795 ;; WE DEMAND LEXICAL SCOPING!!!
 796 ;; WE DEMAND LEXICAL SCOPING!!!
 797 (defun frob-face-property (face property func &optional locale)
 798   "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE.
 799 This function is ugly and messy and is primarily used as an internal
 800 helper function for `make-face-bold' et al., so you probably don't
 801 want to use it or read the rest of the documentation.  But if you do ...
 802
 803 FUNC should be a function of two arguments (an instance and a device)
 804 that returns a modified name that is valid for the given device.
 805 If LOCALE specifies a valid domain (i.e. a window, frame, or device),
 806 this function instantiates the specifier over that domain, applies FUNC
 807 to the resulting instance, and adds the result back as an instantiator
 808 for that locale.  Otherwise, LOCALE should be a locale, locale type, or
 809 'all (defaults to 'all if omitted).  For each specification thusly
 810 included: if the locale given is a valid domain, FUNC will be
 811 iterated over all valid instantiators for the device of the domain
 812 until a non-nil result is found (if there is no such result, the
 813 first valid instantiator is used), and that result substituted for
 814 the specification; otherwise, the process just outlined is
 815 iterated over each existing device and the concatenated results
 816 substituted for the specification."
 817   (let ((sp (face-property face property)))
 818     (if (valid-specifier-domain-p locale)
 819         ;; this is easy.
 820         (let* ((inst (face-property-instance face property locale))
 821                (name (and inst (funcall func inst (dfw-device locale)))))
 822           (when name
 823             (add-spec-to-specifier sp name locale)))
 824       ;; otherwise, map over all specifications ...
 825       ;; but first, some further kludging:
 826       ;; (1) if we're frobbing the global property, make sure
 827       ;;     that something is there (copy from the default face,
 828       ;;     if necessary).  Otherwise, something like
 829       ;;     (make-face-larger 'modeline)
 830       ;;     won't do anything at all if the modeline simply
 831       ;;     inherits its font from 'default.
 832       ;; (2) if we're frobbing a particular locale, nothing would
 833       ;;     happen if that locale has no instantiators.  So signal
 834       ;;     an error to indicate this.
 835       (if (and (or (eq locale 'global) (eq locale 'all) (not locale))
 836                (not (face-property face property 'global)))
 837           (copy-specifier (face-property 'default property)
 838                           (face-property face property)
 839                           'global))
 840       (if (and (valid-specifier-locale-p locale)
 841                (not (face-property face property locale)))
 842           (error "Property must have a specification in locale %S" locale))
 843       (map-specifier
 844        sp
 845        (lambda (sp locale inst-list func)
 846          (let* ((device (dfw-device locale))
 847                 ;; if a device can be derived from the locale,
 848                 ;; call frob-face-property-1 for that device.
 849                 ;; Otherwise map frob-face-property-1 over each device.
 850                 (result
 851                  (if device
 852                      (list (frob-face-property-1 sp device inst-list func))
 853                    (mapcar (lambda (device)
 854                              (frob-face-property-1 sp device
 855                                                    inst-list func))
 856                            (device-list))))
 857                 new-result)
 858            ;; remove duplicates and nils from the obtained list of
 859            ;; instantiators.
 860            (mapcar (lambda (arg)
 861                      (when (and arg (not (member arg new-result)))
 862                        (setq new-result (cons arg new-result))))
 863                    result)
 864            ;; add back in.
 865            (add-spec-list-to-specifier sp (list (cons locale new-result)))
 866            ;; tell map-specifier to keep going.
 867            nil))
 868        locale
 869        func))))
 870
 871 (defun frob-face-property-1 (sp device inst-list func)
 872   (let
 873       (first-valid result)
 874     (while (and inst-list (not result))
 875       (let* ((inst-pair (car inst-list))
 876              (tag-set (car inst-pair))
 877              (sp-inst (specifier-instance-from-inst-list
 878                        sp device (list inst-pair))))
 879         (if sp-inst
 880             (progn
 881               (if (not first-valid)
 882                   (setq first-valid inst-pair))
 883               (setq result (funcall func sp-inst device))
 884               (if result
 885                   (setq result (cons tag-set result))))))
 886       (setq inst-list (cdr inst-list)))
 887     (or result first-valid)))
 888
 889 (defun frob-face-font-2 (face locale unfrobbed-face frobbed-face
 890                               tty-thunk x-thunk standard-face-mapping)
 891   ;; another kludge to make things more intuitive.  If we're
 892   ;; inheriting from a standard face in this locale, frob the
 893   ;; inheritance as appropriate.  Else, if, after the first X frobbing
 894   ;; pass, the face hasn't changed and still looks like the standard
 895   ;; unfrobbed face (e.g. 'default), make it inherit from the standard
 896   ;; frobbed face (e.g. 'bold).  Regardless of things, do the TTY
 897   ;; frobbing.
 898
 899   ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale,
 900   ;; but is a "locale, locale-type, or nil for all".  So ...  do our extra
 901   ;; frobbing only if it's actually a locale; or for nil, do the frobbing
 902   ;; on 'global.  This specifier stuff needs some rethinking.
 903   (let* ((the-locale (cond ((null locale) 'global)
 904                            ((valid-specifier-locale-p locale) locale)
 905                            (t nil)))
 906          (specs (and the-locale (face-font face the-locale nil t)))
 907          (change-it (and specs (cdr (assoc specs standard-face-mapping)))))
 908     (if (and change-it
 909              (not (memq (face-name (find-face face))
 910                         '(default bold italic bold-italic))))
 911         (progn
 912           (or (equal change-it t)
 913               (set-face-property face 'font change-it the-locale))
 914           (funcall tty-thunk))
 915       (let* ((domain (cond ((null the-locale) nil)
 916                            ((valid-specifier-domain-p the-locale) the-locale)
 917                            ;; OK, this next one is truly a kludge, but
 918                            ;; it results in more intuitive behavior most
 919                            ;; of the time. (really!)
 920                            ((or (eq the-locale 'global) (eq the-locale 'all))
 921                             (selected-device))
 922                            (t nil)))
 923              (inst (and domain (face-property-instance face 'font domain))))
 924         (funcall tty-thunk)
 925         (funcall x-thunk)
 926         ;; If it's reasonable to do the inherit-from-standard-face trick,
 927         ;; and it's called for, then do it now.
 928         (or (null domain)
 929             (not (equal inst (face-property-instance face 'font domain)))
 930             ;; don't do it for standard faces, or you'll get inheritance loops.
 931             ;; #### This makes XEmacs seg fault! fix this bug.
 932             (memq (face-name (find-face face))
 933                   '(default bold italic bold-italic))
 934             (not (equal (face-property-instance face 'font domain)
 935                         (face-property-instance unfrobbed-face 'font domain)))
 936             (set-face-property face 'font (vector frobbed-face)
 937                                the-locale))))))
 938
 939 (defun make-face-bold (face &optional locale)
 940   "Make FACE bold in LOCALE, if possible.
 941 This will attempt to make the font bold for X locales and will set the
 942 highlight flag for TTY locales.
 943
 944 If LOCALE is nil, omitted, or `all', this will attempt to frob all
 945 font specifications for FACE to make them appear bold.  Similarly, if
 946 LOCALE is a locale type, this frobs all font specifications for locales
 947 of that type.  If LOCALE is a particular locale, what happens depends on
 948 what sort of locale is given.  If you gave a device, frame, or window,
 949 then it's always possible to determine what the font actually will be,
 950 so this is determined and the resulting font is frobbed and added back as a
 951 specification for this locale.  If LOCALE is a buffer, however, you can't
 952 determine what the font will actually be unless there's actually a
 953 specification given for that particular buffer (otherwise, it depends
 954 on what window and frame the buffer appears in, and might not even be
 955 well-defined if the buffer appears multiple times in different places);
 956 therefore you will get an error unless there's a specification for the
 957 buffer.
 958
 959 Finally, in some cases (specifically, when LOCALE is not a locale type),
 960 if the frobbing didn't actually make the font look any different
 961 \(this happens, for example, if your font specification is already bold
 962 or has no bold equivalent), and currently looks like the font of the
 963 'default face, it is set to inherit from the 'bold face.  This is kludgy
 964 but it makes `make-face-bold' have more intuitive behavior in many
 965 circumstances."
 966   (interactive (list (read-face-name "Make which face bold: ")))
 967   (frob-face-font-2
 968    face locale 'default 'bold
 969    (lambda ()
 970      ;; handle TTY specific entries
 971      (when (featurep 'tty)
 972        (set-face-highlight-p face t locale 'tty)))
 973    (lambda ()
 974      ;; handle X specific entries
 975      (when (featurep 'x)
 976        (frob-face-property face 'font 'x-make-font-bold locale))
 977      (when (featurep 'mswindows)
 978        (frob-face-property face 'font 'mswindows-make-font-bold locale))
 979      )
 980    '(([default] . [bold])
 981      ([bold] . t)
 982      ([italic] . [bold-italic])
 983      ([bold-italic] . t))))
 984
 985 (defun make-face-italic (face &optional locale)
 986   "Make FACE italic in LOCALE, if possible.
 987 This will attempt to make the font italic for X locales and will set
 988 the underline flag for TTY locales.
 989 See `make-face-bold' for the semantics of the LOCALE argument and
 990 for more specifics on exactly how this function works."
 991   (interactive (list (read-face-name "Make which face italic: ")))
 992   (frob-face-font-2
 993    face locale 'default 'italic
 994    (lambda ()
 995      ;; handle TTY specific entries
 996      (when (featurep 'tty)
 997        (set-face-underline-p face t locale 'tty)))
 998    (lambda ()
 999      ;; handle X specific entries
1000      (when (featurep 'x)
1001        (frob-face-property face 'font 'x-make-font-italic locale))
1002      (when (featurep 'mswindows)
1003        (frob-face-property face 'font 'mswindows-make-font-italic locale))
1004      )
1005    '(([default] . [italic])
1006      ([bold] . [bold-italic])
1007      ([italic] . t)
1008      ([bold-italic] . t))))
1009
1010 (defun make-face-bold-italic (face &optional locale)
1011   "Make FACE bold and italic in LOCALE, if possible.
1012 This will attempt to make the font bold-italic for X locales and will
1013 set the highlight and underline flags for TTY locales.
1014 See `make-face-bold' for the semantics of the LOCALE argument and
1015 for more specifics on exactly how this function works."
1016   (interactive (list (read-face-name "Make which face bold-italic: ")))
1017   (frob-face-font-2
1018    face locale 'default 'bold-italic
1019    (lambda ()
1020      ;; handle TTY specific entries
1021      (when (featurep 'tty)
1022        (set-face-highlight-p face t locale 'tty)
1023        (set-face-underline-p face t locale 'tty)))
1024    (lambda ()
1025      ;; handle X specific entries
1026      (when (featurep 'x)
1027        (frob-face-property face 'font 'x-make-font-bold-italic locale))
1028      (when (featurep 'mswindows)
1029        (frob-face-property face 'font 'mswindows-make-font-bold-italic locale))
1030      )
1031    '(([default] . [italic])
1032      ([bold] . [bold-italic])
1033      ([italic] . [bold-italic])
1034      ([bold-italic] . t))))
1035
1036 (defun make-face-unbold (face &optional locale)
1037   "Make FACE non-bold in LOCALE, if possible.
1038 This will attempt to make the font non-bold for X locales and will
1039 unset the highlight flag for TTY locales.
1040 See `make-face-bold' for the semantics of the LOCALE argument and
1041 for more specifics on exactly how this function works."
1042   (interactive (list (read-face-name "Make which face non-bold: ")))
1043   (frob-face-font-2
1044    face locale 'bold 'default
1045    (lambda ()
1046      ;; handle TTY specific entries
1047      (when (featurep 'tty)
1048        (set-face-highlight-p face nil locale 'tty)))
1049    (lambda ()
1050      ;; handle X specific entries
1051      (when (featurep 'x)
1052        (frob-face-property face 'font 'x-make-font-unbold locale))
1053      (when (featurep 'mswindows)
1054        (frob-face-property face 'font 'mswindows-make-font-unbold locale))
1055      )
1056    '(([default] . t)
1057      ([bold] . [default])
1058      ([italic] . t)
1059      ([bold-italic] . [italic]))))
1060
1061 (defun make-face-unitalic (face &optional locale)
1062   "Make FACE non-italic in LOCALE, if possible.
1063 This will attempt to make the font non-italic for X locales and will
1064 unset the underline flag for TTY locales.
1065 See `make-face-bold' for the semantics of the LOCALE argument and
1066 for more specifics on exactly how this function works."
1067   (interactive (list (read-face-name "Make which face non-italic: ")))
1068   (frob-face-font-2
1069    face locale 'italic 'default
1070    (lambda ()
1071      ;; handle TTY specific entries
1072      (when (featurep 'tty)
1073        (set-face-underline-p face nil locale 'tty)))
1074    (lambda ()
1075      ;; handle X specific entries
1076      (when (featurep 'x)
1077        (frob-face-property face 'font 'x-make-font-unitalic locale))
1078      (when (featurep 'mswindows)
1079        (frob-face-property face 'font 'mswindows-make-font-unitalic locale))
1080      )
1081    '(([default] . t)
1082      ([bold] . t)
1083      ([italic] . [default])
1084      ([bold-italic] . [bold]))))
1085
1086
1087 ;; Why do the following two functions lose so badly in so many
1088 ;; circumstances?
1089
1090 (defun make-face-smaller (face &optional locale)
1091   "Make the font of FACE be smaller, if possible.
1092 LOCALE works as in `make-face-bold' et al., but the ``inheriting-
1093 from-the-bold-face'' operations described there are not done
1094 because they don't make sense in this context."
1095   (interactive (list (read-face-name "Shrink which face: ")))
1096   ;; handle X specific entries
1097   (when (featurep 'x)
1098     (frob-face-property face 'font 'x-find-smaller-font locale))
1099   (when (featurep 'mswindows)
1100     (frob-face-property face 'font 'mswindows-find-smaller-font locale)))
1101
1102 (defun make-face-larger (face &optional locale)
1103   "Make the font of FACE be larger, if possible.
1104 See `make-face-smaller' for the semantics of the LOCALE argument."
1105   (interactive (list (read-face-name "Enlarge which face: ")))
1106   ;; handle X specific entries
1107   (when (featurep 'x)
1108     (frob-face-property face 'font 'x-find-larger-font locale))
1109   (when (featurep 'mswindows)
1110     (frob-face-property face 'font 'mswindows-find-larger-font locale)))
1111
1112 (defun invert-face (face &optional locale)
1113   "Swap the foreground and background colors of the face."
1114   (interactive (list (read-face-name "Invert face: ")))
1115   (if (valid-specifier-domain-p locale)
1116       (let ((foreface (face-foreground-instance face locale)))
1117         (set-face-foreground face (face-background-instance face locale)
1118                              locale)
1119         (set-face-background face foreface locale))
1120     (let ((forespec (copy-specifier (face-foreground face) nil locale)))
1121       (copy-specifier (face-background face) (face-foreground face) locale)
1122       (copy-specifier forespec (face-background face) locale))))
1123
1124 \f
1125 ;;; Convenience functions
1126
1127 (defun face-ascent (face &optional domain charset)
1128   "Return the ascent of FACE in DOMAIN.
1129 See `face-property-instance' for the semantics of the DOMAIN argument."
1130   (font-ascent (face-font face) domain charset))
1131
1132 (defun face-descent (face &optional domain charset)
1133   "Return the descent of FACE in DOMAIN.
1134 See `face-property-instance' for the semantics of the DOMAIN argument."
1135   (font-descent (face-font face) domain charset))
1136
1137 (defun face-width (face &optional domain charset)
1138   "Return the width of FACE in DOMAIN.
1139 See `face-property-instance' for the semantics of the DOMAIN argument."
1140   (font-width (face-font face) domain charset))
1141
1142 (defun face-height (face &optional domain charset)
1143   "Return the height of FACE in DOMAIN.
1144 See `face-property-instance' for the semantics of the DOMAIN argument."
1145   (+ (face-ascent face domain charset) (face-descent face domain charset)))
1146
1147 (defun face-proportional-p (face &optional domain charset)
1148   "Return t if FACE is proportional in DOMAIN.
1149 See `face-property-instance' for the semantics of the DOMAIN argument."
1150   (font-proportional-p (face-font face) domain charset))
1151
1152 \f
1153 ;; Functions that used to be in cus-face.el, but logically go here.
1154
1155 (defcustom frame-background-mode nil
1156   "*The brightness of the background.
1157 Set this to the symbol dark if your background color is dark, light if
1158 your background is light, or nil (default) if you want Emacs to
1159 examine the brightness for you."
1160   :group 'faces
1161   :type '(choice (choice-item dark)
1162                  (choice-item light)
1163                  (choice-item :tag "Auto" nil)))
1164
1165 ;; The old variable that many people still have in .emacs files.
1166 (define-obsolete-variable-alias 'custom-background-mode
1167   'frame-background-mode)
1168
1169 (defun get-frame-background-mode (frame)
1170   "Detect background mode for FRAME."
1171   (let* ((color-instance (face-background-instance 'default frame))
1172          (mode (condition-case nil
1173                    (if (< (apply '+ (color-instance-rgb-components
1174                                      color-instance)) 65536)
1175                        'dark 'light)
1176                  ;; Here, we get an error on a TTY.  As we don't have
1177                  ;; a good way of detecting whether a TTY is light or
1178                  ;; dark, we'll guess it's dark.
1179                  (error 'dark))))
1180     (set-frame-property frame 'background-mode mode)
1181     mode))
1182
1183 (defun extract-custom-frame-properties (frame)
1184   "Return a plist with the frame properties of FRAME used by custom."
1185   (list 'type (or (frame-property frame 'display-type)
1186                   (device-type (frame-device frame)))
1187         'class (device-class (frame-device frame))
1188         'background (or frame-background-mode
1189                         (frame-property frame 'background-mode)
1190                         (get-frame-background-mode frame))))
1191
1192 (defcustom init-face-from-resources t
1193   "If non nil, attempt to initialize faces from the resource database."
1194   :group 'faces
1195   :type 'boolean)
1196
1197 ;; Old name, used by custom.  Also, FSFmacs name.
1198 (defvaralias 'initialize-face-resources 'init-face-from-resources)
1199
1200 (defun face-spec-set (face spec &optional frame)
1201   "Set FACE's face attributes according to the first matching entry in SPEC.
1202 If optional FRAME is non-nil, set it for that frame only.
1203 If it is nil, then apply SPEC to each frame individually.
1204 See `defface' for information about SPEC."
1205   (if frame
1206       (progn
1207         (reset-face face frame)
1208         (face-display-set face spec frame)
1209         (init-face-from-resources face frame))
1210     (let ((frames (relevant-custom-frames)))
1211       (reset-face face)
1212       (face-display-set face spec)
1213       (while frames
1214         (face-display-set face spec (car frames))
1215         (pop frames))
1216       (init-face-from-resources face))))
1217
1218 (defun face-display-set (face spec &optional frame)
1219   "Set FACE to the attributes to the first matching entry in SPEC.
1220 Iff optional FRAME is non-nil, set it for that frame only.
1221 See `defface' for information about SPEC."
1222   (while spec
1223     (let ((display (caar spec))
1224           (atts (cadar spec)))
1225       (pop spec)
1226       (when (face-spec-set-match-display display frame)
1227         ;; Avoid creating frame local duplicates of the global face.
1228         (unless (and frame (eq display (get face 'custom-face-display)))
1229           (apply 'face-custom-attributes-set face frame atts))
1230         (unless frame
1231           (put face 'custom-face-display display))
1232         (setq spec nil)))))
1233
1234 (defvar default-custom-frame-properties nil
1235   "The frame properties used for the global faces.
1236 Frames not matching these propertiess should have frame local faces.
1237 The value should be nil, if uninitialized, or a plist otherwise.
1238 See `defface' for a list of valid keys and values for the plist.")
1239
1240 (defun get-custom-frame-properties (&optional frame)
1241   "Return a plist with the frame properties of FRAME used by custom.
1242 If FRAME is nil, return the default frame properties."
1243   (cond (frame
1244          ;; Try to get from cache.
1245          (let ((cache (frame-property frame 'custom-properties)))
1246            (unless cache
1247              ;; Oh well, get it then.
1248              (setq cache (extract-custom-frame-properties frame))
1249              ;; and cache it...
1250              (set-frame-property frame 'custom-properties cache))
1251            cache))
1252         ;; We avoid this cache, because various frame and device
1253         ;; properties can change.
1254         ;;(default-custom-frame-properties)
1255         (t
1256          (setq default-custom-frame-properties
1257                (extract-custom-frame-properties (selected-frame))))))
1258
1259 (defun face-spec-set-match-display (display &optional frame)
1260   "Return non-nil if DISPLAY matches FRAME.
1261 DISPLAY is part of a spec such as can be used in `defface'.
1262 If FRAME is nil or omitted, the selected frame is used."
1263   (if (eq display t)
1264       t
1265     (let* ((props (get-custom-frame-properties frame))
1266            (type (plist-get props 'type))
1267            (class (plist-get props 'class))
1268            (background (plist-get props 'background))
1269            (match t)
1270            (entries display)
1271            entry req options)
1272       (while (and entries match)
1273         (setq entry (car entries)
1274               entries (cdr entries)
1275               req (car entry)
1276               options (cdr entry)
1277               match (case req
1278                       (type       (memq type options))
1279                       (class      (memq class options))
1280                       (background (memq background options))
1281                       (t (warn "Unknown req `%S' with options `%S'"
1282                                req options)
1283                          nil))))
1284       match)))
1285
1286 (defun relevant-custom-frames ()
1287   "List of frames whose custom properties differ from the default."
1288   (let ((relevant nil)
1289         (default (get-custom-frame-properties))
1290         (frames (frame-list))
1291         frame)
1292     (while frames
1293       (setq frame (car frames)
1294             frames (cdr frames))
1295       (unless (equal default (get-custom-frame-properties frame))
1296         (push frame relevant)))
1297     relevant))
1298
1299 (defun initialize-custom-faces (&optional frame)
1300   "Initialize all custom faces for FRAME.
1301 If FRAME is nil or omitted, initialize them for all frames."
1302   (mapc (lambda (symbol)
1303           (let ((spec (or (get symbol 'saved-face)
1304                           (get symbol 'face-defface-spec))))
1305             (when spec
1306               ;; No need to init-face-from-resources -- code in
1307               ;; `init-frame-faces' does it already.
1308               (face-display-set symbol spec frame))))
1309         (face-list)))
1310
1311 (defun custom-initialize-frame (frame)
1312   "Initialize frame-local custom faces for FRAME if necessary."
1313   (unless (equal (get-custom-frame-properties)
1314                  (get-custom-frame-properties frame))
1315     (initialize-custom-faces frame)))
1316
1317 \f
1318 (defun make-empty-face (name &optional doc-string temporary)
1319   "Like `make-face', but doesn't query the resource database."
1320   (let ((init-face-from-resources nil))
1321     (make-face name doc-string temporary)))
1322
1323 (defun init-face-from-resources (face &optional locale)
1324   "Initialize FACE from the resource database.
1325 If LOCALE is specified, it should be a frame, device, or 'global, and
1326 the face will be resourced over that locale.  Otherwise, the face will
1327 be resourced over all possible locales (i.e. all frames, all devices,
1328 and 'global)."
1329   (cond ((null init-face-from-resources)
1330          ;; Do nothing.
1331          )
1332         ((not locale)
1333          ;; Global, set for all frames.
1334          (progn
1335            (init-face-from-resources face 'global)
1336            (let ((devices (device-list)))
1337              (while devices
1338                (init-face-from-resources face (car devices))
1339                (setq devices (cdr devices))))
1340            (let ((frames (frame-list)))
1341              (while frames
1342                (init-face-from-resources face (car frames))
1343                (setq frames (cdr frames))))))
1344         (t
1345          ;; Specific.
1346          (let ((devtype (cond ((devicep locale) (device-type locale))
1347                               ((framep locale) (frame-type locale))
1348                               (t nil))))
1349            (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype))
1350                   (x-init-face-from-resources face locale))
1351                  ((or (not devtype) (eq 'tty devtype))
1352                   ;; Nothing to do for TTYs?
1353                   ))))))
1354
1355 (defun init-device-faces (device)
1356   ;; First, add any device-local face resources.
1357   (when init-face-from-resources
1358     (loop for face in (face-list) do
1359           (init-face-from-resources face device))
1360     ;; Then do any device-specific initialization.
1361     (cond ((eq 'x (device-type device))
1362            (x-init-device-faces device))
1363           ((eq 'mswindows (device-type device))
1364            (mswindows-init-device-faces device))
1365           ;; Nothing to do for TTYs?
1366           )
1367     (init-other-random-faces device)))
1368
1369 (defun init-frame-faces (frame)
1370   (when init-face-from-resources
1371     ;; First, add any frame-local face resources.
1372     (loop for face in (face-list) do
1373           (init-face-from-resources face frame))
1374     ;; Then do any frame-specific initialization.
1375     (cond ((eq 'x (frame-type frame))
1376            (x-init-frame-faces frame))
1377           ((eq 'mswindows (frame-type frame))
1378            (mswindows-init-frame-faces frame))
1379           ;; Is there anything which should be done for TTY's?
1380           )))
1381
1382 ;; #### This is somewhat X-specific, and is called when the first
1383 ;; X device is created (even if there were TTY devices created
1384 ;; beforehand).  The concept of resources has not been generalized
1385 ;; outside of X-specificness, so we have to live with this
1386 ;; breach of device-independence.
1387
1388 (defun init-global-faces ()
1389   ;; Look for global face resources.
1390   (loop for face in (face-list) do
1391         (init-face-from-resources face 'global))
1392   ;; Further X frobbing.
1393   (x-init-global-faces)
1394   ;; for bold and the like, make the global specification be bold etc.
1395   ;; if the user didn't already specify a value.  These will also be
1396   ;; frobbed further in init-other-random-faces.
1397   (unless (face-font 'bold 'global)
1398     (make-face-bold 'bold 'global))
1399   ;;
1400   (unless (face-font 'italic 'global)
1401     (make-face-italic 'italic 'global))
1402   ;;
1403   (unless (face-font 'bold-italic 'global)
1404     (make-face-bold-italic 'bold-italic 'global)
1405     (unless (face-font 'bold-italic 'global)
1406       (copy-face 'bold 'bold-italic)
1407       (make-face-italic 'bold-italic)))
1408
1409   (when (face-equal 'bold 'bold-italic)
1410     (copy-face 'italic 'bold-italic)
1411     (make-face-bold 'bold-italic))
1412   ;;
1413   ;; Nothing more to be done for X or TTY's?
1414   )
1415
1416
1417 ;; These warnings are there for a reason.  Just specify your fonts
1418 ;; correctly.  Deal with it.  Additionally, one can use
1419 ;; `log-warning-minimum-level' instead of this.
1420 ;(defvar inhibit-font-complaints nil
1421 ;  "Whether to suppress complaints about incomplete sets of fonts.")
1422
1423 (defun face-complain-about-font (face device)
1424   (if (symbolp face) (setq face (symbol-name face)))
1425 ;;  (if (not inhibit-font-complaints)
1426   (display-warning
1427    'font
1428    (let ((default-name (face-font-name 'default device)))
1429      (format "%s: couldn't deduce %s %s version of the font
1430 %S.
1431
1432 Please specify X resources to make the %s face
1433 visually distinguishable from the default face.
1434 For example, you could add one of the following to $HOME/Emacs:
1435
1436 Emacs.%s.attributeFont: -dt-*-medium-i-*
1437 or
1438 Emacs.%s.attributeForeground: hotpink\n"
1439              invocation-name
1440              (if (string-match "\\`[aeiouAEIOU]" face) "an" "a")
1441              face
1442              default-name
1443              face
1444              face
1445              face
1446              ))))
1447
1448
1449 ;; #### This is quite a mess.  We should use the custom mechanism for
1450 ;; most of this stuff.  Currently we don't do it, because Custom
1451 ;; doesn't use specifiers (yet.)  FSF does it the Right Way.
1452
1453 ;; For instance, the definition of `bold' should be something like
1454 ;; (defface bold ((t (:bold t))) "Bold text.") -- and `:bold t' should
1455 ;; make sure that everything works properly.
1456
1457 (defun init-other-random-faces (device)
1458   "Initialize the colors and fonts of the bold, italic, bold-italic,
1459 zmacs-region, list-mode-item-selected, highlight, primary-selection,
1460 secondary-selection, and isearch faces when each device is created.  If
1461 you want to add code to do stuff like this, use the create-device-hook."
1462
1463   ;; try to make 'bold look different from the default on this device.
1464   ;; If that doesn't work at all, then issue a warning.
1465   (unless (face-differs-from-default-p 'bold device)
1466     (make-face-bold 'bold device)
1467     (unless (face-differs-from-default-p 'bold device)
1468       (make-face-unbold 'bold device)
1469       (unless (face-differs-from-default-p 'bold device)
1470         ;; the luser specified one of the bogus font names
1471         (face-complain-about-font 'bold device))))
1472
1473   ;; Similar for italic.
1474   ;; It's unreasonable to expect to be able to make a font italic all
1475   ;; the time.  For many languages, italic is an alien concept.
1476   ;; Basically, because italic is not a globally meaningful concept,
1477   ;; the use of the italic face should really be oboleted.
1478
1479   ;; I disagree with above.  In many languages, the concept of capital
1480   ;; letters is just as alien, and yet we use them.  Italic is here to
1481   ;; stay.  -hniksic
1482
1483   ;; In a Solaris Japanese environment, there just aren't any italic
1484   ;; fonts - period.  CDE recognizes this reality, and fonts
1485   ;; -dt-interface user-medium-r-normal-*-*-*-*-*-*-*-*-* don't come
1486   ;; in italic versions.  So we first try to make the font bold before
1487   ;; complaining.
1488   (unless (face-differs-from-default-p 'italic device)
1489     (make-face-italic 'italic device)
1490     (unless (face-differs-from-default-p 'italic device)
1491       (make-face-bold 'italic device)
1492       (unless (face-differs-from-default-p 'italic device)
1493         (face-complain-about-font 'italic device))))
1494
1495   ;; similar for bold-italic.
1496   (unless (face-differs-from-default-p 'bold-italic device)
1497     (make-face-bold-italic 'bold-italic device)
1498     ;; if we couldn't get a bold-italic version, try just bold.
1499     (unless (face-differs-from-default-p 'bold-italic device)
1500       (make-face-bold 'bold-italic device)
1501       ;; if we couldn't get bold or bold-italic, then that's probably because
1502       ;; the default font is bold, so make the `bold-italic' face be unbold.
1503       (unless (face-differs-from-default-p 'bold-italic device)
1504         (make-face-unbold 'bold-italic device)
1505         (make-face-italic 'bold-italic device)
1506         (unless (face-differs-from-default-p 'bold-italic device)
1507           ;; if that didn't work, try plain italic
1508           ;; (can this ever happen? what the hell.)
1509           (make-face-italic 'bold-italic device)
1510           (unless (face-differs-from-default-p 'bold-italic device)
1511             ;; then bitch and moan.
1512             (face-complain-about-font 'bold-italic device))))))
1513
1514   ;; Set the text-cursor colors unless already specified.
1515   (when (and (not (eq 'tty (device-type device)))
1516              (not (face-background 'text-cursor 'global))
1517              (face-property-equal 'text-cursor 'default 'background device))
1518     (set-face-background 'text-cursor [default foreground] 'global
1519                          nil 'append))
1520   (when (and (not (eq 'tty (device-type device)))
1521              (not (face-foreground 'text-cursor 'global))
1522              (face-property-equal 'text-cursor 'default 'foreground device))
1523     (set-face-foreground 'text-cursor [default background] 'global
1524                          nil 'append))
1525   )
1526
1527 ;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle Jones.
1528 (defun set-face-stipple (face pixmap &optional frame)
1529   "Change the stipple pixmap of FACE to PIXMAP.
1530 This is an Emacs compatibility function; consider using
1531 set-face-background-pixmap instead.
1532
1533 PIXMAP should be a string, the name of a file of pixmap data.
1534 The directories listed in the `x-bitmap-file-path' variable are searched.
1535
1536 Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT
1537 DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is
1538 a string, containing the raw bits of the bitmap.  XBM data is
1539 expected in this case, other types of image data will not work.
1540
1541 If the optional FRAME argument is provided, change only
1542 in that frame; otherwise change each frame."
1543   (while (not (find-face face))
1544     (setq face (signal 'wrong-type-argument (list 'facep face))))
1545   (locate-file pixmap x-bitmap-file-path ".xbm:" 4)
1546   (while (cond ((stringp pixmap)
1547                 (unless (file-readable-p pixmap)
1548                   (setq pixmap `[xbm :file ,pixmap]))
1549                 nil)
1550                ((and (consp pixmap) (= (length pixmap) 3))
1551                 (setq pixmap `[xbm :data ,pixmap])
1552                 nil)
1553                (t t))
1554     (setq pixmap (signal 'wrong-type-argument
1555                          (list 'stipple-pixmap-p pixmap))))
1556   (while (and frame (not (framep frame)))
1557     (setq frame (signal 'wrong-type-argument (list 'framep frame))))
1558   (set-face-background-pixmap face pixmap frame))
1559
1560 \f
1561 ;; Create the remaining standard faces now.  This way, packages that we dump
1562 ;; can reference these faces as parents.
1563 ;;
1564 ;; The default, modeline, left-margin, right-margin, text-cursor,
1565 ;; and pointer faces are created in C.
1566
1567 (make-face 'bold "Bold text.")
1568 (make-face 'italic "Italic text.")
1569 (make-face 'bold-italic "Bold-italic text.")
1570 (make-face 'underline "Underlined text.")
1571 (or (face-differs-from-default-p 'underline)
1572     (set-face-underline-p 'underline t 'global '(default)))
1573 (make-face 'zmacs-region "Used on highlightes region between point and mark.")
1574 (make-face 'isearch "Used on region matched by isearch.")
1575 (make-face 'list-mode-item-selected
1576            "Face for the selected list item in list-mode.")
1577 (make-face 'highlight "Highlight face.")
1578 (make-face 'primary-selection "Primary selection face.")
1579 (make-face 'secondary-selection "Secondary selection face.")
1580
1581 ;; Several useful color faces.
1582 (eval-when-compile (load "cl-macs"))
1583 (dolist (color '(red green blue yellow))
1584   (make-face color (concat (symbol-name color) " text."))
1585   (set-face-foreground color (symbol-name color) nil 'color))
1586
1587 ;; Make some useful faces.  This happens very early, before creating
1588 ;; the first non-stream device.
1589
1590 (set-face-background 'text-cursor
1591                      '(((x default) . "Red3")
1592                        ((mswindows default) . "Red3"))
1593                      'global)
1594
1595 ;; some older X servers don't recognize "darkseagreen2"
1596 (set-face-background 'highlight
1597                      '(((x default color) . "darkseagreen2")
1598                        ((x default color) . "green")
1599                        ((x default grayscale) . "gray53")
1600                        ((mswindows default color) . "darkseagreen2")
1601                        ((mswindows default color) . "green")
1602                        ((mswindows default grayscale) . "gray53"))
1603                      'global)
1604 (set-face-background-pixmap 'highlight
1605                             '(((x default mono) . "gray1")
1606                               ((mswindows default mono) . "gray1"))
1607                             'global)
1608
1609 (set-face-background 'zmacs-region
1610                      '(((x default color) . "gray65")
1611                        ((x default grayscale) . "gray65")
1612                        ((mswindows default color) . "gray65")
1613                        ((mswindows default grayscale) . "gray65"))
1614                      'global)
1615 (set-face-background-pixmap 'zmacs-region
1616                             '(((x default mono) . "gray3")
1617                               ((mswindows default mono) . "gray3"))
1618                             'global)
1619
1620 (set-face-background 'list-mode-item-selected
1621                      '(((x default color) . "gray68")
1622                        ((x default grayscale) . "gray68")
1623                        ((x default mono) . [default foreground])
1624                        ((mswindows default color) . "gray68")
1625                        ((mswindows default grayscale) . "gray68")
1626                        ((mswindows default mono) . [default foreground]))
1627                      'global)
1628 (set-face-foreground 'list-mode-item-selected
1629                      '(((x default mono) . [default background])
1630                        ((mswindows default mono) . [default background]))
1631                      'global)
1632
1633 (set-face-background 'primary-selection
1634                      '(((x default color) . "gray65")
1635                        ((x default grayscale) . "gray65")
1636                        ((mswindows default color) . "gray65")
1637                        ((mswindows default grayscale) . "gray65"))
1638                      'global)
1639 (set-face-background-pixmap 'primary-selection
1640                             '(((x default mono) . "gray3")
1641                               ((mswindows default mono) . "gray3"))
1642                             'global)
1643
1644 (set-face-background 'secondary-selection
1645                      '(((x default color) . "paleturquoise")
1646                        ((x default color) . "green")
1647                        ((x default grayscale) . "gray53")
1648                        ((mswindows default color) . "paleturquoise")
1649                        ((mswindows default color) . "green")
1650                        ((mswindows default grayscale) . "gray53"))
1651                      'global)
1652 (set-face-background-pixmap 'secondary-selection
1653                             '(((x default mono) . "gray1")
1654                               ((mswindows default mono) . "gray1"))
1655                             'global)
1656
1657 (set-face-background 'isearch
1658                      '(((x default color) . "paleturquoise")
1659                        ((x default color) . "green")
1660                        ((mswindows default color) . "paleturquoise")
1661                        ((mswindows default color) . "green"))
1662                      'global)
1663
1664 ;; Define some logical color names to be used when reading the pixmap files.
1665 (if (featurep 'xpm)
1666     (setq xpm-color-symbols
1667           (list
1668            (purecopy '("foreground" (face-foreground 'default)))
1669            (purecopy '("background" (face-background 'default)))
1670            (purecopy '("backgroundToolBarColor"
1671                        (or
1672                         (and
1673                          (featurep 'x)
1674                          (x-get-resource "backgroundToolBarColor"
1675                                          "BackgroundToolBarColor" 'string))
1676
1677                         (face-background 'toolbar))))
1678            (purecopy '("foregroundToolBarColor"
1679                        (or
1680                         (and
1681                          (featurep 'x)
1682                          (x-get-resource "foregroundToolBarColor"
1683                                          "ForegroundToolBarColor" 'string))
1684                         (face-foreground 'toolbar))))
1685            )))
1686
1687 (when (featurep 'tty)
1688   (set-face-highlight-p 'bold                    t 'global '(default tty))
1689   (set-face-underline-p 'italic                  t 'global '(default tty))
1690   (set-face-highlight-p 'bold-italic             t 'global '(default tty))
1691   (set-face-underline-p 'bold-italic             t 'global '(default tty))
1692   (set-face-highlight-p 'highlight               t 'global '(default tty))
1693   (set-face-reverse-p   'text-cursor             t 'global '(default tty))
1694   (set-face-reverse-p   'modeline                t 'global '(default tty))
1695   (set-face-reverse-p   'zmacs-region            t 'global '(default tty))
1696   (set-face-reverse-p   'primary-selection       t 'global '(default tty))
1697   (set-face-underline-p 'secondary-selection     t 'global '(default tty))
1698   (set-face-reverse-p   'list-mode-item-selected t 'global '(default tty))
1699   (set-face-reverse-p   'isearch                 t 'global '(default tty))
1700   )
1701
1702 ;;; faces.el ends here