xemacs-beta / lisp / faces.el

   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210
 211
 212
 213
 214
 215
 216
 217
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712
 713
 714
 715
 716
 717
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727
 728
 729
 730
 731
 732
 733
 734
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
;;; faces.el --- Lisp interface to the C "face" structure

;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995 Board of Trustees, University of Illinois
;; Copyright (C) 1995, 1996 Ben Wing

;; Author: Ben Wing <ben@xemacs.org>
;; Keywords: faces, internal, dumped

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Synched up with: Not synched with FSF.  Almost completely divergent.

;;; Commentary:

;; This file is dumped with XEmacs.

;; face implementation #1 (used Lisp vectors and parallel C vectors;
;; FSFmacs still uses this) authored by Jamie Zawinski <jwz@jwz.org>
;; pre Lucid-Emacs 19.0.

;; face implementation #2 (used one face object per frame per face)
;; authored by Jamie Zawinski for 19.9.

;; face implementation #3 (use one face object per face) originally
;; authored for 19.12 by Chuck Thompson <cthomp@cs.uiuc.edu>,
;; rewritten by Ben Wing with the advent of specifiers.


;;; Some stuff in FSF's faces.el is in our x-faces.el.

;;; Code:

(defgroup faces nil
  "Support for multiple text attributes (fonts, colors, ...)
Such a collection of attributes is called a \"face\"."
  :group 'emacs)


(defun read-face-name (prompt)
  (let (face)
    (while (= (length face) 0) ; nil or ""
      (setq face (completing-read prompt
				  (mapcar (lambda (x) (list (symbol-name x)))
					  (face-list))
				  nil t)))
    (intern face)))

(defun face-interactive (what &optional bool)
  (let* ((fn (intern (concat "face-" what "-instance")))
	 (face (read-face-name (format "Set %s of face: " what)))
	 (default (if (fboundp fn)
		      ;; #### we should distinguish here between
		      ;; explicitly setting the value to be the
		      ;; same as the default face's value, and
		      ;; not setting a value at all.
		      (funcall fn face)))
	 (value (if bool
		    (y-or-n-p (format "Should face %s be %s? "
				      (symbol-name face) bool))
		  (read-string (format "Set %s of face %s to: "
				       what (symbol-name face))
		   (cond ((font-instance-p default)
			  (font-instance-name default))
			 ((color-instance-p default)
			  (color-instance-name default))
			 ((image-instance-p default)
			  (image-instance-file-name default))
			 (t default))))))
    (list face (if (equal value "") nil value))))

(defconst built-in-face-specifiers
  (built-in-face-specifiers)
  "A list of the built-in face properties that are specifiers.")

(defun face-property (face property &optional locale tag-set exact-p)
  "Return FACE's value of the given PROPERTY.

If LOCALE is omitted, the FACE's actual value for PROPERTY will be
  returned.  For built-in properties, this will be a specifier object
  of a type appropriate to the property (e.g. a font or color
  specifier).  For other properties, this could be anything.

If LOCALE is supplied, then instead of returning the actual value,
  the specification(s) for the given locale or locale type will
  be returned.  This will only work if the actual value of
  PROPERTY is a specifier (this will always be the case for built-in
  properties, but not or not may apply to user-defined properties).
  If the actual value of PROPERTY is not a specifier, this value
  will simply be returned regardless of LOCALE.

The return value will be a list of instantiators (e.g. strings
  specifying a font or color name), or a list of specifications, each
  of which is a cons of a locale and a list of instantiators.
  Specifically, if LOCALE is a particular locale (a buffer, window,
  frame, device, or 'global), a list of instantiators for that locale
  will be returned.  Otherwise, if LOCALE is a locale type (one of
  the symbols 'buffer, 'window, 'frame, or 'device), the specifications
  for all locales of that type will be returned.  Finally, if LOCALE is
  'all, the specifications for all locales of all types will be returned.

The specifications in a specifier determine what the value of
  PROPERTY will be in a particular \"domain\" or set of circumstances,
  which is typically a particular Emacs window along with the buffer
  it contains and the frame and device it lies within.  The value
  is derived from the instantiator associated with the most specific
  locale (in the order buffer, window, frame, device, and 'global)
  that matches the domain in question.  In other words, given a domain
  (i.e. an Emacs window, usually), the specifier for PROPERTY will first
  be searched for a specification whose locale is the buffer contained
  within that window; then for a specification whose locale is the window
  itself; then for a specification whose locale is the frame that the
  window is contained within; etc.  The first instantiator that is
  valid for the domain (usually this means that the instantiator is
  recognized by the device [i.e. the X server or TTY device] that the
  domain is on.  The function `face-property-instance' actually does
  all this, and is used to determine how to display the face.

See `set-face-property' for the built-in property-names."

  (setq face (get-face face))
  (let ((value (get face property)))
    (if (and locale
	     (or (memq property built-in-face-specifiers)
		 (specifierp value)))
	(setq value (specifier-specs value locale tag-set exact-p)))
    value))

(defun convert-face-property-into-specifier (face property)
  "Convert PROPERTY on FACE into a specifier, if it's not already."
  (setq face (get-face face))
  (let ((specifier (get face property)))
    ;; if a user-property does not have a specifier but a
    ;; locale was specified, put a specifier there.
    ;; If there was already a value there, convert it to a
    ;; specifier with the value as its 'global instantiator.
    (unless (specifierp specifier)
      (let ((new-specifier (make-specifier 'generic)))
	(if (or (not (null specifier))
		;; make sure the nil returned from `get' wasn't
		;; actually the value of the property
		(null (get face property t)))
	    (add-spec-to-specifier new-specifier specifier))
	(setq specifier new-specifier)
	(put face property specifier)))))

(defun face-property-instance (face property
				    &optional domain default no-fallback)
  "Return the instance of FACE's PROPERTY in the specified DOMAIN.

Under most circumstances, DOMAIN will be a particular window,
  and the returned instance describes how the specified property
  actually is displayed for that window and the particular buffer
  in it.  Note that this may not be the same as how the property
  appears when the buffer is displayed in a different window or
  frame, or how the property appears in the same window if you
  switch to another buffer in that window; and in those cases,
  the returned instance would be different.

The returned instance will typically be a color-instance,
  font-instance, or pixmap-instance object, and you can query
  it using the appropriate object-specific functions.  For example,
  you could use `color-instance-rgb-components' to find out the
  RGB (red, green, and blue) components of how the 'background
  property of the 'highlight face is displayed in a particular
  window.  The results might be different from the results
  you would get for another window (perhaps the user
  specified a different color for the frame that window is on;
  or perhaps the same color was specified but the window is
  on a different X server, and that X server has different RGB
  values for the color from this one).

DOMAIN defaults to the selected window if omitted.

DOMAIN can be a frame or device, instead of a window.  The value
  returned for a such a domain is used in special circumstances
  when a more specific domain does not apply; for example, a frame
  value might be used for coloring a toolbar, which is conceptually
  attached to a frame rather than a particular window.  The value
  is also useful in determining what the value would be for a
  particular window within the frame or device, if it is not
  overridden by a more specific specification.

If PROPERTY does not name a built-in property, its value will
  simply be returned unless it is a specifier object, in which case
  it will be instanced using `specifier-instance'.

Optional arguments DEFAULT and NO-FALLBACK are the same as in
  `specifier-instance'."

  (setq face (get-face face))
  (let ((value (get face property)))
    (if (specifierp value)
	(setq value (specifier-instance value domain default no-fallback)))
    value))

(defun face-property-matching-instance (face property matchspec
					     &optional domain default
					     no-fallback)
  "Return the instance of FACE's PROPERTY matching MATCHSPEC in DOMAIN.
Currently the only useful value for MATCHSPEC is a charset, when used
in conjunction with the face's font; this allows you to retrieve a
font that can be used to display a particular charset, rather than just
any font.

Other than MATCHSPEC, this function is identical to `face-property-instance'.
See also `specifier-matching-instance' for a fuller description of the
matching process."

  (setq face (get-face face))
  (let ((value (get face property)))
    (if (specifierp value)
	(setq value (specifier-matching-instance value matchspec domain
						 default no-fallback)))
    value))

(defun set-face-property (face property value &optional locale tag-set
			       how-to-add)
  "Change a property of FACE.

NOTE: If you want to remove a property from a face, use `remove-face-property'
  rather than attempting to set a value of nil for the property.

For built-in properties, the actual value of the property is a
  specifier and you cannot change this; but you can change the
  specifications within the specifier, and that is what this function
  will do.  For user-defined properties, you can use this function
  to either change the actual value of the property or, if this value
  is a specifier, change the specifications within it.

If PROPERTY is a built-in property, the specifications to be added to
  this property can be supplied in many different ways:

  -- If VALUE is a simple instantiator (e.g. a string naming a font or
     color) or a list of instantiators, then the instantiator(s) will
     be added as a specification of the property for the given LOCALE
     (which defaults to 'global if omitted).
  -- If VALUE is a list of specifications (each of which is a cons of
     a locale and a list of instantiators), then LOCALE must be nil
     (it does not make sense to explicitly specify a locale in this
     case), and specifications will be added as given.
  -- If VALUE is a specifier (as would be returned by `face-property'
     if no LOCALE argument is given), then some or all of the
     specifications in the specifier will be added to the property.
     In this case, the function is really equivalent to
     `copy-specifier' and LOCALE has the same semantics (if it is
     a particular locale, the specification for the locale will be
     copied; if a locale type, specifications for all locales of
     that type will be copied; if nil or 'all, then all
     specifications will be copied).

HOW-TO-ADD should be either nil or one of the symbols 'prepend,
  'append, 'remove-tag-set-prepend, 'remove-tag-set-append, 'remove-locale,
  'remove-locale-type, or 'remove-all.  See `copy-specifier' and
  `add-spec-to-specifier' for a description of what each of
  these means.  Most of the time, you do not need to worry about
  this argument; the default behavior usually is fine.

In general, it is OK to pass an instance object (e.g. as returned
  by `face-property-instance') as an instantiator in place of
  an actual instantiator.  In such a case, the instantiator used
  to create that instance object will be used (for example, if
  you set a font-instance object as the value of the 'font
  property, then the font name used to create that object will
  be used instead).  If some cases, however, doing this
  conversion does not make sense, and this will be noted in
  the documentation for particular types of instance objects.

If PROPERTY is not a built-in property, then this function will
  simply set its value if LOCALE is nil.  However, if LOCALE is
  given, then this function will attempt to add VALUE as the
  instantiator for the given LOCALE, using `add-spec-to-specifier'.
  If the value of the property is not a specifier, it will
  automatically be converted into a 'generic specifier.


The following symbols have predefined meanings:

 foreground         The foreground color of the face.
                    For valid instantiators, see `color-specifier-p'.

 background         The background color of the face.
                    For valid instantiators, see `color-specifier-p'.

 font               The font used to display text covered by this face.
                    For valid instantiators, see `font-specifier-p'.

 display-table      The display table of the face.
                    This should be a vector of 256 elements.

 background-pixmap  The pixmap displayed in the background of the face.
                    Only used by faces on X devices.
                    For valid instantiators, see `image-specifier-p'.

 underline          Underline all text covered by this face.
                    For valid instantiators, see `face-boolean-specifier-p'.

 strikethru         Draw a line through all text covered by this face.
                    For valid instantiators, see `face-boolean-specifier-p'.

 highlight          Highlight all text covered by this face.
                    Only used by faces on TTY devices.
                    For valid instantiators, see `face-boolean-specifier-p'.

 dim                Dim all text covered by this face.
                    For valid instantiators, see `face-boolean-specifier-p'.

 blinking           Blink all text covered by this face.
                    Only used by faces on TTY devices.
                    For valid instantiators, see `face-boolean-specifier-p'.

 reverse            Reverse the foreground and background colors.
                    Only used by faces on TTY devices.
                    For valid instantiators, see `face-boolean-specifier-p'.

 doc-string         Description of what the face's normal use is.
                    NOTE: This is not a specifier, unlike all
                    the other built-in properties, and cannot
                    contain locale-specific values."

  (setq face (get-face face))
  (if (memq property built-in-face-specifiers)
      (set-specifier (get face property) value locale tag-set how-to-add)

    ;; This section adds user defined properties.
    (if (not locale)
	(put face property value)
      (convert-face-property-into-specifier face property)
      (add-spec-to-specifier (get face property) value locale tag-set
			     how-to-add)))
  value)

(defun remove-face-property (face property &optional locale tag-set exact-p)
  "Remove a property from FACE.
For built-in properties, this is analogous to `remove-specifier'.
See `remove-specifier' for the meaning of the LOCALE, TAG-SET, and EXACT-P
arguments."
  (or locale (setq locale 'all))
  (if (memq property built-in-face-specifiers)
      (remove-specifier (face-property face property) locale tag-set exact-p)
    (if (eq locale 'all)
	(remprop (get-face face) property)
      (convert-face-property-into-specifier face property)
      (remove-specifier (face-property face property) locale tag-set
			exact-p))))

(defun reset-face (face &optional locale tag-set exact-p)
  "Clear all existing built-in specifications from FACE.
This makes FACE inherit all its display properties from 'default.
WARNING: Be absolutely sure you want to do this!!!  It is a dangerous
operation and is not undoable.

The arguments LOCALE, TAG-SET and EXACT-P are the same as for
`remove-specifier'."
  (mapc (lambda (x)
	  (remove-specifier (face-property face x) locale tag-set exact-p))
	built-in-face-specifiers)
  nil)

(defun set-face-parent (face parent &optional locale tag-set how-to-add)
  "Set the parent of FACE to PARENT, for all properties.
This makes all properties of FACE inherit from PARENT."
  (setq parent (get-face parent))
  (mapcar (lambda (x)
	    (set-face-property face x (vector parent) locale tag-set
			       how-to-add))
	  (delq 'display-table
		(delq 'background-pixmap
		      (copy-sequence built-in-face-specifiers))))
  (set-face-background-pixmap face (vector 'inherit ':face parent)
			      locale tag-set how-to-add)
  nil)

(defun face-doc-string (face)
  "Return the documentation string for FACE."
  (face-property face 'doc-string))

(defun set-face-doc-string (face doc-string)
  "Change the documentation string of FACE to DOC-STRING."
  (interactive (face-interactive "doc-string"))
  (set-face-property face 'doc-string doc-string))

(defun face-font-name (face &optional domain charset)
  "Return the font name of FACE in DOMAIN, or nil if it is unspecified.
DOMAIN is as in `face-font-instance'."
  (let ((f (face-font-instance face domain charset)))
    (and f (font-instance-name f))))

(defun face-font (face &optional locale tag-set exact-p)
  "Return the font of FACE in LOCALE, or nil if it is unspecified.

FACE may be either a face object or a symbol representing a face.

LOCALE may be a locale (the instantiators for that particular locale
  will be returned), a locale type (the specifications for all locales
  of that type will be returned), 'all (all specifications will be
  returned), or nil (the actual specifier object will be returned).

See `face-property' for more information."
  (face-property face 'font locale tag-set exact-p))

(defun face-font-instance (face &optional domain charset)
  "Return the instance of FACE's font in DOMAIN.

FACE may be either a face object or a symbol representing a face.

Normally DOMAIN will be a window or nil (meaning the selected window),
  and an instance object describing how the font appears in that
  particular window and buffer will be returned.

See `face-property-instance' for more information."
  (if charset
      (face-property-matching-instance face 'font charset domain)
    (face-property-instance face 'font domain)))

(defun set-face-font (face font &optional locale tag-set how-to-add)
  "Change the font of FACE to FONT in LOCALE.

FACE may be either a face object or a symbol representing a face.

FONT should be an instantiator (see `font-specifier-p'), a list of
  instantiators, an alist of specifications (each mapping a
  locale to an instantiator list), or a font specifier object.

If FONT is an alist, LOCALE must be omitted.  If FONT is a
  specifier object, LOCALE can be a locale, a locale type, 'all,
  or nil; see `copy-specifier' for its semantics.  Otherwise LOCALE
  specifies the locale under which the specified instantiator(s)
  will be added, and defaults to 'global.

See `set-face-property' for more information."
  (interactive (face-interactive "font"))
  (set-face-property face 'font font locale tag-set how-to-add))

(defun face-foreground (face &optional locale tag-set exact-p)
  "Return the foreground of FACE in LOCALE, or nil if it is unspecified.

FACE may be either a face object or a symbol representing a face.

LOCALE may be a locale (the instantiators for that particular locale
  will be returned), a locale type (the specifications for all locales
  of that type will be returned), 'all (all specifications will be
  returned), or nil (the actual specifier object will be returned).

See `face-property' for more information."
  (face-property face 'foreground locale tag-set exact-p))

(defun face-foreground-instance (face &optional domain default no-fallback)
  "Return the instance of FACE's foreground in DOMAIN.

FACE may be either a face object or a symbol representing a face.

Normally DOMAIN will be a window or nil (meaning the selected window),
  and an instance object describing how the foreground appears in that
  particular window and buffer will be returned.

See `face-property-instance' for more information."
  (face-property-instance face 'foreground domain default no-fallback))

(defun face-foreground-name (face &optional domain default no-fallback)
  "Return the name of FACE's foreground color in DOMAIN.

FACE may be either a face object or a symbol representing a face.

Normally DOMAIN will be a window or nil (meaning the selected window),
  and an instance object describing how the background appears in that
  particular window and buffer will be returned.

See `face-property-instance' for more information."
  (color-instance-name (face-foreground-instance
			face domain default no-fallback)))

(defun set-face-foreground (face color &optional locale tag-set how-to-add)
  "Change the foreground color of FACE to COLOR in LOCALE.

FACE may be either a face object or a symbol representing a face.

COLOR should be an instantiator (see `color-specifier-p'), a list of
  instantiators, an alist of specifications (each mapping a locale to
  an instantiator list), or a color specifier object.

If COLOR is an alist, LOCALE must be omitted.  If COLOR is a
  specifier object, LOCALE can be a locale, a locale type, 'all,
  or nil; see `copy-specifier' for its semantics.  Otherwise LOCALE
  specifies the locale under which the specified instantiator(s)
  will be added, and defaults to 'global.

See `set-face-property' for more information."
  (interactive (face-interactive "foreground"))
  (set-face-property face 'foreground color locale tag-set how-to-add))

(defun face-background (face &optional locale tag-set exact-p)
  "Return the background color of FACE in LOCALE, or nil if it is unspecified.

FACE may be either a face object or a symbol representing a face.

LOCALE may be a locale (the instantiators for that particular locale
  will be returned), a locale type (the specifications for all locales
  of that type will be returned), 'all (all specifications will be
  returned), or nil (the actual specifier object will be returned).

See `face-property' for more information."
  (face-property face 'background locale tag-set exact-p))

(defun face-background-instance (face &optional domain default no-fallback)
  "Return the instance of FACE's background in DOMAIN.

FACE may be either a face object or a symbol representing a face.

Normally DOMAIN will be a window or nil (meaning the selected window),
  and an instance object describing how the background appears in that
  particular window and buffer will be returned.

See `face-property-instance' for more information."
  (face-property-instance face 'background domain default no-fallback))

(defun face-background-name (face &optional domain default no-fallback)
  "Return the name of FACE's background color in DOMAIN.

FACE may be either a face object or a symbol representing a face.

Normally DOMAIN will be a window or nil (meaning the selected window),
  and an instance object describing how the background appears in that
  particular window and buffer will be returned.

See `face-property-instance' for more information."
  (color-instance-name (face-background-instance
			face domain default no-fallback)))

(defun set-face-background (face color &optional locale tag-set how-to-add)
  "Change the background color of FACE to COLOR in LOCALE.

FACE may be either a face object or a symbol representing a face.

COLOR should be an instantiator (see `color-specifier-p'), a list of
  instantiators, an alist of specifications (each mapping a locale to
  an instantiator list), or a color specifier object.

If COLOR is an alist, LOCALE must be omitted.  If COLOR is a
  specifier object, LOCALE can be a locale, a locale type, 'all,
  or nil; see `copy-specifier' for its semantics.  Otherwise LOCALE
  specifies the locale under which the specified instantiator(s)
  will be added, and defaults to 'global.

See `set-face-property' for more information."
  (interactive (face-interactive "background"))
  (set-face-property face 'background color locale tag-set how-to-add))

(defun face-background-pixmap (face &optional locale tag-set exact-p)
  "Return the background pixmap of FACE in LOCALE, or nil if it is unspecified.
This property is only used on window system devices.

FACE may be either a face object or a symbol representing a face.

LOCALE may be a locale (the instantiators for that particular locale
  will be returned), a locale type (the specifications for all locales
  of that type will be returned), 'all (all specifications will be
  returned), or nil (the actual specifier object will be returned).

See `face-property' for more information."
  (face-property face 'background-pixmap locale tag-set exact-p))

(defun face-background-pixmap-instance (face &optional domain default
					     no-fallback)
  "Return the instance of FACE's background pixmap in DOMAIN.

FACE may be either a face object or a symbol representing a face.

Normally DOMAIN will be a window or nil (meaning the selected window),
  and an instance object describing how the background appears in that
  particular window and buffer will be returned.

See `face-property-instance' for more information."
  (face-property-instance face 'background-pixmap domain default no-fallback))

(defun set-face-background-pixmap (face pixmap &optional locale tag-set
					how-to-add)
  "Change the background pixmap of FACE to PIXMAP in LOCALE.
This property is only used on window system devices.

FACE may be either a face object or a symbol representing a face.

PIXMAP should be an instantiator (see `image-specifier-p'), a list
  of instantiators, an alist of specifications (each mapping a locale
  to an instantiator list), or an image specifier object.

If PIXMAP is an alist, LOCALE must be omitted.  If PIXMAP is a
  specifier object, LOCALE can be a locale, a locale type, 'all,
  or nil; see `copy-specifier' for its semantics.  Otherwise LOCALE
  specifies the locale under which the specified instantiator(s)
  will be added, and defaults to 'global.

See `set-face-property' for more information."
  (interactive (face-interactive "background-pixmap"))
  (set-face-property face 'background-pixmap pixmap locale tag-set how-to-add))

(defun face-display-table (face &optional locale tag-set exact-p)
  "Return the display table of FACE in LOCALE.

A vector (as returned by `make-display-table') will be returned.

LOCALE may be a locale (the instantiators for that particular locale
  will be returned), a locale type (the specifications for all locales
  of that type will be returned), 'all (all specifications will be
  returned), or nil (the actual specifier object will be returned).

See `face-property' for more information."
  (face-property face 'display-table locale tag-set exact-p))

(defun face-display-table-instance (face &optional domain default no-fallback)
  "Return the instance of FACE's display table in DOMAIN.
A vector (as returned by `make-display-table') will be returned.

See `face-property-instance' for the semantics of the DOMAIN argument."
  (face-property-instance face 'display-table domain default no-fallback))

(defun set-face-display-table (face display-table &optional locale tag-set
				    how-to-add)
  "Change the display table of FACE to DISPLAY-TABLE in LOCALE.
DISPLAY-TABLE should be a vector as returned by `make-display-table'.

See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
  HOW-TO-ADD arguments."
  (interactive (face-interactive "display-table"))
  (set-face-property face 'display-table display-table locale tag-set
		     how-to-add))

;; The following accessors and mutators are, IMHO, good
;; implementation.  Cf. with `make-face-bold'.

(defun face-underline-p (face &optional domain default no-fallback)
  "Return t if FACE is underlined in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (face-property-instance face 'underline domain default no-fallback))

(defun set-face-underline-p (face underline-p &optional locale tag-set
				  how-to-add)
  "Change the underline property of FACE to UNDERLINE-P.
UNDERLINE-P is normally a face-boolean instantiator; see
 `face-boolean-specifier-p'.
See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 HOW-TO-ADD arguments."
  (interactive (face-interactive "underline-p" "underlined"))
  (set-face-property face 'underline underline-p locale tag-set how-to-add))

(defun face-strikethru-p (face &optional domain default no-fallback)
  "Return t if FACE is strikethru-d (i.e. struck through) in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (face-property-instance face 'strikethru domain default no-fallback))

(defun set-face-strikethru-p (face strikethru-p &optional locale tag-set
				  how-to-add)
  "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE.
STRIKETHRU-P is normally a face-boolean instantiator; see
 `face-boolean-specifier-p'.
See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 HOW-TO-ADD arguments."
  (interactive (face-interactive "strikethru-p" "strikethru-d"))
  (set-face-property face 'strikethru strikethru-p locale tag-set how-to-add))

(defun face-highlight-p (face &optional domain default no-fallback)
  "Return t if FACE is highlighted in DOMAIN (TTY domains only).
See `face-property-instance' for the semantics of the DOMAIN argument."
  (face-property-instance face 'highlight domain default no-fallback))

(defun set-face-highlight-p (face highlight-p &optional locale tag-set
				  how-to-add)
  "Change whether FACE is highlighted in LOCALE (TTY locales only).
HIGHLIGHT-P is normally a face-boolean instantiator; see
 `face-boolean-specifier-p'.
See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 HOW-TO-ADD arguments."
  (interactive (face-interactive "highlight-p" "highlighted"))
  (set-face-property face 'highlight highlight-p locale tag-set how-to-add))

(defun face-dim-p (face &optional domain default no-fallback)
  "Return t if FACE is dimmed in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (face-property-instance face 'dim domain default no-fallback))

(defun set-face-dim-p (face dim-p &optional locale tag-set how-to-add)
  "Change whether FACE is dimmed in LOCALE.
DIM-P is normally a face-boolean instantiator; see
 `face-boolean-specifier-p'.
See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 HOW-TO-ADD arguments."
  (interactive (face-interactive "dim-p" "dimmed"))
  (set-face-property face 'dim dim-p locale tag-set how-to-add))

(defun face-blinking-p (face &optional domain default no-fallback)
  "Return t if FACE is blinking in DOMAIN (TTY domains only).
See `face-property-instance' for the semantics of the DOMAIN argument."
  (face-property-instance face 'blinking domain default no-fallback))

(defun set-face-blinking-p (face blinking-p &optional locale tag-set
				 how-to-add)
  "Change whether FACE is blinking in LOCALE (TTY locales only).
BLINKING-P is normally a face-boolean instantiator; see
 `face-boolean-specifier-p'.
See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 HOW-TO-ADD arguments."
  (interactive (face-interactive "blinking-p" "blinking"))
  (set-face-property face 'blinking blinking-p locale tag-set how-to-add))

(defun face-reverse-p (face &optional domain default no-fallback)
  "Return t if FACE is reversed in DOMAIN (TTY domains only).
See `face-property-instance' for the semantics of the DOMAIN argument."
  (face-property-instance face 'reverse domain default no-fallback))

(defun set-face-reverse-p (face reverse-p &optional locale tag-set how-to-add)
  "Change whether FACE is reversed in LOCALE (TTY locales only).
REVERSE-P is normally a face-boolean instantiator; see
 `face-boolean-specifier-p'.
See `set-face-property' for the semantics of the LOCALE, TAG-SET, and
 HOW-TO-ADD arguments."
  (interactive (face-interactive "reverse-p" "reversed"))
  (set-face-property face 'reverse reverse-p locale tag-set how-to-add))


(defun face-property-equal (face1 face2 prop domain)
  (equal (face-property-instance face1 prop domain)
	 (face-property-instance face2 prop domain)))

(defun face-equal-loop (props face1 face2 domain)
  (while (and props
	      (face-property-equal face1 face2 (car props) domain))
    (setq props (cdr props)))
  (null props))

(defun face-equal (face1 face2 &optional domain)
  "Return t if FACE1 and FACE2 will display in the same way in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (if (null domain) (setq domain (selected-window)))
  (if (not (valid-specifier-domain-p domain))
      (error "Invalid specifier domain"))
  (let ((device (dfw-device domain))
	(common-props '(foreground background font display-table underline
				   dim))
	(win-props '(background-pixmap strikethru))
	(tty-props '(highlight blinking reverse)))

    ;; First check the properties which are used in common between the
    ;; x and tty devices.  Then, check those properties specific to
    ;; the particular device type.
    (and (face-equal-loop common-props face1 face2 domain)
	 (cond ((eq 'tty (device-type device))
		(face-equal-loop tty-props face1 face2 domain))
	       ((or (eq 'x (device-type device))
		    (eq 'mswindows (device-type device)))
		(face-equal-loop win-props face1 face2 domain))
	       (t t)))))

(defun face-differs-from-default-p (face &optional domain)
  "Return t if FACE will display differently from the default face in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (not (face-equal face 'default domain)))

; moved from x-faces.el
(defun try-font-name (name &optional device)
  ;; yes, name really should be here twice.
  (and name (make-font-instance name device t) name))


;; This function is a terrible, disgusting hack!!!!  Need to
;; separate out the font elements as separate face properties!

;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
;; WE DEMAND LEXICAL SCOPING!!!
(defun frob-face-property (face property func &optional locale tags)
  "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE.
This function is ugly and messy and is primarily used as an internal
helper function for `make-face-bold' et al., so you probably don't
want to use it or read the rest of the documentation.  But if you do ...

FUNC should be a function of two arguments (an instance and a device)
that returns a modified name that is valid for the given device.
If LOCALE specifies a valid domain (i.e. a window, frame, or device),
this function instantiates the specifier over that domain, applies FUNC
to the resulting instance, and adds the result back as an instantiator
for that locale.  Otherwise, LOCALE should be a locale, locale type, or
'all (defaults to 'all if omitted).  For each specification thusly
included: if the locale given is a valid domain, FUNC will be
iterated over all valid instantiators for the device of the domain
until a non-nil result is found (if there is no such result, the
first valid instantiator is used), and that result substituted for
the specification; otherwise, the process just outlined is
iterated over each existing device and the concatenated results
substituted for the specification."
  (let ((sp (face-property face property))
	temp-sp)
    (if (valid-specifier-domain-p locale)
	;; this is easy.
	(let* ((inst (face-property-instance face property locale))
	       (name (and inst (funcall func inst (dfw-device locale)))))
	  (when name
	    (add-spec-to-specifier sp name locale tags)))
      ;; otherwise, map over all specifications ...
      ;; but first, some further kludging:
      ;; (1) if we're frobbing the global property, make sure
      ;;     that something is there (copy from the default face,
      ;;     if necessary).  Otherwise, something like
      ;;     (make-face-larger 'modeline)
      ;;     won't do anything at all if the modeline simply
      ;;     inherits its font from 'default.
      ;; (2) if we're frobbing a particular locale, nothing would
      ;;     happen if that locale has no instantiators.  So signal
      ;;     an error to indicate this.

      
      (setq temp-sp (copy-specifier sp))
      (if (and (or (eq locale 'global) (eq locale 'all) (not locale))
	       (not (face-property face property 'global)))
	  (copy-specifier (face-property 'default property)
			  temp-sp 'global))	    
      (if (and (valid-specifier-locale-p locale)
	       (not (specifier-specs temp-sp locale)))
	  (error "Property must have a specification in locale %S" locale))
      (map-specifier
       temp-sp
       (lambda (sp-arg locale inst-list func)
	 (let* ((device (dfw-device locale))
		;; if a device can be derived from the locale,
		;; call frob-face-property-1 for that device.
		;; Otherwise map frob-face-property-1 over each device.
		(result
		 (if device
		     (list (frob-face-property-1 sp-arg device inst-list func))
		   (mapcar (lambda (device)
			     (frob-face-property-1 sp-arg device
						   inst-list func))
			   (device-list))))
		new-result)
	   ;; remove duplicates and nils from the obtained list of
	   ;; instantiators. Also add tags amd remove 'defaults'.
	   (mapcar (lambda (arg)
		     (when arg
		       (if (not (consp arg))
			   (setq arg (cons tags arg))
			 (setcar arg (append tags (delete 'default
							  (car arg))))))
		     (when (and arg (not (member arg new-result)))		       
		       (setq new-result (cons arg new-result))))
		   result)
	   ;; add back in.
	   (add-spec-list-to-specifier sp (list (cons locale new-result)))
	   ;; tell map-specifier to keep going.
	   nil))
       locale
       func))))

(defun frob-face-property-1 (sp device inst-list func)
  (let
      (first-valid result)
    (while (and inst-list (not result))
      (let* ((inst-pair (car inst-list))
	     (tag-set (car inst-pair))
	     (sp-inst (specifier-instance-from-inst-list
		       sp device (list inst-pair))))
	(if sp-inst
	    (progn
	      (if (not first-valid)
		  (setq first-valid inst-pair))
	      (setq result (funcall func sp-inst device))
              (if result
                  (setq result (cons tag-set result))))))
      (setq inst-list (cdr inst-list)))
    (or result first-valid)))

(defun frob-face-font-2 (face locale tags unfrobbed-face frobbed-face
			      tty-thunk x-thunk standard-face-mapping)
  ;; another kludge to make things more intuitive.  If we're
  ;; inheriting from a standard face in this locale, frob the
  ;; inheritance as appropriate.  Else, if, after the first X frobbing
  ;; pass, the face hasn't changed and still looks like the standard
  ;; unfrobbed face (e.g. 'default), make it inherit from the standard
  ;; frobbed face (e.g. 'bold).  Regardless of things, do the TTY
  ;; frobbing.

  ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale,
  ;; but is a "locale, locale-type, or nil for all".  So ...  do our extra
  ;; frobbing only if it's actually a locale; or for nil, do the frobbing
  ;; on 'global.  This specifier stuff needs some rethinking.
  (let* ((the-locale (cond ((null locale) 'global)
			   ((valid-specifier-locale-p locale) locale)
			   (t nil)))
	 (specs (and the-locale (face-font face the-locale nil t)))
	 (change-it (and specs (cdr (assoc specs standard-face-mapping)))))
    (if (and change-it
	     (not (memq (face-name (find-face face))
			'(default bold italic bold-italic))))
	(progn
	  (or (equal change-it t)
	      (set-face-property face 'font change-it the-locale))
	  (funcall tty-thunk))
      (let* ((domain (cond ((null the-locale) nil)
			   ((valid-specifier-domain-p the-locale) the-locale)
			   ;; OK, this next one is truly a kludge, but
			   ;; it results in more intuitive behavior most
			   ;; of the time. (really!)
			   ((or (eq the-locale 'global) (eq the-locale 'all))
			    (selected-device))
			   (t nil)))
	     (inst (and domain (face-property-instance face 'font domain))))
	(funcall tty-thunk)
	(funcall x-thunk)
	;; If it's reasonable to do the inherit-from-standard-face trick,
	;; and it's called for, then do it now.
	(or (null domain)
	    (not (equal inst (face-property-instance face 'font domain)))
	    ;; don't do it for standard faces, or you'll get inheritance loops.
	    ;; #### This makes XEmacs seg fault! fix this bug.
	    (memq (face-name (find-face face))
		  '(default bold italic bold-italic))
	    (not (equal (face-property-instance face 'font domain)
			(face-property-instance unfrobbed-face 'font domain)))
	    (set-face-property face 'font (vector frobbed-face)
			       the-locale tags))))))

(defun make-face-bold (face &optional locale tags)
  "Make FACE bold in LOCALE, if possible.
This will attempt to make the font bold for X locales and will set the
highlight flag for TTY locales.

If LOCALE is nil, omitted, or `all', this will attempt to frob all
font specifications for FACE to make them appear bold.  Similarly, if
LOCALE is a locale type, this frobs all font specifications for locales
of that type.  If LOCALE is a particular locale, what happens depends on
what sort of locale is given.  If you gave a device, frame, or window,
then it's always possible to determine what the font actually will be,
so this is determined and the resulting font is frobbed and added back as a
specification for this locale.  If LOCALE is a buffer, however, you can't
determine what the font will actually be unless there's actually a
specification given for that particular buffer (otherwise, it depends
on what window and frame the buffer appears in, and might not even be
well-defined if the buffer appears multiple times in different places);
therefore you will get an error unless there's a specification for the
buffer.

Finally, in some cases (specifically, when LOCALE is not a locale type),
if the frobbing didn't actually make the font look any different
\(this happens, for example, if your font specification is already bold
or has no bold equivalent), and currently looks like the font of the
'default face, it is set to inherit from the 'bold face.  This is kludgy
but it makes `make-face-bold' have more intuitive behavior in many
circumstances."
  (interactive (list (read-face-name "Make which face bold: ")))
  (frob-face-font-2
   face locale tags 'default 'bold
   (lambda ()
     ;; handle TTY specific entries
     (when (featurep 'tty)
       (set-face-highlight-p face t locale (cons 'tty tags))))
   (lambda ()
     ;; handle X specific entries
     (when (featurep 'x)
       (frob-face-property face 'font 'x-make-font-bold locale tags))
     (when (featurep 'mswindows)
       (frob-face-property face 'font 'mswindows-make-font-bold locale tags))
     )
   '(([default] . [bold])
     ([bold] . t)
     ([italic] . [bold-italic])
     ([bold-italic] . t))))

(defun make-face-italic (face &optional locale tags)
  "Make FACE italic in LOCALE, if possible.
This will attempt to make the font italic for X locales and will set
the underline flag for TTY locales.
See `make-face-bold' for the semantics of the LOCALE argument and
for more specifics on exactly how this function works."
  (interactive (list (read-face-name "Make which face italic: ")))
  (frob-face-font-2
   face locale tags 'default 'italic
   (lambda ()
     ;; handle TTY specific entries
     (when (featurep 'tty)
       (set-face-underline-p face t locale (cons 'tty tags))))
   (lambda ()
     ;; handle X specific entries
     (when (featurep 'x)
       (frob-face-property face 'font 'x-make-font-italic locale tags))
     (when (featurep 'mswindows)
       (frob-face-property face 'font 'mswindows-make-font-italic locale tags))
     )
   '(([default] . [italic])
     ([bold] . [bold-italic])
     ([italic] . t)
     ([bold-italic] . t))))

(defun make-face-bold-italic (face &optional locale tags)
  "Make FACE bold and italic in LOCALE, if possible.
This will attempt to make the font bold-italic for X locales and will
set the highlight and underline flags for TTY locales.
See `make-face-bold' for the semantics of the LOCALE argument and
for more specifics on exactly how this function works."
  (interactive (list (read-face-name "Make which face bold-italic: ")))
  (frob-face-font-2
   face locale tags 'default 'bold-italic
   (lambda ()
     ;; handle TTY specific entries
     (when (featurep 'tty)
       (set-face-highlight-p face t locale (cons 'tty tags))
       (set-face-underline-p face t locale (cons 'tty tags))))
   (lambda ()
     ;; handle X specific entries
     (when (featurep 'x)
       (frob-face-property face 'font 'x-make-font-bold-italic locale tags))
     (when (featurep 'mswindows)
       (frob-face-property face 'font 'mswindows-make-font-bold-italic locale tags))
     )
   '(([default] . [italic])
     ([bold] . [bold-italic])
     ([italic] . [bold-italic])
     ([bold-italic] . t))))

(defun make-face-unbold (face &optional locale tags)
  "Make FACE non-bold in LOCALE, if possible.
This will attempt to make the font non-bold for X locales and will
unset the highlight flag for TTY locales.
See `make-face-bold' for the semantics of the LOCALE argument and
for more specifics on exactly how this function works."
  (interactive (list (read-face-name "Make which face non-bold: ")))
  (frob-face-font-2
   face locale tags 'bold 'default
   (lambda ()
     ;; handle TTY specific entries
     (when (featurep 'tty)
       (set-face-highlight-p face nil locale (cons 'tty tags))))
   (lambda ()
     ;; handle X specific entries
     (when (featurep 'x)
       (frob-face-property face 'font 'x-make-font-unbold locale tags))
     (when (featurep 'mswindows)
       (frob-face-property face 'font 'mswindows-make-font-unbold locale tags))
     )
   '(([default] . t)
     ([bold] . [default])
     ([italic] . t)
     ([bold-italic] . [italic]))))

(defun make-face-unitalic (face &optional locale tags)
  "Make FACE non-italic in LOCALE, if possible.
This will attempt to make the font non-italic for X locales and will
unset the underline flag for TTY locales.
See `make-face-bold' for the semantics of the LOCALE argument and
for more specifics on exactly how this function works."
  (interactive (list (read-face-name "Make which face non-italic: ")))
  (frob-face-font-2
   face locale tags 'italic 'default
   (lambda ()
     ;; handle TTY specific entries
     (when (featurep 'tty)
       (set-face-underline-p face nil locale (cons 'tty tags))))
   (lambda ()
     ;; handle X specific entries
     (when (featurep 'x)
       (frob-face-property face 'font 'x-make-font-unitalic locale tags))
     (when (featurep 'mswindows)
       (frob-face-property face 'font 'mswindows-make-font-unitalic locale tags))
     )
   '(([default] . t)
     ([bold] . t)
     ([italic] . [default])
     ([bold-italic] . [bold]))))


;; Why do the following two functions lose so badly in so many
;; circumstances?

(defun make-face-smaller (face &optional locale)
  "Make the font of FACE be smaller, if possible.
LOCALE works as in `make-face-bold' et al., but the ``inheriting-
from-the-bold-face'' operations described there are not done
because they don't make sense in this context."
  (interactive (list (read-face-name "Shrink which face: ")))
  ;; handle X specific entries
  (when (featurep 'x)
    (frob-face-property face 'font 'x-find-smaller-font locale))
  (when (featurep 'mswindows)
    (frob-face-property face 'font 'mswindows-find-smaller-font locale)))

(defun make-face-larger (face &optional locale)
  "Make the font of FACE be larger, if possible.
See `make-face-smaller' for the semantics of the LOCALE argument."
  (interactive (list (read-face-name "Enlarge which face: ")))
  ;; handle X specific entries
  (when (featurep 'x)
    (frob-face-property face 'font 'x-find-larger-font locale))
  (when (featurep 'mswindows)
    (frob-face-property face 'font 'mswindows-find-larger-font locale)))

(defun invert-face (face &optional locale)
  "Swap the foreground and background colors of the face."
  (interactive (list (read-face-name "Invert face: ")))
  (if (valid-specifier-domain-p locale)
      (let ((foreface (face-foreground-instance face locale)))
	(set-face-foreground face (face-background-instance face locale)
			     locale)
	(set-face-background face foreface locale))
    (let ((forespec (copy-specifier (face-foreground face) nil locale)))
      (copy-specifier (face-background face) (face-foreground face) locale)
      (copy-specifier forespec (face-background face) locale))))


;;; Convenience functions

(defun face-ascent (face &optional domain charset)
  "Return the ascent of FACE in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (font-ascent (face-font face) domain charset))

(defun face-descent (face &optional domain charset)
  "Return the descent of FACE in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (font-descent (face-font face) domain charset))

(defun face-width (face &optional domain charset)
  "Return the width of FACE in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (font-width (face-font face) domain charset))

(defun face-height (face &optional domain charset)
  "Return the height of FACE in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (+ (face-ascent face domain charset) (face-descent face domain charset)))

(defun face-proportional-p (face &optional domain charset)
  "Return t if FACE is proportional in DOMAIN.
See `face-property-instance' for the semantics of the DOMAIN argument."
  (font-proportional-p (face-font face) domain charset))


;; Functions that used to be in cus-face.el, but logically go here.

(defcustom frame-background-mode nil
  "*The brightness of the background.
Set this to the symbol dark if your background color is dark, light if
your background is light, or nil (default) if you want Emacs to
examine the brightness for you."
  :group 'faces
  :type '(choice (choice-item dark)
		 (choice-item light)
		 (choice-item :tag "Auto" nil)))

;; The old variable that many people still have in .emacs files.
(define-obsolete-variable-alias 'custom-background-mode
  'frame-background-mode)

(defun get-frame-background-mode (frame)
  "Detect background mode for FRAME."
  (let* ((color-instance (face-background-instance 'default frame))
	 (mode (condition-case nil
		   (if (< (apply '+ (color-instance-rgb-components
				     color-instance)) 65536)
		       'dark 'light)
		 ;; Here, we get an error on a TTY.  As we don't have
		 ;; a good way of detecting whether a TTY is light or
		 ;; dark, we'll guess it's dark.
		 (error 'dark))))
    (set-frame-property frame 'background-mode mode)
    mode))

(defun extract-custom-frame-properties (frame)
  "Return a plist with the frame properties of FRAME used by custom."
  (list 'type (or (frame-property frame 'display-type)
		  (device-type (frame-device frame)))
	'class (device-class (frame-device frame))
	'background (or frame-background-mode
			(frame-property frame 'background-mode)
			(get-frame-background-mode frame))))

(defcustom init-face-from-resources t
  "If non nil, attempt to initialize faces from the resource database."
  :group 'faces
  :type 'boolean)

;; Old name, used by custom.  Also, FSFmacs name.
(defvaralias 'initialize-face-resources 'init-face-from-resources)

;; Make sure all custom setting are added with this tag so we can
;; identify-them
(define-specifier-tag 'custom)

(defun face-spec-set (face spec &optional frame tags)
  "Set FACE's face attributes according to the first matching entry in SPEC.
If optional FRAME is non-nil, set it for that frame only.
If it is nil, then apply SPEC to each frame individually.
See `defface' for information about SPEC."
  (if frame
      (progn
	(reset-face face frame tags)
	(face-display-set face spec frame tags)
	(init-face-from-resources face frame))
    (let ((frames (relevant-custom-frames)))
      (reset-face face nil tags)
      ;; This should not be needed. We only remove our own specifiers
      ;; (if (and (eq 'default face) (featurep 'x))
      ;;	  (x-init-global-faces))
      (face-display-set face spec nil tags)
      (while frames
	(face-display-set face spec (car frames) tags)
	(pop frames))
      (init-face-from-resources face))))

(defun face-display-set (face spec &optional frame tags)
  "Set FACE to the attributes to the first matching entry in SPEC.
Iff optional FRAME is non-nil, set it for that frame only.
See `defface' for information about SPEC."
  (while spec
    (let ((display (caar spec))
	  (atts (cadar spec)))
      (pop spec)
      (when (face-spec-set-match-display display frame)
	;; Avoid creating frame local duplicates of the global face.
	(unless (and frame (eq display (get face 'custom-face-display)))
	  (apply 'face-custom-attributes-set face frame tags atts))
	(unless frame
	  (put face 'custom-face-display display))
	(setq spec nil)))))

(defvar default-custom-frame-properties nil
  "The frame properties used for the global faces.
Frames not matching these propertiess should have frame local faces.
The value should be nil, if uninitialized, or a plist otherwise.
See `defface' for a list of valid keys and values for the plist.")

(defun get-custom-frame-properties (&optional frame)
  "Return a plist with the frame properties of FRAME used by custom.
If FRAME is nil, return the default frame properties."
  (cond (frame
	 ;; Try to get from cache.
	 (let ((cache (frame-property frame 'custom-properties)))
	   (unless cache
	     ;; Oh well, get it then.
	     (setq cache (extract-custom-frame-properties frame))
	     ;; and cache it...
	     (set-frame-property frame 'custom-properties cache))
	   cache))
	(default-custom-frame-properties)
	(t
	 (setq default-custom-frame-properties
	       (extract-custom-frame-properties (selected-frame))))))

(defun face-spec-update-all-matching (spec display plist)
  "Update all entries in the face spec that could match display to
have the entries from the new plist and return the new spec"
  (mapcar
   (lambda (e)
     (let ((entries (car e))
	   (options (cadr e))
	   (match t)
	   dplist
	   (new-options plist)
	   )
       (unless (eq display t)
	 (mapc (lambda (arg)
		 (setq dplist (plist-put dplist (car arg) (cadr arg))))
	       display))
       (unless (eq entries t)
	 (mapc (lambda (arg)
		 (setq match (and match (eq (cadr arg)
					    (plist-get
					      dplist (car arg)
					      (cadr arg))))))
	       entries))
       (if (not match)
	   e
	 (while new-options
	   (setq options
		 (plist-put options (car new-options) (cadr new-options)))
	   (setq new-options (cddr new-options)))
	 (list entries options))))
   (copy-sequence spec)))
       
		    

(defun face-spec-set-match-display (display &optional frame)
  "Return non-nil if DISPLAY matches FRAME.
DISPLAY is part of a spec such as can be used in `defface'.
If FRAME is nil or omitted, the selected frame is used."
  (if (eq display t)
      t
    (let* ((props (get-custom-frame-properties frame))
	   (type (plist-get props 'type))
	   (class (plist-get props 'class))
	   (background (plist-get props 'background))
	   (match t)
	   (entries display)
	   entry req options)
      (while (and entries match)
	(setq entry (car entries)
	      entries (cdr entries)
	      req (car entry)
	      options (cdr entry)
	      match (case req
		      (type       (memq type options))
		      (class      (memq class options))
		      (background (memq background options))
		      (t (warn "Unknown req `%S' with options `%S'"
			       req options)
			 nil))))
      match)))

(defun relevant-custom-frames ()
  "List of frames whose custom properties differ from the default."
  (let ((relevant nil)
	(default (get-custom-frame-properties))
	(frames (frame-list))
	frame)
    (while frames
      (setq frame (car frames)
	    frames (cdr frames))
      (unless (equal default (get-custom-frame-properties frame))
	(push frame relevant)))
    relevant))

(defun initialize-custom-faces (&optional frame)
  "Initialize all custom faces for FRAME.
If FRAME is nil or omitted, initialize them for all frames."
  (mapc (lambda (symbol)
	  (let ((spec (or (get symbol 'saved-face)
			  (get symbol 'face-defface-spec))))
	    (when spec
	      ;; No need to init-face-from-resources -- code in
	      ;; `init-frame-faces' does it already.
	      (face-display-set symbol spec frame))))
	(face-list)))

(defun custom-initialize-frame (frame)
  "Initialize frame-local custom faces for FRAME if necessary."
  (unless (equal (get-custom-frame-properties)
		 (get-custom-frame-properties frame))
    (initialize-custom-faces frame)))

(defun startup-initialize-custom-faces ()
  "Reset faces created by defface.  Only called at startup.
Don't use this function in your program."
  (when default-custom-frame-properties
    ;; Reset default value to the actual frame, not stream.
    (setq default-custom-frame-properties
	  (extract-custom-frame-properties (selected-frame)))
    ;; like initialize-custom-faces but removes property first.
    (mapc (lambda (symbol)
	    (let ((spec (or (get symbol 'saved-face)
			    (get symbol 'face-defface-spec))))
	      (when spec
		;; Reset faces created during auto-autoloads loading.
		(reset-face symbol)
		;; And set it according to the spec.
		(face-display-set symbol spec nil))))
	  (face-list))))


(defun make-empty-face (name &optional doc-string temporary)
  "Like `make-face', but doesn't query the resource database."
  (let ((init-face-from-resources nil))
    (make-face name doc-string temporary)))

(defun init-face-from-resources (face &optional locale)
  "Initialize FACE from the resource database.
If LOCALE is specified, it should be a frame, device, or 'global, and
the face will be resourced over that locale.  Otherwise, the face will
be resourced over all possible locales (i.e. all frames, all devices,
and 'global)."
  (cond ((null init-face-from-resources)
	 ;; Do nothing.
	 )
	((not locale)
	 ;; Global, set for all frames.
	 (progn
	   (init-face-from-resources face 'global)
	   (let ((devices (device-list)))
	     (while devices
	       (init-face-from-resources face (car devices))
	       (setq devices (cdr devices))))
	   (let ((frames (frame-list)))
	     (while frames
	       (init-face-from-resources face (car frames))
	       (setq frames (cdr frames))))))
	(t
	 ;; Specific.
	 (let ((devtype (cond ((devicep locale) (device-type locale))
			      ((framep locale) (frame-type locale))
			      (t nil))))
	   (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype))
		  (x-init-face-from-resources face locale))
		 ((or (not devtype) (eq 'tty devtype))
		  ;; Nothing to do for TTYs?
		  ))))))

(defun init-device-faces (device)
  ;; First, add any device-local face resources.
  (when init-face-from-resources
    (loop for face in (face-list) do
	  (init-face-from-resources face device))
    ;; Then do any device-specific initialization.
    (cond ((eq 'x (device-type device))
	   (x-init-device-faces device))
	  ((eq 'mswindows (device-type device))
	   (mswindows-init-device-faces device))
	  ;; Nothing to do for TTYs?
	  )
    (or (eq 'stream (device-type device))
	(init-other-random-faces device))))

(defun init-frame-faces (frame)
  (when init-face-from-resources
    ;; First, add any frame-local face resources.
    (loop for face in (face-list) do
	  (init-face-from-resources face frame))
    ;; Then do any frame-specific initialization.
    (cond ((eq 'x (frame-type frame))
	   (x-init-frame-faces frame))
	  ((eq 'mswindows (frame-type frame))
	   (mswindows-init-frame-faces frame))
	  ;; Is there anything which should be done for TTY's?
	  )))

;; #### This is somewhat X-specific, and is called when the first
;; X device is created (even if there were TTY devices created
;; beforehand).  The concept of resources has not been generalized
;; outside of X-specificness, so we have to live with this
;; breach of device-independence.

(defun init-global-faces ()
  ;; Look for global face resources.
  (loop for face in (face-list) do
	(init-face-from-resources face 'global))
  ;; Further X frobbing.
  (x-init-global-faces)
  ;; for bold and the like, make the global specification be bold etc.
  ;; if the user didn't already specify a value.  These will also be
  ;; frobbed further in init-other-random-faces.
  (unless (face-font 'bold 'global)
    (make-face-bold 'bold 'global))
  ;;
  (unless (face-font 'italic 'global)
    (make-face-italic 'italic 'global))
  ;;
  (unless (face-font 'bold-italic 'global)
    (make-face-bold-italic 'bold-italic 'global)
    (unless (face-font 'bold-italic 'global)
      (copy-face 'bold 'bold-italic)
      (make-face-italic 'bold-italic)))

  (when (face-equal 'bold 'bold-italic)
    (copy-face 'italic 'bold-italic)
    (make-face-bold 'bold-italic))
  ;;
  ;; Nothing more to be done for X or TTY's?
  )


;; These warnings are there for a reason.  Just specify your fonts
;; correctly.  Deal with it.  Additionally, one can use
;; `log-warning-minimum-level' instead of this.
;(defvar inhibit-font-complaints nil
;  "Whether to suppress complaints about incomplete sets of fonts.")

(defun face-complain-about-font (face device)
  (if (symbolp face) (setq face (symbol-name face)))
;;  (if (not inhibit-font-complaints)
  (display-warning
   'font
   (let ((default-name (face-font-name 'default device)))
     (format "%s: couldn't deduce %s %s version of the font
%S.

Please specify X resources to make the %s face
visually distinguishable from the default face.
For example, you could add one of the following to $HOME/Emacs:

Emacs.%s.attributeFont: -dt-*-medium-i-*
or
Emacs.%s.attributeForeground: hotpink\n"
             invocation-name
             (if (string-match "\\`[aeiouAEIOU]" face) "an" "a")
             face
             default-name
             face
             face
             face
             ))))


;; #### This is quite a mess.  We should use the custom mechanism for
;; most of this stuff.  Currently we don't do it, because Custom
;; doesn't use specifiers (yet.)  FSF does it the Right Way.

;; For instance, the definition of `bold' should be something like
;; (defface bold ((t (:bold t))) "Bold text.") -- and `:bold t' should
;; make sure that everything works properly.

(defun init-other-random-faces (device)
  "Initialize the colors and fonts of the bold, italic, bold-italic,
zmacs-region, list-mode-item-selected, highlight, primary-selection,
secondary-selection, and isearch faces when each device is created.  If
you want to add code to do stuff like this, use the create-device-hook."

  ;; try to make 'bold look different from the default on this device.
  ;; If that doesn't work at all, then issue a warning.
  (unless (face-differs-from-default-p 'bold device)
    (make-face-bold 'bold device)
    (unless (face-differs-from-default-p 'bold device)
      (make-face-unbold 'bold device)
      (unless (face-differs-from-default-p 'bold device)
	;; the luser specified one of the bogus font names
	(face-complain-about-font 'bold device))))

  ;; Similar for italic.
  ;; It's unreasonable to expect to be able to make a font italic all
  ;; the time.  For many languages, italic is an alien concept.
  ;; Basically, because italic is not a globally meaningful concept,
  ;; the use of the italic face should really be obsoleted.

  ;; I disagree with above.  In many languages, the concept of capital
  ;; letters is just as alien, and yet we use them.  Italic is here to
  ;; stay.  -hniksic

  ;; In a Solaris Japanese environment, there just aren't any italic
  ;; fonts - period.  CDE recognizes this reality, and fonts
  ;; -dt-interface user-medium-r-normal-*-*-*-*-*-*-*-*-* don't come
  ;; in italic versions.  So we first try to make the font bold before
  ;; complaining.
  (unless (face-differs-from-default-p 'italic device)
    (make-face-italic 'italic device)
    (unless (face-differs-from-default-p 'italic device)
      (make-face-bold 'italic device)
      (unless (face-differs-from-default-p 'italic device)
	(face-complain-about-font 'italic device))))

  ;; similar for bold-italic.
  (unless (face-differs-from-default-p 'bold-italic device)
    (make-face-bold-italic 'bold-italic device)
    ;; if we couldn't get a bold-italic version, try just bold.
    (unless (face-differs-from-default-p 'bold-italic device)
      (make-face-bold 'bold-italic device)
      ;; if we couldn't get bold or bold-italic, then that's probably because
      ;; the default font is bold, so make the `bold-italic' face be unbold.
      (unless (face-differs-from-default-p 'bold-italic device)
	(make-face-unbold 'bold-italic device)
	(make-face-italic 'bold-italic device)
	(unless (face-differs-from-default-p 'bold-italic device)
	  ;; if that didn't work, try plain italic
	  ;; (can this ever happen? what the hell.)
	  (make-face-italic 'bold-italic device)
	  (unless (face-differs-from-default-p 'bold-italic device)
	    ;; then bitch and moan.
	    (face-complain-about-font 'bold-italic device))))))

  ;; Set the text-cursor colors unless already specified.
  (when (and (not (eq 'tty (device-type device)))
	     (not (face-background 'text-cursor 'global))
	     (face-property-equal 'text-cursor 'default 'background device))
    (set-face-background 'text-cursor [default foreground] 'global
			 nil 'append))
  (when (and (not (eq 'tty (device-type device)))
	     (not (face-foreground 'text-cursor 'global))
	     (face-property-equal 'text-cursor 'default 'foreground device))
    (set-face-foreground 'text-cursor [default background] 'global
			 nil 'append))
  )

;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle Jones.
(defun set-face-stipple (face pixmap &optional frame)
  "Change the stipple pixmap of FACE to PIXMAP.
This is an Emacs compatibility function; consider using
set-face-background-pixmap instead.

PIXMAP should be a string, the name of a file of pixmap data.
The directories listed in the `x-bitmap-file-path' variable are searched.

Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT
DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is
a string, containing the raw bits of the bitmap.  XBM data is
expected in this case, other types of image data will not work.

If the optional FRAME argument is provided, change only
in that frame; otherwise change each frame."
  (while (not (find-face face))
    (setq face (signal 'wrong-type-argument (list 'facep face))))
  (locate-file pixmap x-bitmap-file-path '(".xbm" ""))
  (while (cond ((stringp pixmap)
		(unless (file-readable-p pixmap)
		  (setq pixmap `[xbm :file ,pixmap]))
		nil)
	       ((and (consp pixmap) (= (length pixmap) 3))
		(setq pixmap `[xbm :data ,pixmap])
		nil)
	       (t t))
    (setq pixmap (signal 'wrong-type-argument
			 (list 'stipple-pixmap-p pixmap))))
  (while (and frame (not (framep frame)))
    (setq frame (signal 'wrong-type-argument (list 'framep frame))))
  (set-face-background-pixmap face pixmap frame))


;; Create the remaining standard faces now.  This way, packages that we dump
;; can reference these faces as parents.
;;
;; The default, modeline, left-margin, right-margin, text-cursor,
;; and pointer faces are created in C.

(make-face 'bold "Bold text.")
(make-face 'italic "Italic text.")
(make-face 'bold-italic "Bold-italic text.")
(make-face 'underline "Underlined text.")
(or (face-differs-from-default-p 'underline)
    (set-face-underline-p 'underline t 'global '(default)))
(make-face 'zmacs-region "Used on highlightes region between point and mark.")
(make-face 'isearch "Used on region matched by isearch.")
(make-face 'isearch-secondary "Face to use for highlighting all matches.")
(make-face 'list-mode-item-selected
	   "Face for the selected list item in list-mode.")
(make-face 'highlight "Highlight face.")
(make-face 'primary-selection "Primary selection face.")
(make-face 'secondary-selection "Secondary selection face.")

;; Several useful color faces.
(eval-when-compile (load "cl-macs"))
(dolist (color '(red green blue yellow))
  (make-face color (concat (symbol-name color) " text."))
  (set-face-foreground color (symbol-name color) nil 'color))

;; Make some useful faces.  This happens very early, before creating
;; the first non-stream device.

(set-face-background 'text-cursor
		     '(((x default) . "Red3")
		       ((mswindows default) . "Red3"))
		     'global)

;; some older X servers don't recognize "darkseagreen2"
(set-face-background 'highlight
		     '(((x default color) . "darkseagreen2")
		       ((x default color) . "green")
		       ((x default grayscale) . "gray53")
		       ((mswindows default color) . "darkseagreen2")
		       ((mswindows default color) . "green")
		       ((mswindows default grayscale) . "gray53"))
		     'global)
(set-face-background-pixmap 'highlight
			    '(((x default mono) . "gray1")
			      ((mswindows default mono) . "gray1"))
			    'global)

(set-face-background 'zmacs-region
		     '(((x default color) . "gray65")
		       ((x default grayscale) . "gray65")
		       ((mswindows default color) . "gray65")
		       ((mswindows default grayscale) . "gray65"))
		     'global)
(set-face-background-pixmap 'zmacs-region
			    '(((x default mono) . "gray3")
			      ((mswindows default mono) . "gray3"))
			    'global)

(set-face-background 'list-mode-item-selected
		     '(((x default color) . "gray68")
		       ((x default grayscale) . "gray68")
		       ((x default mono) . [default foreground])
		       ((mswindows default color) . "gray68")
		       ((mswindows default grayscale) . "gray68")
		       ((mswindows default mono) . [default foreground]))
		     'global)
(set-face-foreground 'list-mode-item-selected
		     '(((x default mono) . [default background])
		       ((mswindows default mono) . [default background]))
		     'global)

(set-face-background 'primary-selection
		     '(((x default color) . "gray65")
		       ((x default grayscale) . "gray65")
		       ((mswindows default color) . "gray65")
		       ((mswindows default grayscale) . "gray65"))
		     'global)
(set-face-background-pixmap 'primary-selection
			    '(((x default mono) . "gray3")
			      ((mswindows default mono) . "gray3"))
			    'global)

(set-face-background 'secondary-selection
		     '(((x default color) . "paleturquoise")
		       ((x default color) . "green")
		       ((x default grayscale) . "gray53")
		       ((mswindows default color) . "paleturquoise")
		       ((mswindows default color) . "green")
		       ((mswindows default grayscale) . "gray53"))
		     'global)
(set-face-background-pixmap 'secondary-selection
			    '(((x default mono) . "gray1")
			      ((mswindows default mono) . "gray1"))
			    'global)

(set-face-background 'isearch
		     '(((x default color) . "paleturquoise")
		       ((x default color) . "green")
		       ((mswindows default color) . "paleturquoise")
		       ((mswindows default color) . "green"))
		     'global)

;; #### This should really, I mean *really*, be converted to some form
;; of `defface' one day.
(set-face-foreground 'isearch-secondary
		     '(((x default color) . "red3")
		       ((mswindows default color) . "red3"))
		     'global)

;; Define some logical color names to be used when reading the pixmap files.
(if (featurep 'xpm)
    (setq xpm-color-symbols
	  (list
	   (purecopy '("foreground" (face-foreground 'default)))
	   (purecopy '("background" (face-background 'default)))
	   (purecopy '("backgroundToolBarColor"
		       (or
			(and 
			 (featurep 'x)
			 (x-get-resource "backgroundToolBarColor"
					 "BackgroundToolBarColor" 'string))

			(face-background 'toolbar))))
	   (purecopy '("foregroundToolBarColor"
		       (or
			(and 
			 (featurep 'x)
			 (x-get-resource "foregroundToolBarColor"
					 "ForegroundToolBarColor" 'string))
			(face-foreground 'toolbar))))
	   )))

(when (featurep 'tty)
  (set-face-highlight-p 'bold                    t 'global '(default tty))
  (set-face-underline-p 'italic                  t 'global '(default tty))
  (set-face-highlight-p 'bold-italic             t 'global '(default tty))
  (set-face-underline-p 'bold-italic             t 'global '(default tty))
  (set-face-highlight-p 'highlight               t 'global '(default tty))
  (set-face-reverse-p   'text-cursor             t 'global '(default tty))
  (set-face-reverse-p   'modeline                t 'global '(default tty))
  (set-face-reverse-p   'zmacs-region            t 'global '(default tty))
  (set-face-reverse-p   'primary-selection       t 'global '(default tty))
  (set-face-underline-p 'secondary-selection     t 'global '(default tty))
  (set-face-reverse-p   'list-mode-item-selected t 'global '(default tty))
  (set-face-reverse-p   'isearch                 t 'global '(default tty))
  )

;;; faces.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.