Mercurial > hg > xemacs-beta

comparison lisp/fontconfig.el @ 5923:61d7d7bcbe76 cygwin

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merged heads after pull -u
author Henry Thompson <ht@markup.co.uk>
date Thu, 05 Feb 2015 17:19:05 +0000
parents 2dee57a2c2d6
children
comparison
equal deleted inserted replaced
5921:68639fb08af8 5923:61d7d7bcbe76
536 (defun fc-name-parse-harder (fontname) 536 (defun fc-name-parse-harder (fontname)
537 "Parse an Fc font name and return its representation as a Fc pattern object. 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 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 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'.)" 540 unparsed objects are listed in `fc-name-parse-known-problem-attributes'.)"
541 (labels ((repair-embedded-colons (l) 541 (let* ((objects (split-string-by-char fontname ?: ?\\))
542 ;; #### May need generalization to other separators? 542 name omits display)
543 (let ((ll l)) 543 (labels ((prefixp (haystack needle)
544 (while (cdr l) 544 "Return non-nil if HAYSTACK starts with NEEDLE."
545 (when (string-match ".*\\\\$" (cadr l)) 545 (not (mismatch haystack needle :end1 (length needle))))
546 (setcdr l (cons (concat (cadr l) ":" (caddr l)) (cdddr l)))) 546 (prepare-omit (object)
547 (setq l (cdr l))) 547 (setq display
548 ll)) 548 (or (if (find object
549 (prepare-omits (object) 549 fc-name-parse-known-problem-attributes
550 (declare (special display)) 550 :test #'prefixp)
551 (let* ((reports fc-name-parse-known-problem-attributes) 551 (progn
552 (report (car reports)) 552 (setq object (concat "(KNOWN) " object))
553 (display-this t)) 553 ;; This attribute is known, don't display the
554 (while reports 554 ;; error based on it alone.
555 (if (string= report (subseq object 0 (length report))) 555 nil)
556 (setq object (concat "(KNOWN) " object) 556 ;; Attribute is not known.
557 display-this nil 557 t)
558 reports nil) 558 ;; Otherwise, if we're already decided we need to
559 (setq report (pop reports)))) 559 ;; show them, respect that.
560 (push display-this display) 560 display))
561 (concat object "\n"))) 561 object)
562 (any (bools) 562 (fontconfig-quote (string)
563 (let (ret) 563 (mapconcat #'identity (split-string-by-char string ?:) #r"\:")))
564 (while bools 564 (when (find ?: objects :test #'position)
565 (setq ret (or (pop bools) ret)))))) 565 (setq objects (mapcar #'fontconfig-quote objects)))
566 (let* ((objects (repair-embedded-colons (split-string fontname ":"))) 566 (setq name (pop objects))
567 (name (pop objects)) 567 (dolist (object objects)
568 (omits nil) 568 (condition-case nil
569 (outcomes (list 'dummy))) 569 (let ((try (concat name ":" object)))
570 (while objects 570 (fc-name-parse try)
571 (let ((object (pop objects))) 571 (setq name try))
572 (condition-case nil 572 (invalid-argument (push object omits))))
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 573 (when omits
579 (setq display nil) 574 (setq omits (mapconcat #'prepare-omit omits "\n"))
580 (setq omits (mapconcat #'prepare-omits omits "")) 575 (lwarn 'fontconfig (if display 'warning 'info)
581 (lwarn 'fontconfig (if (apply #'any display) 'warning 'info) 576 "Some objects in fontname weren't parsed (details in *Warnings*).
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. 577 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 578 Please report any unparseable objects below not marked as KNOWN with
585 M-x report-xemacs-bug. Objects:\n%sFontname:\n%s" 579 M-x report-xemacs-bug. Objects:\n%sFontname:\n%s" omits fontname))
586 omits 580 (fc-name-parse name))))
587 fontname))
588 (fc-name-parse name)
589 )))
590 581
591 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 582 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
592 ;; 583 ;;
593 ;; The XLFD fontname UI 584 ;; The XLFD fontname UI
594 ;; 585 ;;