--- a/lisp/fontconfig.el	Sun Sep 15 23:47:37 2013 +0900
+++ b/lisp/fontconfig.el	Sun Sep 15 23:50:20 2013 +0900
@@ -1,7 +1,7 @@
 ;;; fontconfig.el --- New font model, NG
 
 ;; Copyright (c) 2003 Eric Knauel and Matthias Neubauer
-;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005, 2013 Free Software Foundation, Inc.
 
 ;; Authors:	Eric Knauel <knauel@informatik.uni-tuebingen.de>
 ;;		Matthias Neubauer <neubauer@informatik.uni-freiburg.de>
@@ -519,6 +519,77 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
+;; Workarounds
+;;
+
+(defvar fc-name-parse-known-problem-attributes
+  '("charset")
+  "List of attribute names known to induce fc-name-parse failures.
+
+Note: The name returned by `xft-font-truename' has been observed to be
+unparseable.  The cause is unknown so you can't assume getting a name from a
+font instance then instantiating the font again will round-trip.  Hypotheses:
+\(1) name too long. FALSE
+\(2) name has postscriptname attribute. FALSE
+\(3) name has charset attribute. OBSERVED")
+
+(defun fc-name-parse-harder (fontname)
+  "Parse an Fc font name and return its representation as a Fc pattern object.
+Unlike `fc-parse-name', unparseable objects are skipped and reported in the
+*Warnings* buffer.  \(The *Warnings* buffer is popped up unless all of the
+unparsed objects are listed in `fc-name-parse-known-problem-attributes'.)"
+  (labels ((repair-embedded-colons (l)
+	     ;; #### May need generalization to other separators?
+	     (let ((ll l))
+	       (while (cdr l)
+	         (when (string-match ".*\\\\$" (cadr l))
+		   (setcdr l (cons (concat (cadr l) ":" (caddr l)) (cdddr l))))
+	         (setq l (cdr l)))
+	       ll))
+	   (prepare-omits (object)
+	     (declare (special display))
+	     (let* ((reports fc-name-parse-known-problem-attributes)
+		    (report (car reports))
+		    (display-this t))
+	       (while reports
+		 (if (string= report (subseq object 0 (length report)))
+		     (setq object (concat "(KNOWN) " object)
+			   display-this nil
+			   reports nil)
+		   (setq report (pop reports))))
+	       (push display-this display)
+	       (concat object "\n")))
+	   (any (bools)
+	     (let (ret)
+	       (while bools
+		 (setq ret (or (pop bools) ret))))))
+    (let* ((objects (repair-embedded-colons (split-string fontname ":")))
+	   (name (pop objects))
+	   (omits nil)
+	   (outcomes (list 'dummy)))
+      (while objects
+        (let ((object (pop objects)))
+	  (condition-case nil
+	      (let ((try (concat name ":" object)))
+	        (fc-name-parse try)
+	        (setq name try))
+	    (invalid-argument
+	     (push object omits)))))
+      (when omits
+	(setq display nil)
+	(setq omits (mapconcat #'prepare-omits omits ""))
+	(lwarn 'fontconfig (if (apply #'any display) 'warning 'info)
+	  "Some objects in fontname weren't parsed (details in *Warnings*).
+This shouldn't affect your XEmacs except that the font may be inaccurate.
+Please report any unparseable objects below not marked as KNOWN with
+M-x report-xemacs-bug.  Objects:\n%sFontname:\n%s"
+	  omits
+	  fontname))
+      (fc-name-parse name)
+      )))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
 ;; The XLFD fontname UI
 ;;