aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2006-06-28 05:57:27 +0000
committerKenichi Handa2006-06-28 05:57:27 +0000
commitec6fe57c249ddd227c42ca0d42f2db018b0a845b (patch)
tree80b11015ad7937aa444a46dcc7f427aca752ff2f
parenta46bb06e73ae6db4da9a917a813e8fb2d6c24da4 (diff)
downloademacs-ec6fe57c249ddd227c42ca0d42f2db018b0a845b.tar.gz
emacs-ec6fe57c249ddd227c42ca0d42f2db018b0a845b.zip
(QCscalable, Qc, Qm, Qp, Qd): New variables.
(syms_of_font): Initialize them. (font_pixel_size): Allow float value in dpi. (font_prop_validate_type): Deleted. (font_prop_validate_symbol, font_prop_validate_style): Argument changed. Caller changed. (font_prop_validate_non_neg): Renamed from font_prop_validate_size. (font_prop_validate_extra): Deleted. (font_prop_validate_spacing): New function. (font_property_table): Add elements for all known properties. (get_font_prop_index): Renamed from check_font_prop_name. New argument FROM. Caller changed. (font_prop_validate): Validate all known properties. (font_put_extra): Argument force deleted. Caller changed. (font_expand_wildcards): Make it static. Fix the way of shrinking the possible range. (font_parse_xlfd): Arguemnt merge deleted. Fix handling of RESX, RESY, SPACING, and AVGWIDTH. Don't validate property values here. Caller changed. (font_unparse_xlfd): Handle dpi, spacing, and scalable properties. (font_parse_fcname): Arguemnt merge deleted. Fix parsing of point size. Don't validate properties values here. Caller changed. (font_unparse_fcname): Handle dpi, spacing, and scalable properties. (font_open_by_name): Delete unused variable. (Ffont_spec): Likewise. Validate property values. (Ffont_match_p): New function.
-rw-r--r--src/font.c975
1 files changed, 544 insertions, 431 deletions
diff --git a/src/font.c b/src/font.c
index bd18d1a3ce7..5540702b562 100644
--- a/src/font.c
+++ b/src/font.c
@@ -36,7 +36,9 @@ Boston, MA 02110-1301, USA. */
36#include "fontset.h" 36#include "fontset.h"
37#include "font.h" 37#include "font.h"
38 38
39#ifndef FONT_DEBUG
39#define FONT_DEBUG 40#define FONT_DEBUG
41#endif
40 42
41#ifdef FONT_DEBUG 43#ifdef FONT_DEBUG
42#undef xassert 44#undef xassert
@@ -65,12 +67,12 @@ Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp;
65#define PT_PER_INCH 72.27 67#define PT_PER_INCH 72.27
66 68
67/* Return a pixel size (integer) corresponding to POINT size (double) 69/* Return a pixel size (integer) corresponding to POINT size (double)
68 on resolution RESY. */ 70 on resolution DPI. */
69#define POINT_TO_PIXEL(POINT, RESY) ((POINT) * (RESY) / PT_PER_INCH + 0.5) 71#define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5)
70 72
71/* Return a point size (double) corresponding to POINT size (integer) 73/* Return a point size (double) corresponding to POINT size (integer)
72 on resolution RESY. */ 74 on resolution DPI. */
73#define PIXEL_TO_POINT(PIXEL, RESY) ((PIXEL) * PT_PER_INCH * 10 / (RESY) + 0.5) 75#define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH * 10 / (DPI) + 0.5)
74 76
75/* Special string of zero length. It is used to specify a NULL name 77/* Special string of zero length. It is used to specify a NULL name
76 in a font properties (e.g. adstyle). We don't use the symbol of 78 in a font properties (e.g. adstyle). We don't use the symbol of
@@ -101,22 +103,27 @@ static Lisp_Object font_family_alist;
101extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth, QCsize, QCname; 103extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth, QCsize, QCname;
102Lisp_Object QCfoundry, QCadstyle, QCregistry, QCextra; 104Lisp_Object QCfoundry, QCadstyle, QCregistry, QCextra;
103/* Symbols representing keys of font extra info. */ 105/* Symbols representing keys of font extra info. */
104Lisp_Object QCspacing, QCdpi, QCotf, QClanguage, QCscript; 106Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClanguage, QCscript;
107/* Symbols representing values of font spacing property. */
108Lisp_Object Qc, Qm, Qp, Qd;
105 109
106/* List of all font drivers. All font-backends (XXXfont.c) call 110/* List of all font drivers. All font-backends (XXXfont.c) call
107 add_font_driver in syms_of_XXXfont to register the font-driver 111 add_font_driver in syms_of_XXXfont to register the font-driver
108 here. */ 112 here. */
109static struct font_driver_list *font_driver_list; 113static struct font_driver_list *font_driver_list;
110 114
115static int font_pixel_size P_ ((FRAME_PTR f, Lisp_Object));
111static Lisp_Object prop_name_to_numeric P_ ((enum font_property_index, 116static Lisp_Object prop_name_to_numeric P_ ((enum font_property_index,
112 Lisp_Object)); 117 Lisp_Object));
113static Lisp_Object prop_numeric_to_name P_ ((enum font_property_index, int)); 118static Lisp_Object prop_numeric_to_name P_ ((enum font_property_index, int));
114static Lisp_Object font_open_entity P_ ((FRAME_PTR, Lisp_Object, int)); 119static Lisp_Object font_open_entity P_ ((FRAME_PTR, Lisp_Object, int));
120static void build_font_family_alist P_ ((void));
115 121
116/* Number of registered font drivers. */ 122/* Number of registered font drivers. */
117static int num_font_drivers; 123static int num_font_drivers;
118 124
119/* Return a pixel size of font-spec SPEC on frame F. */ 125/* Return a pixel size of font-spec SPEC on frame F. */
126
120static int 127static int
121font_pixel_size (f, spec) 128font_pixel_size (f, spec)
122 FRAME_PTR f; 129 FRAME_PTR f;
@@ -134,9 +141,13 @@ font_pixel_size (f, spec)
134 point_size = XFLOAT_DATA (size); 141 point_size = XFLOAT_DATA (size);
135 extra = AREF (spec, FONT_EXTRA_INDEX); 142 extra = AREF (spec, FONT_EXTRA_INDEX);
136 val = assq_no_quit (extra, QCdpi); 143 val = assq_no_quit (extra, QCdpi);
137 144 if (CONSP (val))
138 if (CONSP (val) && INTEGERP (XCDR (val))) 145 {
139 dpi = XINT (XCDR (val)); 146 if (INTEGERP (XCDR (val)))
147 dpi = XINT (XCDR (val));
148 else
149 dpi = XFLOAT_DATA (XCDR (val)) + 0.5;
150 }
140 else 151 else
141 dpi = f->resy; 152 dpi = f->resy;
142 pixel_size = POINT_TO_PIXEL (point_size, dpi); 153 pixel_size = POINT_TO_PIXEL (point_size, dpi);
@@ -236,19 +247,25 @@ build_font_family_alist ()
236 247
237/* Font property validater. */ 248/* Font property validater. */
238 249
239static Lisp_Object 250static Lisp_Object font_prop_validate_symbol P_ ((enum font_property_index,
240font_prop_validate_type (prop, val) 251 Lisp_Object, Lisp_Object));
241 enum font_property_index prop; 252static Lisp_Object font_prop_validate_style P_ ((enum font_property_index,
242 Lisp_Object val; 253 Lisp_Object, Lisp_Object));
243{ 254static Lisp_Object font_prop_validate_non_neg P_ ((enum font_property_index,
244 return (SYMBOLP (val) ? val : Qerror); 255 Lisp_Object, Lisp_Object));
245} 256static Lisp_Object font_prop_validate_spacing P_ ((enum font_property_index,
257 Lisp_Object, Lisp_Object));
258static int get_font_prop_index P_ ((Lisp_Object, int));
259static Lisp_Object font_prop_validate P_ ((Lisp_Object));
260static Lisp_Object font_put_extra P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
246 261
247static Lisp_Object 262static Lisp_Object
248font_prop_validate_symbol (prop, val) 263font_prop_validate_symbol (prop_index, prop, val)
249 enum font_property_index prop; 264 enum font_property_index prop_index;
250 Lisp_Object val; 265 Lisp_Object prop, val;
251{ 266{
267 if (EQ (prop, QCotf))
268 return (SYMBOLP (val) ? val : Qerror);
252 if (STRINGP (val)) 269 if (STRINGP (val))
253 val = (SCHARS (val) == 0 ? null_string 270 val = (SCHARS (val) == 0 ? null_string
254 : intern_downcase ((char *) SDATA (val), SBYTES (val))); 271 : intern_downcase ((char *) SDATA (val), SBYTES (val)));
@@ -263,9 +280,9 @@ font_prop_validate_symbol (prop, val)
263} 280}
264 281
265static Lisp_Object 282static Lisp_Object
266font_prop_validate_style (prop, val) 283font_prop_validate_style (prop_index, prop, val)
267 enum font_property_index prop; 284 enum font_property_index prop_index;
268 Lisp_Object val; 285 Lisp_Object prop, val;
269{ 286{
270 if (! INTEGERP (val)) 287 if (! INTEGERP (val))
271 { 288 {
@@ -275,7 +292,7 @@ font_prop_validate_style (prop, val)
275 val = Qerror; 292 val = Qerror;
276 else 293 else
277 { 294 {
278 val = prop_name_to_numeric (prop, val); 295 val = prop_name_to_numeric (prop_index, val);
279 if (NILP (val)) 296 if (NILP (val))
280 val = Qerror; 297 val = Qerror;
281 } 298 }
@@ -284,51 +301,41 @@ font_prop_validate_style (prop, val)
284} 301}
285 302
286static Lisp_Object 303static Lisp_Object
287font_prop_validate_size (prop, val) 304font_prop_validate_non_neg (prop_index, prop, val)
288 enum font_property_index prop; 305 enum font_property_index prop_index;
289 Lisp_Object val; 306 Lisp_Object prop, val;
290{ 307{
291 return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0) 308 return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0)
292 ? val : Qerror); 309 ? val : Qerror);
293} 310}
294 311
295static Lisp_Object 312static Lisp_Object
296font_prop_validate_extra (prop, val) 313font_prop_validate_spacing (prop_index, prop, val)
297 enum font_property_index prop; 314 enum font_property_index prop_index;
298 Lisp_Object val; 315 Lisp_Object prop, val;
299{ 316{
300 Lisp_Object tail; 317 if (NILP (val) || (NATNUMP (val) && XINT (val) <= FONT_SPACING_CHARCELL))
301 318 return val;
302 for (tail = val; CONSP (tail); tail = XCDR (tail)) 319 if (EQ (val, Qc))
303 { 320 return make_number (FONT_SPACING_CHARCELL);
304 Lisp_Object key = Fcar (XCAR (tail)), this_val = Fcdr (XCAR (tail)); 321 if (EQ (val, Qm))
305 322 return make_number (FONT_SPACING_MONO);
306 if (NILP (this_val)) 323 if (EQ (val, Qp))
307 return Qnil; 324 return make_number (FONT_SPACING_PROPORTIONAL);
308 if (EQ (key, QClanguage)) 325 return Qerror;
309 if (! SYMBOLP (this_val)) 326}
310 { 327
311 for (; CONSP (this_val); this_val = XCDR (this_val)) 328/* Structure of known font property keys and validater of the
312 if (! SYMBOLP (XCAR (this_val))) 329 values. */
313 return Qerror;
314 if (! NILP (this_val))
315 return Qerror;
316 }
317 if (EQ (key, QCotf))
318 if (! STRINGP (this_val))
319 return Qerror;
320 }
321 return (NILP (tail) ? val : Qerror);
322}
323
324
325struct 330struct
326{ 331{
332 /* Pointer to the key symbol. */
327 Lisp_Object *key; 333 Lisp_Object *key;
328 Lisp_Object (*validater) P_ ((enum font_property_index prop, 334 /* Function to validate the value VAL, or NULL if any value is ok. */
329 Lisp_Object val)); 335 Lisp_Object (*validater) P_ ((enum font_property_index prop_index,
330} font_property_table[FONT_SPEC_MAX] = 336 Lisp_Object prop, Lisp_Object val));
331 { { &QCtype, font_prop_validate_type }, 337} font_property_table[] =
338 { { &QCtype, font_prop_validate_symbol },
332 { &QCfoundry, font_prop_validate_symbol }, 339 { &QCfoundry, font_prop_validate_symbol },
333 { &QCfamily, font_prop_validate_symbol }, 340 { &QCfamily, font_prop_validate_symbol },
334 { &QCadstyle, font_prop_validate_symbol }, 341 { &QCadstyle, font_prop_validate_symbol },
@@ -336,69 +343,94 @@ struct
336 { &QCweight, font_prop_validate_style }, 343 { &QCweight, font_prop_validate_style },
337 { &QCslant, font_prop_validate_style }, 344 { &QCslant, font_prop_validate_style },
338 { &QCwidth, font_prop_validate_style }, 345 { &QCwidth, font_prop_validate_style },
339 { &QCsize, font_prop_validate_size }, 346 { &QCsize, font_prop_validate_non_neg },
340 { &QCextra, font_prop_validate_extra } 347 { &QClanguage, font_prop_validate_symbol },
348 { &QCscript, font_prop_validate_symbol },
349 { &QCdpi, font_prop_validate_non_neg },
350 { &QCspacing, font_prop_validate_spacing },
351 { &QCscalable, NULL },
352 { &QCotf, font_prop_validate_symbol }
341 }; 353 };
342 354
343static enum font_property_index 355#define FONT_PROPERTY_TABLE_SIZE \
344check_font_prop_name (key) 356 ((sizeof font_property_table) / (sizeof *font_property_table))
357
358static int
359get_font_prop_index (key, from)
345 Lisp_Object key; 360 Lisp_Object key;
361 int from;
346{ 362{
347 enum font_property_index i; 363 for (; from < FONT_PROPERTY_TABLE_SIZE; from++)
348 364 if (EQ (key, *font_property_table[from].key))
349 for (i = FONT_TYPE_INDEX; i < FONT_SPEC_MAX; i++) 365 return from;
350 if (EQ (key, *font_property_table[i].key)) 366 return -1;
351 break;
352 return i;
353} 367}
354 368
355static Lisp_Object 369static Lisp_Object
356font_prop_validate (spec) 370font_prop_validate (spec)
357 Lisp_Object spec; 371 Lisp_Object spec;
358{ 372{
359 enum font_property_index i; 373 int i;
360 Lisp_Object val; 374 Lisp_Object prop, val, extra;
361 375
362 for (i = FONT_TYPE_INDEX; i <= FONT_EXTRA_INDEX; i++) 376 for (i = FONT_TYPE_INDEX; i < FONT_EXTRA_INDEX; i++)
363 { 377 {
364 if (! NILP (AREF (spec, i))) 378 if (! NILP (AREF (spec, i)))
365 { 379 {
366 val = (font_property_table[i].validater) (i, AREF (spec, i)); 380 prop = *font_property_table[i].key;
381 val = (font_property_table[i].validater) (i, prop, AREF (spec, i));
367 if (EQ (val, Qerror)) 382 if (EQ (val, Qerror))
368 Fsignal (Qerror, list3 (build_string ("invalid font property"), 383 Fsignal (Qfont, list2 (build_string ("invalid font property"),
369 *font_property_table[i].key, 384 Fcons (prop, AREF (spec, i))));
370 AREF (spec, i)));
371 ASET (spec, i, val); 385 ASET (spec, i, val);
372 } 386 }
373 } 387 }
388 for (extra = AREF (spec, FONT_EXTRA_INDEX);
389 CONSP (extra); extra = XCDR (extra))
390 {
391 Lisp_Object elt = XCAR (extra);
392
393 prop = XCAR (elt);
394 i = get_font_prop_index (prop, FONT_EXTRA_INDEX);
395 if (i >= 0
396 && font_property_table[i].validater)
397 {
398 val = (font_property_table[i].validater) (i, prop, XCDR (elt));
399 if (EQ (val, Qerror))
400 Fsignal (Qfont, list2 (build_string ("invalid font property"),
401 elt));
402 XSETCDR (elt, val);
403 }
404 }
374 return spec; 405 return spec;
375} 406}
376 407
377static void 408static Lisp_Object
378font_put_extra (font, prop, val, force) 409font_put_extra (font, prop, val)
379 Lisp_Object font, prop, val; 410 Lisp_Object font, prop, val;
380 int force;
381{ 411{
382 Lisp_Object extra = AREF (font, FONT_EXTRA_INDEX); 412 Lisp_Object extra = AREF (font, FONT_EXTRA_INDEX);
383 Lisp_Object slot = (NILP (extra) ? Qnil : Fassq (prop, extra)); 413 Lisp_Object slot = (NILP (extra) ? Qnil : assq_no_quit (prop, extra));
384 414
385 if (NILP (slot)) 415 if (NILP (slot))
386 { 416 {
387 extra = Fcons (Fcons (prop, val), extra); 417 extra = Fcons (Fcons (prop, val), extra);
388 ASET (font, FONT_EXTRA_INDEX, extra); 418 ASET (font, FONT_EXTRA_INDEX, extra);
389 return; 419 return val;
390 } 420 }
391 if (! NILP (XCDR (slot)) && ! force)
392 return;
393 XSETCDR (slot, val); 421 XSETCDR (slot, val);
394 return; 422 return val;
395} 423}
396 424
397 425
398/* Font name parser and unparser */ 426/* Font name parser and unparser */
399 427
400/* An enumerator for each field of an XLFD font name. */ 428static Lisp_Object intern_font_field P_ ((char *, int));
429static int parse_matrix P_ ((char *));
430static int font_expand_wildcards P_ ((Lisp_Object *, int));
431static int font_parse_name P_ ((char *, Lisp_Object));
401 432
433/* An enumerator for each field of an XLFD font name. */
402enum xlfd_field_index 434enum xlfd_field_index
403{ 435{
404 XLFD_FOUNDRY_INDEX, 436 XLFD_FOUNDRY_INDEX,
@@ -418,6 +450,7 @@ enum xlfd_field_index
418 XLFD_LAST_INDEX 450 XLFD_LAST_INDEX
419}; 451};
420 452
453/* An enumerator for mask bit corresponding to each XLFD field. */
421enum xlfd_field_mask 454enum xlfd_field_mask
422{ 455{
423 XLFD_FOUNDRY_MASK = 0x0001, 456 XLFD_FOUNDRY_MASK = 0x0001,
@@ -437,10 +470,11 @@ enum xlfd_field_mask
437}; 470};
438 471
439 472
440/* Return a Lispy value for string at STR and bytes LEN. 473/* Return a Lispy value of a XLFD font field at STR and LEN bytes.
441 If LEN == 0, return a null string. 474 If LEN is zero, it returns `null_string'.
442 If the string is "*", return Qnil. 475 If STR is "*", it returns nil.
443 It is assured that LEN < 256. */ 476 If all characters in STR are digits, it returns an integer.
477 Otherwise, it returns a symbol interned from downcased STR. */
444 478
445static Lisp_Object 479static Lisp_Object
446intern_font_field (str, len) 480intern_font_field (str, len)
@@ -501,7 +535,7 @@ parse_matrix (p)
501 multiple fields to fill in all 14 XLFD fields while restring a 535 multiple fields to fill in all 14 XLFD fields while restring a
502 field position by its contents. */ 536 field position by its contents. */
503 537
504int 538static int
505font_expand_wildcards (field, n) 539font_expand_wildcards (field, n)
506 Lisp_Object field[XLFD_LAST_INDEX]; 540 Lisp_Object field[XLFD_LAST_INDEX];
507 int n; 541 int n;
@@ -519,6 +553,7 @@ font_expand_wildcards (field, n)
519 int mask; 553 int mask;
520 } range[XLFD_LAST_INDEX]; 554 } range[XLFD_LAST_INDEX];
521 int i, j; 555 int i, j;
556 int range_from, range_to;
522 unsigned range_mask; 557 unsigned range_mask;
523 558
524#define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \ 559#define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
@@ -534,11 +569,11 @@ font_expand_wildcards (field, n)
534 for (i = 0, range_mask = 0; i <= 14 - n; i++) 569 for (i = 0, range_mask = 0; i <= 14 - n; i++)
535 range_mask = (range_mask << 1) | 1; 570 range_mask = (range_mask << 1) | 1;
536 571
537 for (i = 0; i < n; i++, range_mask <<= 1) 572 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
573 position-based retriction for FIELD[I]. */
574 for (i = 0, range_from = 0, range_to = 14 - n; i < n;
575 i++, range_from++, range_to++, range_mask <<= 1)
538 { 576 {
539 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
540 position-based retriction for FIELD[I]. */
541 int range_from = i, range_to = 14 - n + i;
542 Lisp_Object val = field[i]; 577 Lisp_Object val = field[i];
543 578
544 tmp[i] = val; 579 tmp[i] = val;
@@ -563,11 +598,14 @@ font_expand_wildcards (field, n)
563 if (i + 1 == n) 598 if (i + 1 == n)
564 from = to = XLFD_ENCODING_INDEX, 599 from = to = XLFD_ENCODING_INDEX,
565 mask = XLFD_ENCODING_MASK; 600 mask = XLFD_ENCODING_MASK;
601 else if (numeric == 0)
602 from = XLFD_PIXEL_INDEX, to = XLFD_AVGWIDTH_INDEX,
603 mask = XLFD_PIXEL_MASK | XLFD_LARGENUM_MASK;
566 else if (numeric <= 48) 604 else if (numeric <= 48)
567 from = to = XLFD_PIXEL_INDEX, 605 from = to = XLFD_PIXEL_INDEX,
568 mask = XLFD_PIXEL_MASK; 606 mask = XLFD_PIXEL_MASK;
569 else 607 else
570 from = XLFD_POINT_INDEX, to = XLFD_AVGWIDTH_MASK, 608 from = XLFD_POINT_INDEX, to = XLFD_AVGWIDTH_INDEX,
571 mask = XLFD_LARGENUM_MASK; 609 mask = XLFD_LARGENUM_MASK;
572 } 610 }
573 else if (EQ (val, null_string)) 611 else if (EQ (val, null_string))
@@ -600,12 +638,7 @@ font_expand_wildcards (field, n)
600 from = to = XLFD_SWIDTH_INDEX, mask = XLFD_SWIDTH_MASK; 638 from = to = XLFD_SWIDTH_INDEX, mask = XLFD_SWIDTH_MASK;
601 else 639 else
602 { 640 {
603 Lisp_Object name = SYMBOL_NAME (val); 641 if (EQ (val, Qc) || EQ (val, Qm) || EQ (val, Qp) || EQ (val, Qd))
604
605 if (SBYTES (name) == 1
606 && (SDATA (name)[0] == 'c'
607 || SDATA (name)[0] == 'm'
608 || SDATA (name)[0] == 'p'))
609 from = to = XLFD_SPACING_INDEX, mask = XLFD_SPACING_MASK; 642 from = to = XLFD_SPACING_INDEX, mask = XLFD_SPACING_MASK;
610 else 643 else
611 from = XLFD_FOUNDRY_INDEX, to = XLFD_ENCODING_INDEX, 644 from = XLFD_FOUNDRY_INDEX, to = XLFD_ENCODING_INDEX,
@@ -629,34 +662,40 @@ font_expand_wildcards (field, n)
629 range[i].mask = mask; 662 range[i].mask = mask;
630 663
631 if (from > range_from || to < range_to) 664 if (from > range_from || to < range_to)
632 /* The range is narrowed by value-based restrictions. 665 {
633 Reflect it to the previous fields. */ 666 /* The range is narrowed by value-based restrictions.
634 for (j = i - 1, from--, to--; j >= 0; j--, from--, to--) 667 Reflect it to the other fields. */
635 { 668
636 /* Check FROM for non-wildcard field. */ 669 /* Following fields should be after FROM. */
637 if (! NILP (tmp[j]) && range[j].from < from) 670 range_from = from;
638 { 671 /* Preceding fields should be before TO. */
639 while (range[j].from < from) 672 for (j = i - 1, from--, to--; j >= 0; j--, from--, to--)
640 range[j].mask &= ~(1 << range[j].from++); 673 {
641 while (from < 14 && ! (range[j].mask & (1 << from))) 674 /* Check FROM for non-wildcard field. */
642 from++; 675 if (! NILP (tmp[j]) && range[j].from < from)
643 range[j].from = from; 676 {
644 } 677 while (range[j].from < from)
645 else 678 range[j].mask &= ~(1 << range[j].from++);
646 from = range[j].from; 679 while (from < 14 && ! (range[j].mask & (1 << from)))
647 if (range[j].to > to) 680 from++;
648 { 681 range[j].from = from;
649 while (range[j].to > to) 682 }
650 range[j].mask &= ~(1 << range[j].to--); 683 else
651 while (to >= 0 && ! (range[j].mask & (1 << to))) 684 from = range[j].from;
652 to--; 685 if (range[j].to > to)
653 range[j].to = to; 686 {
654 } 687 while (range[j].to > to)
655 else 688 range[j].mask &= ~(1 << range[j].to--);
656 to = range[j].to; 689 while (to >= 0 && ! (range[j].mask & (1 << to)))
657 if (from > to) 690 to--;
658 return -1; 691 range[j].to = to;
659 } 692 }
693 else
694 to = range[j].to;
695 if (from > to)
696 return -1;
697 }
698 }
660 } 699 }
661 } 700 }
662 701
@@ -692,224 +731,207 @@ font_expand_wildcards (field, n)
692 POINT_SIZE and RESY calculated pixel size (Lisp integer) 731 POINT_SIZE and RESY calculated pixel size (Lisp integer)
693 POINT_SIZE POINT_SIZE/10 (Lisp float) 732 POINT_SIZE POINT_SIZE/10 (Lisp float)
694 733
695 If NAME is successfully parsed, return 2 (size is specified), 1 734 If NAME is successfully parsed, return 0. Otherwise return -1.
696 (size is not specified), or 0 (size is not specified but resolution
697 is specified). Otherwise return -1.
698 735
699 See font_parse_name for more detail. */ 736 FONT is usually a font-spec, but when this function is called from
737 X font backend driver, it is a font-entity. In that case, NAME is
738 a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a
739 symbol RESX-RESY-SPACING-AVGWIDTH.
740*/
700 741
701int 742int
702font_parse_xlfd (name, font, merge) 743font_parse_xlfd (name, font)
703 char *name; 744 char *name;
704 Lisp_Object font; 745 Lisp_Object font;
705 int merge;
706{ 746{
707 int len = strlen (name); 747 int len = strlen (name);
708 int i, j; 748 int i, j;
709 int pixel_size, resy, avgwidth; 749 Lisp_Object dpi, spacing;
710 double point_size; 750 int avgwidth;
711 Lisp_Object f[XLFD_LAST_INDEX]; 751 char *f[XLFD_LAST_INDEX];
712 Lisp_Object val; 752 Lisp_Object val;
713 char *p; 753 char *p;
714 754
715 if (len > 255) 755 if (len > 255)
716 /* Maximum XLFD name length is 255. */ 756 /* Maximum XLFD name length is 255. */
717 return -1; 757 return -1;
718 i = (name[0] == '*' && name[1] == '-'); 758 /* Accept "*-.." as a fully specified XLFD. */
719 for (p = name + 1; *p; p++) 759 if (name[0] == '*' && name[1] == '-')
720 { 760 i = 1, f[XLFD_FOUNDRY_INDEX] = name;
721 if (*p == '-') 761 else
722 { 762 i = 0;
723 i++; 763 for (p = name + i; *p; p++)
724 if (i == XLFD_ENCODING_INDEX) 764 if (*p == '-' && i < XLFD_LAST_INDEX)
725 break; 765 f[i++] = p + 1;
726 } 766 f[i] = p;
727 }
728 767
729 pixel_size = resy = avgwidth = -1; 768 dpi = spacing = Qnil;
730 point_size = -1; 769 avgwidth = -1;
731 770
732 if (i == XLFD_ENCODING_INDEX) 771 if (i == XLFD_LAST_INDEX)
733 { 772 {
773 int pixel_size;
774
734 /* Fully specified XLFD. */ 775 /* Fully specified XLFD. */
735 if (name[0] == '-') 776 for (i = 0, j = FONT_FOUNDRY_INDEX; i < XLFD_WEIGHT_INDEX; i++, j++)
736 name++; 777 {
737 for (i = 0, p = name; ; p++) 778 val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
779 if (! NILP (val))
780 ASET (font, j, val);
781 }
782 for (j = FONT_WEIGHT_INDEX; i < XLFD_ADSTYLE_INDEX; i++, j++)
738 { 783 {
739 if (*p == '-') 784 val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
785 if (! NILP (val))
740 { 786 {
741 if (i < XLFD_PIXEL_INDEX) 787 Lisp_Object numeric = prop_name_to_numeric (j, val);
742 f[i++] = intern_font_field (name, p - name); 788
743 else if (i == XLFD_PIXEL_INDEX) 789 if (INTEGERP (numeric))
744 { 790 val = numeric;
745 if (isdigit (*name)) 791 ASET (font, j, val);
746 pixel_size = atoi (name); 792 }
747 else if (*name == '[') 793 }
748 pixel_size = parse_matrix (name); 794 val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
749 i++; 795 if (! NILP (val))
750 } 796 ASET (font, FONT_ADSTYLE_INDEX, val);
751 else if (i == XLFD_POINT_INDEX) 797 i = XLFD_REGISTRY_INDEX;
752 { 798 val = intern_font_field (f[i], f[i + 2] - f[i]);
753 /* If PIXEL_SIZE is specified, we don't have to 799 if (! NILP (val))
754 calculate POINT_SIZE. */ 800 ASET (font, FONT_REGISTRY_INDEX, val);
755 if (pixel_size < 0) 801
756 { 802 p = f[XLFD_PIXEL_INDEX];
757 if (isdigit (*name)) 803 if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0)
758 point_size = atoi (name); 804 ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
759 else if (*name == '[') 805 else
760 point_size = parse_matrix (name); 806 {
761 } 807 i = XLFD_PIXEL_INDEX;
762 i++; 808 val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
763 } 809 if (! NILP (val))
764 else if (i == XLFD_RESX_INDEX) 810 ASET (font, FONT_SIZE_INDEX, val);
765 { 811 else
766 /* Skip this field. */ 812 {
767 f[i++] = Qnil; 813 double point_size = -1;
768 } 814
769 else if (i == XLFD_RESY_INDEX) 815 xassert (FONT_SPEC_P (font));
770 { 816 p = f[XLFD_POINT_INDEX];
771 /* Stuff RESY, SPACING, and AVGWIDTH. */ 817 if (*p == '[')
772 /* If PIXEL_SIZE is specified, we don't have to 818 point_size = parse_matrix (p);
773 calculate RESY. */ 819 else if (isdigit (*p))
774 if (pixel_size < 0 && isdigit (*name)) 820 point_size = atoi (p), point_size /= 10;
775 resy = atoi (name); 821 if (point_size >= 0)
776 for (p++; *p != '-'; p++); 822 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
777 if (isdigit (p[1]))
778 avgwidth = atoi (p + 1);
779 else if (p[1] == '~' && isdigit (p[2]))
780 avgwidth = atoi (p + 2);
781 for (p++; *p != '-'; p++);
782 if (FONT_ENTITY_P (font))
783 f[i] = intern_font_field (name, p - name);
784 else
785 f[i] = Qnil;
786 i = XLFD_REGISTRY_INDEX;
787 }
788 else 823 else
789 { 824 {
790 /* Stuff REGISTRY and ENCODING. */ 825 i = XLFD_PIXEL_INDEX;
791 for (p++; *p; p++); 826 val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
792 f[i++] = intern_font_field (name, p - name); 827 if (! NILP (val))
793 break; 828 ASET (font, FONT_SIZE_INDEX, val);
794 } 829 }
795 name = p + 1;
796 } 830 }
797 } 831 }
798 xassert (i == XLFD_ENCODING_INDEX); 832
833 /* Parse RESX, RESY, SPACING, and AVGWIDTH. */
834 if (FONT_ENTITY_P (font))
835 {
836 i = XLFD_RESX_INDEX;
837 ASET (font, FONT_EXTRA_INDEX,
838 intern_font_field (f[i], f[XLFD_REGISTRY_INDEX] - 1 - f[i]));
839 return 0;
840 }
841
842 /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set
843 in FONT_EXTRA_INDEX later. */
844 i = XLFD_RESX_INDEX;
845 dpi = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
846 i = XLFD_SPACING_INDEX;
847 spacing = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
848 p = f[XLFD_AVGWIDTH_INDEX];
849 if (*p == '~')
850 p++;
851 if (isdigit (*p))
852 avgwidth = atoi (p);
799 } 853 }
800 else 854 else
801 { 855 {
802 int wild_card_found = 0; 856 int wild_card_found = 0;
857 Lisp_Object prop[XLFD_LAST_INDEX];
803 858
804 if (name[0] == '-') 859 for (j = 0; j < i; j++)
805 name++;
806 for (i = 0, p = name; ; p++)
807 { 860 {
808 if (*p == '-' || ! *p) 861 if (*f[j] == '*')
809 { 862 {
810 if (*name == '*') 863 if (f[j][1] && f[j][1] != '-')
811 { 864 return -1;
812 if (name + 1 != p) 865 prop[j] = Qnil;
813 return -1; 866 wild_card_found = 1;
814 f[i++] = Qnil; 867 }
815 wild_card_found = 1; 868 else if (isdigit (*f[j]))
816 } 869 {
817 else if (isdigit (*name)) 870 for (p = f[j] + 1; isdigit (*p); p++);
818 { 871 if (*p && *p != '-')
819 f[i++] = make_number (atoi (name)); 872 prop[j] = intern_downcase (f[j], p - f[j]);
820 /* Check if all chars in this field is number. */
821 name++;
822 while (isdigit (*name)) name++;
823 if (name != p)
824 return -1;
825 }
826 else if (p == name)
827 f[i++] = null_string;
828 else 873 else
829 { 874 prop[j] = make_number (atoi (f[j]));
830 f[i++] = intern_downcase (name, p - name);
831 }
832 if (! *p)
833 break;
834 name = p + 1;
835 } 875 }
876 else if (j + 1 < i)
877 prop[j] = intern_font_field (f[j], f[j + 1] - 1 - f[j]);
878 else
879 prop[j] = intern_font_field (f[j], f[i] - f[j]);
836 } 880 }
837 if (! wild_card_found) 881 if (! wild_card_found)
838 return -1; 882 return -1;
839 if (font_expand_wildcards (f, i) < 0) 883 if (font_expand_wildcards (prop, i) < 0)
840 return -1; 884 return -1;
841 if (! NILP (f[XLFD_PIXEL_INDEX])) 885
842 pixel_size = XINT (f[XLFD_PIXEL_INDEX]); 886 for (i = 0, j = FONT_FOUNDRY_INDEX; i < XLFD_WEIGHT_INDEX; i++, j++)
843 /* If PIXEL_SIZE is specified, we don't have to 887 if (! NILP (prop[i]))
844 calculate POINT_SIZE and RESY. */ 888 ASET (font, j, prop[i]);
845 if (pixel_size < 0) 889 for (j = FONT_WEIGHT_INDEX; i < XLFD_ADSTYLE_INDEX; i++, j++)
846 { 890 if (! NILP (prop[i]))
847 if (! NILP (f[XLFD_POINT_INDEX])) 891 ASET (font, j, prop[i]);
848 point_size = XINT (f[XLFD_POINT_INDEX]); 892 if (! NILP (prop[XLFD_ADSTYLE_INDEX]))
849 if (! NILP (f[XLFD_RESY_INDEX])) 893 ASET (font, FONT_ADSTYLE_INDEX, prop[XLFD_ADSTYLE_INDEX]);
850 resy = XINT (f[XLFD_RESY_INDEX]); 894 val = prop[XLFD_REGISTRY_INDEX];
851 } 895 if (NILP (val))
852 if (! NILP (f[XLFD_AVGWIDTH_INDEX]))
853 avgwidth = XINT (f[XLFD_AVGWIDTH_INDEX]);
854 if (NILP (f[XLFD_REGISTRY_INDEX]))
855 { 896 {
856 if (! NILP (f[XLFD_ENCODING_INDEX])) 897 val = prop[XLFD_ENCODING_INDEX];
857 f[XLFD_REGISTRY_INDEX] 898 if (! NILP (val))
858 = Fintern (concat2 (build_string ("*-"), 899 val = Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val)),
859 SYMBOL_NAME (f[XLFD_ENCODING_INDEX])), Qnil); 900 Qnil);
860 } 901 }
902 else if (NILP (prop[XLFD_ENCODING_INDEX]))
903 val = Fintern (concat2 (SYMBOL_NAME (val), build_string ("-*")),
904 Qnil);
861 else 905 else
906 val = Fintern (concat3 (SYMBOL_NAME (val), build_string ("-"),
907 SYMBOL_NAME (prop[XLFD_ENCODING_INDEX])),
908 Qnil);
909 if (! NILP (val))
910 ASET (font, FONT_REGISTRY_INDEX, val);
911
912 if (INTEGERP (prop[XLFD_PIXEL_INDEX]))
913 ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]);
914 else if (INTEGERP (prop[XLFD_POINT_INDEX]))
862 { 915 {
863 if (! NILP (f[XLFD_ENCODING_INDEX])) 916 double point_size = XINT (prop[XLFD_POINT_INDEX]);
864 f[XLFD_REGISTRY_INDEX]
865 = Fintern (concat3 (SYMBOL_NAME (f[XLFD_REGISTRY_INDEX]),
866 build_string ("-"),
867 SYMBOL_NAME (f[XLFD_ENCODING_INDEX])), Qnil);
868 }
869 }
870
871 if (! merge || NILP (AREF (font, FONT_FOUNDRY_INDEX)))
872 ASET (font, FONT_FOUNDRY_INDEX, f[XLFD_FOUNDRY_INDEX]);
873 if (! merge || NILP (AREF (font, FONT_FAMILY_INDEX)))
874 ASET (font, FONT_FAMILY_INDEX, f[XLFD_FAMILY_INDEX]);
875 if (! merge || NILP (AREF (font, FONT_ADSTYLE_INDEX)))
876 ASET (font, FONT_ADSTYLE_INDEX, f[XLFD_ADSTYLE_INDEX]);
877 if (! merge || NILP (AREF (font, FONT_REGISTRY_INDEX)))
878 ASET (font, FONT_REGISTRY_INDEX, f[XLFD_REGISTRY_INDEX]);
879 917
880 for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; 918 ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10));
881 j <= XLFD_SWIDTH_INDEX; i++, j++) 919 }
882 if (! merge || NILP (AREF (font, i)))
883 {
884 if (! INTEGERP (f[j]))
885 {
886 val = prop_name_to_numeric (i, f[j]);
887 if (INTEGERP (val))
888 f[j] = val;
889 }
890 ASET (font, i, f[j]);
891 }
892
893 if (pixel_size < 0 && FONT_ENTITY_P (font))
894 return -1;
895 920
896 if (! merge || NILP (AREF (font, FONT_SIZE_INDEX))) 921 dpi = prop[XLFD_RESX_INDEX];
897 { 922 spacing = prop[XLFD_SPACING_INDEX];
898 if (pixel_size >= 0) 923 if (INTEGERP (prop[XLFD_AVGWIDTH_INDEX]))
899 ASET (font, FONT_SIZE_INDEX, make_number (pixel_size)); 924 avgwidth = XINT (prop[XLFD_AVGWIDTH_INDEX]);
900 else if (point_size >= 0)
901 ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10));
902 } 925 }
903 926
904 if (FONT_ENTITY_P (font)) 927 if (! NILP (dpi))
905 { 928 font_put_extra (font, QCdpi, dpi);
906 if (EQ (AREF (font, FONT_TYPE_INDEX), Qx)) 929 if (! NILP (spacing))
907 ASET (font, FONT_EXTRA_INDEX, f[XLFD_RESY_INDEX]); 930 font_put_extra (font, QCspacing, spacing);
908 } 931 if (avgwidth >= 0)
909 else if (resy >= 0) 932 font_put_extra (font, QCscalable, avgwidth == 0 ? Qt : Qnil);
910 font_put_extra (font, QCdpi, make_number (resy), merge);
911 933
912 return (avgwidth > 0 ? 2 : resy == 0); 934 return 0;
913} 935}
914 936
915/* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES 937/* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
@@ -923,8 +945,7 @@ font_unparse_xlfd (font, pixel_size, name, nbytes)
923 char *name; 945 char *name;
924 int nbytes; 946 int nbytes;
925{ 947{
926 char *f[XLFD_REGISTRY_INDEX + 1], *pixel_point; 948 char *f[XLFD_REGISTRY_INDEX + 1];
927 char work[256];
928 Lisp_Object val; 949 Lisp_Object val;
929 int i, j, len = 0; 950 int i, j, len = 0;
930 951
@@ -992,47 +1013,90 @@ font_unparse_xlfd (font, pixel_size, name, nbytes)
992 xassert (NUMBERP (val) || NILP (val)); 1013 xassert (NUMBERP (val) || NILP (val));
993 if (INTEGERP (val)) 1014 if (INTEGERP (val))
994 { 1015 {
1016 f[XLFD_PIXEL_INDEX] = alloca (22);
995 i = XINT (val); 1017 i = XINT (val);
996 if (i > 0) 1018 if (i > 0)
997 len += sprintf (work, "%d-*", i) + 1; 1019 len += sprintf (f[XLFD_PIXEL_INDEX], "%d-*", i) + 1;
998 else /* i == 0 */ 1020 else /* i == 0 */
999 len += sprintf (work, "%d-*", pixel_size) + 1; 1021 len += sprintf (f[XLFD_PIXEL_INDEX], "%d-*", pixel_size) + 1;
1000 pixel_point = work;
1001 } 1022 }
1002 else if (FLOATP (val)) 1023 else if (FLOATP (val))
1003 { 1024 {
1025 f[XLFD_PIXEL_INDEX] = alloca (12);
1004 i = XFLOAT_DATA (val) * 10; 1026 i = XFLOAT_DATA (val) * 10;
1005 len += sprintf (work, "*-%d", i) + 1; 1027 len += sprintf (f[XLFD_PIXEL_INDEX], "*-%d", i) + 1;
1006 pixel_point = work;
1007 } 1028 }
1008 else 1029 else
1009 pixel_point = "*-*", len += 4; 1030 f[XLFD_PIXEL_INDEX] = "*-*", len += 4;
1031
1032 val = AREF (font, FONT_EXTRA_INDEX);
1010 1033
1011 if (FONT_ENTITY_P (font) 1034 if (FONT_ENTITY_P (font)
1012 && EQ (AREF (font, FONT_TYPE_INDEX), Qx)) 1035 && EQ (AREF (font, FONT_TYPE_INDEX), Qx))
1013 { 1036 {
1014 /* Setup names for RESY-SPACING-AVWIDTH. */ 1037 /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
1015 val = AREF (font, FONT_EXTRA_INDEX);
1016 if (SYMBOLP (val) && ! NILP (val)) 1038 if (SYMBOLP (val) && ! NILP (val))
1017 { 1039 {
1018 val = SYMBOL_NAME (val); 1040 val = SYMBOL_NAME (val);
1019 f[XLFD_RESY_INDEX] = (char *) SDATA (val), len += SBYTES (val) + 1; 1041 f[XLFD_RESX_INDEX] = (char *) SDATA (val), len += SBYTES (val) + 1;
1020 } 1042 }
1021 else 1043 else
1022 f[XLFD_RESY_INDEX] = "*-*-*", len += 6; 1044 f[XLFD_RESX_INDEX] = "*-*-*-*", len += 6;
1023 } 1045 }
1024 else 1046 else
1025 f[XLFD_RESY_INDEX] = "*-*-*", len += 6; 1047 {
1048 Lisp_Object dpi = assq_no_quit (QCdpi, val);
1049 Lisp_Object spacing = assq_no_quit (QCspacing, val);
1050 Lisp_Object scalable = assq_no_quit (QCscalable, val);
1051
1052 if (CONSP (dpi) || CONSP (spacing) || CONSP (scalable))
1053 {
1054 char *str = alloca (24);
1055 int this_len;
1026 1056
1027 len += 3; /* for "-*" of resx, and terminating '\0'. */ 1057 if (CONSP (dpi) && INTEGERP (XCDR (dpi)))
1058 this_len = sprintf (str, "%d-%d",
1059 XINT (XCDR (dpi)), XINT (XCDR (dpi)));
1060 else
1061 this_len = sprintf (str, "*-*");
1062 if (CONSP (spacing) && ! NILP (XCDR (spacing)))
1063 {
1064 val = XCDR (spacing);
1065 if (INTEGERP (val))
1066 {
1067 if (XINT (val) < FONT_SPACING_MONO)
1068 val = Qp;
1069 else if (XINT (val) < FONT_SPACING_CHARCELL)
1070 val = Qm;
1071 else
1072 val = Qc;
1073 }
1074 xassert (SYMBOLP (val));
1075 this_len += sprintf (str + this_len, "-%c",
1076 SDATA (SYMBOL_NAME (val))[0]);
1077 }
1078 else
1079 this_len += sprintf (str + this_len, "-*");
1080 if (CONSP (scalable) && ! NILP (XCDR (spacing)))
1081 this_len += sprintf (str + this_len, "-0");
1082 else
1083 this_len += sprintf (str + this_len, "-*");
1084 f[XLFD_RESX_INDEX] = str;
1085 len += this_len;
1086 }
1087 else
1088 f[XLFD_RESX_INDEX] = "*-*-*-*", len += 8;
1089 }
1090
1091 len++; /* for terminating '\0'. */
1028 if (len >= nbytes) 1092 if (len >= nbytes)
1029 return -1; 1093 return -1;
1030 return sprintf (name, "-%s-%s-%s-%s-%s-%s-%s-*-%s-%s", 1094 return sprintf (name, "-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1031 f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX], 1095 f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
1032 f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX], 1096 f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
1033 f[XLFD_SWIDTH_INDEX], 1097 f[XLFD_SWIDTH_INDEX],
1034 f[XLFD_ADSTYLE_INDEX], pixel_point, 1098 f[XLFD_ADSTYLE_INDEX], f[XLFD_PIXEL_INDEX],
1035 f[XLFD_RESY_INDEX], f[XLFD_REGISTRY_INDEX]); 1099 f[XLFD_RESX_INDEX], f[XLFD_REGISTRY_INDEX]);
1036} 1100}
1037 1101
1038/* Parse NAME (null terminated) as Fonconfig's name format and store 1102/* Parse NAME (null terminated) as Fonconfig's name format and store
@@ -1040,40 +1104,39 @@ font_unparse_xlfd (font, pixel_size, name, nbytes)
1040 successfully parsed, return 0. Otherwise return -1. */ 1104 successfully parsed, return 0. Otherwise return -1. */
1041 1105
1042int 1106int
1043font_parse_fcname (name, font, merge) 1107font_parse_fcname (name, font)
1044 char *name; 1108 char *name;
1045 Lisp_Object font; 1109 Lisp_Object font;
1046 int merge;
1047{ 1110{
1048 char *p0, *p1; 1111 char *p0, *p1;
1049 Lisp_Object family = Qnil;
1050 double point_size = 0;
1051 int pixel_size = 0;
1052 Lisp_Object extra = AREF (font, FONT_EXTRA_INDEX);
1053 int len = strlen (name); 1112 int len = strlen (name);
1054 char *copy; 1113 char *copy;
1055 1114
1115 if (len == 0)
1116 return -1;
1056 /* It is assured that (name[0] && name[0] != '-'). */ 1117 /* It is assured that (name[0] && name[0] != '-'). */
1057 if (name[0] == ':') 1118 if (name[0] == ':')
1058 p0 = name; 1119 p0 = name;
1059 else 1120 else
1060 { 1121 {
1061 for (p0 = name + 1; *p0 && (*p0 != '-' && *p0 != ':'); p0++); 1122 Lisp_Object family;
1062 if (isdigit (name[0]) && *p0 != '-') 1123 double point_size;
1063 point_size = strtod (name, NULL); 1124
1064 else 1125 for (p0 = name + 1; *p0 && (*p0 != '-' && *p0 != ':'); p0++)
1126 if (*p0 == '\\' && p0[1])
1127 p0++;
1128 family = intern_font_field (name, p0 - name);
1129 if (*p0 == '-')
1065 { 1130 {
1066 family = intern_font_field (name, p0 - name); 1131 if (! isdigit (p0[1]))
1067 if (*p0 == '-') 1132 return -1;
1068 { 1133 point_size = strtod (p0 + 1, &p1);
1069 point_size = strtod (p0 + 1, &p1); 1134 if (*p1 && *p1 != ':')
1070 if (*p1 && *p1 != ':') 1135 return -1;
1071 return -1; 1136 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
1072 p0 = p1; 1137 p0 = p1;
1073 }
1074 } 1138 }
1075 if (! merge || NILP (AREF (font, FONT_FAMILY_INDEX))) 1139 ASET (font, FONT_FAMILY_INDEX, family);
1076 ASET (font, FONT_FAMILY_INDEX, family);
1077 } 1140 }
1078 1141
1079 len -= p0 - name; 1142 len -= p0 - name;
@@ -1087,41 +1150,33 @@ font_parse_fcname (name, font, merge)
1087 while (*p0) 1150 while (*p0)
1088 { 1151 {
1089 Lisp_Object key, val; 1152 Lisp_Object key, val;
1090 enum font_property_index prop; 1153 int prop;
1091 1154
1092 for (p1 = p0 + 1; islower (*p1); p1++); 1155 for (p1 = p0 + 1; *p1 && *p1 != '=' && *p1 != ':'; p1++);
1093 if (*p1 != '=') 1156 if (*p1 != '=')
1094 { 1157 {
1095 /* Must be an enumerated value. */ 1158 /* Must be an enumerated value. */
1096 val = intern_font_field (p0 + 1, p1 - p0 - 1); 1159 val = intern_font_field (p0 + 1, p1 - p0 - 1);
1097
1098 if (memcmp (p0 + 1, "light", 5) == 0 1160 if (memcmp (p0 + 1, "light", 5) == 0
1099 || memcmp (p0 + 1, "medium", 6) == 0 1161 || memcmp (p0 + 1, "medium", 6) == 0
1100 || memcmp (p0 + 1, "demibold", 8) == 0 1162 || memcmp (p0 + 1, "demibold", 8) == 0
1101 || memcmp (p0 + 1, "bold", 4) == 0 1163 || memcmp (p0 + 1, "bold", 4) == 0
1102 || memcmp (p0 + 1, "black", 5) == 0) 1164 || memcmp (p0 + 1, "black", 5) == 0)
1103 { 1165 {
1104 if (! merge || NILP (AREF (font, FONT_WEIGHT_INDEX))) 1166 ASET (font, FONT_WEIGHT_INDEX, val);
1105 ASET (font, FONT_WEIGHT_INDEX,
1106 prop_name_to_numeric (FONT_WEIGHT_INDEX, val));
1107 } 1167 }
1108 else if (memcmp (p0 + 1, "roman", 5) == 0 1168 else if (memcmp (p0 + 1, "roman", 5) == 0
1109 || memcmp (p0 + 1, "italic", 6) == 0 1169 || memcmp (p0 + 1, "italic", 6) == 0
1110 || memcmp (p0 + 1, "oblique", 7) == 0) 1170 || memcmp (p0 + 1, "oblique", 7) == 0)
1111 { 1171 {
1112 if (! merge || NILP (AREF (font, FONT_SLANT_INDEX))) 1172 ASET (font, FONT_SLANT_INDEX, val);
1113 ASET (font, FONT_SLANT_INDEX,
1114 prop_name_to_numeric (FONT_SLANT_INDEX, val));
1115 } 1173 }
1116 else if (memcmp (p0 + 1, "charcell", 8) == 0 1174 else if (memcmp (p0 + 1, "charcell", 8) == 0
1117 || memcmp (p0 + 1, "mono", 4) == 0 1175 || memcmp (p0 + 1, "mono", 4) == 0
1118 || memcmp (p0 + 1, "proportional", 12) == 0) 1176 || memcmp (p0 + 1, "proportional", 12) == 0)
1119 { 1177 {
1120 font_put_extra (font, QCspacing, 1178 font_put_extra (font, QCspacing,
1121 p0[1] == 'c' ? make_number (FONT_SPACING_CHARCELL) 1179 (p0[1] == 'c' ? Qc : p0[1] == 'm' ? Qm : Qp));
1122 : p0[1] == 'm' ? make_number (FONT_SPACING_MONO)
1123 : make_number (FONT_SPACING_PROPORTIONAL),
1124 merge);
1125 } 1180 }
1126 else 1181 else
1127 { 1182 {
@@ -1139,50 +1194,32 @@ font_parse_fcname (name, font, merge)
1139 else 1194 else
1140 { 1195 {
1141 key = intern_font_field (p0, p1 - p0); 1196 key = intern_font_field (p0, p1 - p0);
1142 prop = check_font_prop_name (key); 1197 prop = get_font_prop_index (key, 0);
1143 } 1198 }
1144 p0 = p1 + 1; 1199 p0 = p1 + 1;
1145 for (p1 = p0; *p1 && *p1 != ':'; p1++); 1200 for (p1 = p0; *p1 && *p1 != ':'; p1++);
1146 if (prop == FONT_SIZE_INDEX) 1201 val = intern_font_field (p0, p1 - p0);
1202 if (! NILP (val))
1147 { 1203 {
1148 pixel_size = atoi (p0); 1204 if (prop >= 0 && prop < FONT_EXTRA_INDEX)
1149 }
1150 else if (prop < FONT_EXTRA_INDEX)
1151 {
1152 if (! merge || NILP (AREF (font, prop)))
1153 { 1205 {
1154 val = intern_font_field (p0, p1 - p0); 1206 ASET (font, prop, val);
1155 if (prop >= FONT_WEIGHT_INDEX && prop <= FONT_WIDTH_INDEX) 1207 }
1156 val = font_property_table[prop].validater (prop, val); 1208 else if (prop > 0)
1157 if (! EQ (val, Qerror)) 1209 font_put_extra (font, key, val);
1158 ASET (font, prop, val); 1210 else
1211 {
1212 /* Unknown attribute, keep it in name. */
1213 bcopy (pbeg, copy, p1 - pbeg);
1214 copy += p1 - pbeg;
1159 } 1215 }
1160 }
1161 else if (EQ (key, QCdpi))
1162 {
1163 if (INTEGERP (val))
1164 font_put_extra (font, key, val, merge);
1165 }
1166 else
1167 {
1168 /* unknown key */
1169 bcopy (pbeg, copy, p1 - pbeg);
1170 copy += p1 - pbeg;
1171 } 1216 }
1172 } 1217 }
1173 p0 = p1; 1218 p0 = p1;
1174 } 1219 }
1175 1220
1176 if (! merge || NILP (AREF (font, FONT_SIZE_INDEX)))
1177 {
1178 if (pixel_size > 0)
1179 ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
1180 else if (point_size > 0)
1181 ASET (font, FONT_SIZE_INDEX, make_float (point_size));
1182 }
1183 if (name < copy) 1221 if (name < copy)
1184 font_put_extra (font, QCname, make_unibyte_string (name, copy - name), 1222 font_put_extra (font, QCname, make_unibyte_string (name, copy - name));
1185 merge);
1186 1223
1187 return 0; 1224 return 0;
1188} 1225}
@@ -1198,34 +1235,38 @@ font_unparse_fcname (font, pixel_size, name, nbytes)
1198 char *name; 1235 char *name;
1199 int nbytes; 1236 int nbytes;
1200{ 1237{
1201 Lisp_Object val, size; 1238 Lisp_Object val;
1202 int pt = 0; 1239 int point_size;
1203 int i, j, len = 1; 1240 int dpi, spacing, scalable;
1241 int i, len = 1;
1204 char *p; 1242 char *p;
1205 Lisp_Object styles[3]; 1243 Lisp_Object styles[3];
1206 char *style_names[3] = { "weight", "slant", "swidth" }; 1244 char *style_names[3] = { "weight", "slant", "swidth" };
1207 1245
1208 if (SYMBOLP (AREF (font, FONT_FAMILY_INDEX)) 1246 val = AREF (font, FONT_FAMILY_INDEX);
1209 && ! NILP (AREF (font, FONT_FAMILY_INDEX))) 1247 if (SYMBOLP (val) && ! NILP (val))
1210 len += SBYTES (SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX))); 1248 len += SBYTES (SYMBOL_NAME (val));
1211 size = AREF (font, FONT_SIZE_INDEX); 1249
1212 if (INTEGERP (size)) 1250 val = AREF (font, FONT_SIZE_INDEX);
1251 if (INTEGERP (val))
1213 { 1252 {
1214 if (XINT (size) > 0) 1253 if (XINT (val) != 0)
1215 pixel_size = XINT (size); 1254 pixel_size = XINT (val);
1216 if (pixel_size > 0) 1255 point_size = -1;
1217 len += 21; /* for ":pixelsize=NUM" */ 1256 len += 21; /* for ":pixelsize=NUM" */
1218 } 1257 }
1219 else if (FLOATP (size)) 1258 else if (FLOATP (val))
1220 { 1259 {
1221 pt = (int) XFLOAT_DATA (size); 1260 pixel_size = -1;
1222 if (pt > 0) 1261 point_size = (int) XFLOAT_DATA (val);
1223 len += 11; /* for "-NUM" */ 1262 len += 11; /* for "-NUM" */
1224 } 1263 }
1225 if (SYMBOLP (AREF (font, FONT_FOUNDRY_INDEX)) 1264
1226 && ! NILP (AREF (font, FONT_FOUNDRY_INDEX))) 1265 val = AREF (font, FONT_FOUNDRY_INDEX);
1266 if (! NILP (val))
1227 /* ":foundry=NAME" */ 1267 /* ":foundry=NAME" */
1228 len += 9 + SBYTES (SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX))); 1268 len += 9 + SBYTES (SYMBOL_NAME (val));
1269
1229 for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++) 1270 for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
1230 { 1271 {
1231 val = AREF (font, i); 1272 val = AREF (font, i);
@@ -1237,14 +1278,55 @@ font_unparse_fcname (font, pixel_size, name, nbytes)
1237 } 1278 }
1238 styles[i - FONT_WEIGHT_INDEX] = val; 1279 styles[i - FONT_WEIGHT_INDEX] = val;
1239 } 1280 }
1281
1282 val = AREF (font, FONT_EXTRA_INDEX);
1283 if (FONT_ENTITY_P (font)
1284 && EQ (AREF (font, FONT_TYPE_INDEX), Qx))
1285 {
1286 char *p;
1287
1288 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1289 p = (char *) SDATA (SYMBOL_NAME (val));
1290 dpi = atoi (p);
1291 for (p++; *p != '-'; p++); /* skip RESX */
1292 for (p++; *p != '-'; p++); /* skip RESY */
1293 spacing = (*p == 'c' ? FONT_SPACING_CHARCELL
1294 : *p == 'm' ? FONT_SPACING_MONO
1295 : FONT_SPACING_PROPORTIONAL);
1296 for (p++; *p != '-'; p++); /* skip SPACING */
1297 scalable = (atoi (p) == 0);
1298 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1299 len += 42;
1300 }
1301 else
1302 {
1303 Lisp_Object elt;
1304
1305 dpi = spacing = scalable = -1;
1306 elt = assq_no_quit (QCdpi, val);
1307 if (CONSP (elt))
1308 dpi = XINT (XCDR (elt)), len += 15; /* for ":dpi=NUM" */
1309 elt = assq_no_quit (QCspacing, val);
1310 if (CONSP (elt))
1311 spacing = XINT (XCDR (elt)), len += 12; /* for ":spacing=100" */
1312 elt = assq_no_quit (QCscalable, val);
1313 if (CONSP (elt))
1314 scalable = ! NILP (XCDR (elt)), len += 15; /* for ":scalable=False" */
1315 }
1316
1240 if (len > nbytes) 1317 if (len > nbytes)
1241 return -1; 1318 return -1;
1242 p = name; 1319 p = name;
1243 if (! NILP (AREF (font, FONT_FAMILY_INDEX))) 1320 if (! NILP (AREF (font, FONT_FAMILY_INDEX)))
1244 p += sprintf(p, "%s", 1321 p += sprintf(p, "%s",
1245 SDATA (SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX)))); 1322 SDATA (SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX))));
1246 if (pt > 0) 1323 if (point_size > 0)
1247 p += sprintf (p, "-%d", pt); 1324 {
1325 if (p == name)
1326 p += sprintf (p, "%d", point_size);
1327 else
1328 p += sprintf (p, "-%d", point_size);
1329 }
1248 else if (pixel_size > 0) 1330 else if (pixel_size > 0)
1249 p += sprintf (p, ":pixelsize=%d", pixel_size); 1331 p += sprintf (p, ":pixelsize=%d", pixel_size);
1250 if (SYMBOLP (AREF (font, FONT_FOUNDRY_INDEX)) 1332 if (SYMBOLP (AREF (font, FONT_FOUNDRY_INDEX))
@@ -1255,29 +1337,39 @@ font_unparse_fcname (font, pixel_size, name, nbytes)
1255 if (! NILP (styles [i])) 1337 if (! NILP (styles [i]))
1256 p += sprintf (p, ":%s=%s", style_names[i], 1338 p += sprintf (p, ":%s=%s", style_names[i],
1257 SDATA (SYMBOL_NAME (styles [i]))); 1339 SDATA (SYMBOL_NAME (styles [i])));
1340 if (dpi >= 0)
1341 p += sprintf (p, ":dpi=%d", dpi);
1342 if (spacing >= 0)
1343 p += sprintf (p, ":spacing=%d", spacing);
1344 if (scalable > 0)
1345 p += sprintf (p, ":scalable=True");
1346 else if (scalable == 0)
1347 p += sprintf (p, ":scalable=False");
1258 return (p - name); 1348 return (p - name);
1259} 1349}
1260 1350
1261/* Parse NAME (null terminated) and store information in FONT 1351/* Parse NAME (null terminated) and store information in FONT
1262 (font-spec or font-entity). If NAME is successfully parsed, return 1352 (font-spec or font-entity). If NAME is successfully parsed, return
1263 a non-negative value. Otherwise return -1. 1353 0. Otherwise return -1.
1264 1354
1265 If NAME is XLFD and FONT is a font-entity, store 1355 If NAME is XLFD and FONT is a font-entity, store
1266 RESY-SPACING-AVWIDTH information as a symbol in FONT_EXTRA_INDEX. 1356 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1267 1357 FONT_EXTRA_INDEX. */
1268 If MERGE is nonzero, set a property of FONT only when it's nil. */
1269 1358
1270static int 1359static int
1271font_parse_name (name, font, merge) 1360font_parse_name (name, font)
1272 char *name; 1361 char *name;
1273 Lisp_Object font; 1362 Lisp_Object font;
1274 int merge;
1275{ 1363{
1276 if (name[0] == '-' || index (name, '*')) 1364 if (name[0] == '-' || index (name, '*'))
1277 return font_parse_xlfd (name, font, merge); 1365 {
1278 if (name[0]) 1366 if (font_parse_xlfd (name, font) == 0)
1279 return font_parse_fcname (name, font, merge); 1367 return 0;
1280 return -1; 1368 font_put_extra (font, QCname, make_unibyte_string (name, strlen (name)));
1369 return -1;
1370 }
1371 font_put_extra (font, QCname, make_unibyte_string (name, strlen (name)));
1372 return font_parse_fcname (name, font);
1281} 1373}
1282 1374
1283void 1375void
@@ -1286,7 +1378,7 @@ font_merge_old_spec (name, family, registry, spec)
1286{ 1378{
1287 if (STRINGP (name)) 1379 if (STRINGP (name))
1288 { 1380 {
1289 if (font_parse_xlfd ((char *) SDATA (name), spec, 1) < 0) 1381 if (font_parse_xlfd ((char *) SDATA (name), spec) < 0)
1290 { 1382 {
1291 Lisp_Object extra = Fcons (Fcons (QCname, name), Qnil); 1383 Lisp_Object extra = Fcons (Fcons (QCname, name), Qnil);
1292 1384
@@ -2385,17 +2477,17 @@ font_find_for_lface (f, lface, spec)
2385 2477
2386 if (ASIZE (entities) > 1) 2478 if (ASIZE (entities) > 1)
2387 { 2479 {
2388 Lisp_Object prefer = scratch_font_prefer, val; 2480 Lisp_Object prefer = scratch_font_prefer;
2389 double pt; 2481 double pt;
2390 2482
2391 ASET (prefer, FONT_WEIGHT_INDEX, 2483 ASET (prefer, FONT_WEIGHT_INDEX,
2392 font_prop_validate_style (FONT_WEIGHT_INDEX, 2484 font_prop_validate_style (FONT_WEIGHT_INDEX, QCweight,
2393 lface[LFACE_WEIGHT_INDEX])); 2485 lface[LFACE_WEIGHT_INDEX]));
2394 ASET (prefer, FONT_SLANT_INDEX, 2486 ASET (prefer, FONT_SLANT_INDEX,
2395 font_prop_validate_style (FONT_SLANT_INDEX, 2487 font_prop_validate_style (FONT_SLANT_INDEX, QCslant,
2396 lface[LFACE_SLANT_INDEX])); 2488 lface[LFACE_SLANT_INDEX]));
2397 ASET (prefer, FONT_WIDTH_INDEX, 2489 ASET (prefer, FONT_WIDTH_INDEX,
2398 font_prop_validate_style (FONT_WIDTH_INDEX, 2490 font_prop_validate_style (FONT_WIDTH_INDEX, QCwidth,
2399 lface[LFACE_SWIDTH_INDEX])); 2491 lface[LFACE_SWIDTH_INDEX]));
2400 pt = XINT (lface[LFACE_HEIGHT_INDEX]); 2492 pt = XINT (lface[LFACE_HEIGHT_INDEX]);
2401 ASET (prefer, FONT_SIZE_INDEX, make_float (pt / 10)); 2493 ASET (prefer, FONT_SIZE_INDEX, make_float (pt / 10));
@@ -2485,7 +2577,6 @@ font_open_by_name (f, name)
2485 Lisp_Object args[2]; 2577 Lisp_Object args[2];
2486 Lisp_Object spec, prefer, size, entities; 2578 Lisp_Object spec, prefer, size, entities;
2487 Lisp_Object frame; 2579 Lisp_Object frame;
2488 struct font_driver_list *dlist;
2489 int i; 2580 int i;
2490 int pixel_size; 2581 int pixel_size;
2491 2582
@@ -2602,7 +2693,6 @@ usage: (font-spec &rest properties) */)
2602 Lisp_Object *args; 2693 Lisp_Object *args;
2603{ 2694{
2604 Lisp_Object spec = Fmake_vector (make_number (FONT_SPEC_MAX), Qnil); 2695 Lisp_Object spec = Fmake_vector (make_number (FONT_SPEC_MAX), Qnil);
2605 Lisp_Object extra = Qnil, name = Qnil;
2606 int i; 2696 int i;
2607 2697
2608 for (i = 0; i < nargs; i += 2) 2698 for (i = 0; i < nargs; i += 2)
@@ -2610,20 +2700,21 @@ usage: (font-spec &rest properties) */)
2610 enum font_property_index prop; 2700 enum font_property_index prop;
2611 Lisp_Object key = args[i], val = args[i + 1]; 2701 Lisp_Object key = args[i], val = args[i + 1];
2612 2702
2613 prop = check_font_prop_name (key); 2703 prop = get_font_prop_index (key, 0);
2614 if (prop < FONT_EXTRA_INDEX) 2704 if (prop < FONT_EXTRA_INDEX)
2615 ASET (spec, prop, (font_property_table[prop].validater) (prop, val)); 2705 ASET (spec, prop, val);
2616 else 2706 else
2617 { 2707 {
2618 if (EQ (key, QCname)) 2708 if (EQ (key, QCname))
2619 name = val; 2709 {
2710 CHECK_STRING (val);
2711 font_parse_name ((char *) SDATA (val), spec);
2712 }
2620 else 2713 else
2621 extra = Fcons (Fcons (key, val), extra); 2714 font_put_extra (spec, key, val);
2622 } 2715 }
2623 } 2716 }
2624 ASET (spec, FONT_EXTRA_INDEX, extra); 2717 CHECK_VALIDATE_FONT_SPEC (spec);
2625 if (STRINGP (name))
2626 font_parse_name (SDATA (name), spec, 0);
2627 return spec; 2718 return spec;
2628} 2719}
2629 2720
@@ -2638,7 +2729,7 @@ If FONT is font-entity and PROP is :extra, always nil is returned. */)
2638 enum font_property_index idx; 2729 enum font_property_index idx;
2639 2730
2640 CHECK_FONT (font); 2731 CHECK_FONT (font);
2641 idx = check_font_prop_name (prop); 2732 idx = get_font_prop_index (prop, 0);
2642 if (idx < FONT_EXTRA_INDEX) 2733 if (idx < FONT_EXTRA_INDEX)
2643 return AREF (font, idx); 2734 return AREF (font, idx);
2644 if (FONT_ENTITY_P (font)) 2735 if (FONT_ENTITY_P (font))
@@ -2656,7 +2747,7 @@ DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
2656 Lisp_Object extra, slot; 2747 Lisp_Object extra, slot;
2657 2748
2658 CHECK_FONT_SPEC (font_spec); 2749 CHECK_FONT_SPEC (font_spec);
2659 idx = check_font_prop_name (prop); 2750 idx = get_font_prop_index (prop, 0);
2660 if (idx < FONT_EXTRA_INDEX) 2751 if (idx < FONT_EXTRA_INDEX)
2661 return ASET (font_spec, idx, val); 2752 return ASET (font_spec, idx, val);
2662 extra = AREF (font_spec, FONT_EXTRA_INDEX); 2753 extra = AREF (font_spec, FONT_EXTRA_INDEX);
@@ -2672,8 +2763,8 @@ DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
2672 doc: /* List available fonts matching FONT-SPEC on the current frame. 2763 doc: /* List available fonts matching FONT-SPEC on the current frame.
2673Optional 2nd argument FRAME specifies the target frame. 2764Optional 2nd argument FRAME specifies the target frame.
2674Optional 3rd argument NUM, if non-nil, limits the number of returned fonts. 2765Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
2675Optional 4th argument PREFER, if non-nil, is a font-spec to sort fonts 2766Optional 4th argument PREFER, if non-nil, is a font-spec
2676by closeness to PREFER. */) 2767to which closeness fonts are sorted. */)
2677 (font_spec, frame, num, prefer) 2768 (font_spec, frame, num, prefer)
2678 Lisp_Object font_spec, frame, num, prefer; 2769 Lisp_Object font_spec, frame, num, prefer;
2679{ 2770{
@@ -3089,6 +3180,21 @@ Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. *
3089 return vec; 3180 return vec;
3090} 3181}
3091 3182
3183DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
3184 doc: /* Return t iff font-spec SPEC matches with FONT.
3185FONT is a font-spec, font-entity, or font-object. */)
3186 (spec, font)
3187 Lisp_Object spec, font;
3188{
3189 CHECK_FONT_SPEC (spec);
3190 if (FONT_OBJECT_P (font))
3191 font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
3192 else if (! FONT_ENTITY_P (font))
3193 CHECK_FONT_SPEC (font);
3194
3195 return (font_match_p (spec, font) ? Qt : Qnil);
3196}
3197
3092#if 0 3198#if 0
3093DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0, 3199DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
3094 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame. 3200 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
@@ -3176,8 +3282,14 @@ syms_of_font ()
3176 DEFSYM (QCregistry, ":registry"); 3282 DEFSYM (QCregistry, ":registry");
3177 DEFSYM (QCspacing, ":spacing"); 3283 DEFSYM (QCspacing, ":spacing");
3178 DEFSYM (QCdpi, ":dpi"); 3284 DEFSYM (QCdpi, ":dpi");
3285 DEFSYM (QCscalable, ":scalable");
3179 DEFSYM (QCextra, ":extra"); 3286 DEFSYM (QCextra, ":extra");
3180 3287
3288 DEFSYM (Qc, "c");
3289 DEFSYM (Qm, "m");
3290 DEFSYM (Qp, "p");
3291 DEFSYM (Qd, "d");
3292
3181 staticpro (&null_string); 3293 staticpro (&null_string);
3182 null_string = build_string (""); 3294 null_string = build_string ("");
3183 staticpro (&null_vector); 3295 staticpro (&null_vector);
@@ -3206,6 +3318,7 @@ syms_of_font ()
3206 defsubr (&Sclose_font); 3318 defsubr (&Sclose_font);
3207 defsubr (&Squery_font); 3319 defsubr (&Squery_font);
3208 defsubr (&Sget_font_glyphs); 3320 defsubr (&Sget_font_glyphs);
3321 defsubr (&Sfont_match_p);
3209#if 0 3322#if 0
3210 defsubr (&Sdraw_string); 3323 defsubr (&Sdraw_string);
3211#endif 3324#endif