comparison lisp/fontconfig.el @ 5763:23dc211f4d2f

Make fc-name-parse signal on invalid-argument. Add fc-name-parse-harder, which retries without unparseable attributes. Add tests for fc-name-parse and fc-name-parse-harder. A few fixups in comments and docstrings.
author Stephen J. Turnbull <stephen@xemacs.org>
date Sun, 15 Sep 2013 23:50:20 +0900
parents 4dee0387b9de
children 2dee57a2c2d6
comparison
equal deleted inserted replaced
5762:427a72c6ee17 5763:23dc211f4d2f
1 ;;; fontconfig.el --- New font model, NG 1 ;;; fontconfig.el --- New font model, NG
2 2
3 ;; Copyright (c) 2003 Eric Knauel and Matthias Neubauer 3 ;; Copyright (c) 2003 Eric Knauel and Matthias Neubauer
4 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. 4 ;; Copyright (C) 2004, 2005, 2013 Free Software Foundation, Inc.
5 5
6 ;; Authors: Eric Knauel <knauel@informatik.uni-tuebingen.de> 6 ;; Authors: Eric Knauel <knauel@informatik.uni-tuebingen.de>
7 ;; Matthias Neubauer <neubauer@informatik.uni-freiburg.de> 7 ;; Matthias Neubauer <neubauer@informatik.uni-freiburg.de>
8 ;; Stephen J. Turnbull <stephen@xemacs.org> 8 ;; Stephen J. Turnbull <stephen@xemacs.org>
9 ;; Created: 27 Oct 2003 9 ;; Created: 27 Oct 2003
517 (fc-font-weight-translate-from-constant fc-weight-constant)))) 517 (fc-font-weight-translate-from-constant fc-weight-constant))))
518 (fc-list-fonts-pattern-objects device pattern objectset)))) 518 (fc-list-fonts-pattern-objects device pattern objectset))))
519 519
520 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 520 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
521 ;; 521 ;;
522 ;; Workarounds
523 ;;
524
525 (defvar fc-name-parse-known-problem-attributes
526 '("charset")
527 "List of attribute names known to induce fc-name-parse failures.
528
529 Note: The name returned by `xft-font-truename' has been observed to be
530 unparseable. The cause is unknown so you can't assume getting a name from a
531 font instance then instantiating the font again will round-trip. Hypotheses:
532 \(1) name too long. FALSE
533 \(2) name has postscriptname attribute. FALSE
534 \(3) name has charset attribute. OBSERVED")
535
536 (defun fc-name-parse-harder (fontname)
537 "Parse an Fc font name and return its representation as a Fc pattern object.
538 Unlike `fc-parse-name', unparseable objects are skipped and reported in the
539 *Warnings* buffer. \(The *Warnings* buffer is popped up unless all of the
540 unparsed objects are listed in `fc-name-parse-known-problem-attributes'.)"
541 (labels ((repair-embedded-colons (l)
542 ;; #### May need generalization to other separators?
543 (let ((ll l))
544 (while (cdr l)
545 (when (string-match ".*\\\\$" (cadr l))
546 (setcdr l (cons (concat (cadr l) ":" (caddr l)) (cdddr l))))
547 (setq l (cdr l)))
548 ll))
549 (prepare-omits (object)
550 (declare (special display))
551 (let* ((reports fc-name-parse-known-problem-attributes)
552 (report (car reports))
553 (display-this t))
554 (while reports
555 (if (string= report (subseq object 0 (length report)))
556 (setq object (concat "(KNOWN) " object)
557 display-this nil
558 reports nil)
559 (setq report (pop reports))))
560 (push display-this display)
561 (concat object "\n")))
562 (any (bools)
563 (let (ret)
564 (while bools
565 (setq ret (or (pop bools) ret))))))
566 (let* ((objects (repair-embedded-colons (split-string fontname ":")))
567 (name (pop objects))
568 (omits nil)
569 (outcomes (list 'dummy)))
570 (while objects
571 (let ((object (pop objects)))
572 (condition-case nil
573 (let ((try (concat name ":" object)))
574 (fc-name-parse try)
575 (setq name try))
576 (invalid-argument
577 (push object omits)))))
578 (when omits
579 (setq display nil)
580 (setq omits (mapconcat #'prepare-omits omits ""))
581 (lwarn 'fontconfig (if (apply #'any display) 'warning 'info)
582 "Some objects in fontname weren't parsed (details in *Warnings*).
583 This shouldn't affect your XEmacs except that the font may be inaccurate.
584 Please report any unparseable objects below not marked as KNOWN with
585 M-x report-xemacs-bug. Objects:\n%sFontname:\n%s"
586 omits
587 fontname))
588 (fc-name-parse name)
589 )))
590
591 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
592 ;;
522 ;; The XLFD fontname UI 593 ;; The XLFD fontname UI
523 ;; 594 ;;
524 595
525 ;; xlfd-font-name-p 596 ;; xlfd-font-name-p
526 597