Mercurial > hg > xemacs-beta
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 |