# HG changeset patch
# User Aidan Kehoe <kehoea@parhasard.net>
# Date 1407316765 -3600
# Node ID 2dee57a2c2d6579c30cc5cc74181cd42a3873bf5
# Parent  8139bdf8db044f7bbd89b4c7e7bde26da6fb6b99
Improve style, #'fc-name-parse-harder.

lisp/ChangeLog addition:

2014-08-06  Aidan Kehoe  <kehoea@parhasard.net>

	* fontconfig.el (fc-name-parse-harder):
	Improve style here, don't re-implement #'split-string-by-char with
	its ESCAPE-CHAR argument, look for a string prefix in a list of
	candidates in a more CL-idiomatic way, use the language's features
	for boolean or.

diff -r 8139bdf8db04 -r 2dee57a2c2d6 lisp/ChangeLog
--- a/lisp/ChangeLog	Sun Aug 03 20:25:03 2014 +0100
+++ b/lisp/ChangeLog	Wed Aug 06 10:19:25 2014 +0100
@@ -1,3 +1,11 @@
+2014-08-06  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fontconfig.el (fc-name-parse-harder):
+	Improve style here, don't re-implement #'split-string-by-char with
+	its ESCAPE-CHAR argument, look for a string prefix in a list of
+	candidates in a more CL-idiomatic way, use the language's features
+	for boolean or.
+
 2014-07-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* simple.el (raw-append-message):
diff -r 8139bdf8db04 -r 2dee57a2c2d6 lisp/fontconfig.el
--- a/lisp/fontconfig.el	Sun Aug 03 20:25:03 2014 +0100
+++ b/lisp/fontconfig.el	Wed Aug 06 10:19:25 2014 +0100
@@ -538,55 +538,46 @@
 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)))))
+  (let* ((objects (split-string-by-char fontname ?: ?\\))
+         name omits display)
+    (labels ((prefixp (haystack needle)
+               "Return non-nil if HAYSTACK starts with NEEDLE."
+               (not (mismatch haystack needle :end1 (length needle))))
+             (prepare-omit (object)
+               (setq display
+                     (or (if (find object
+                                   fc-name-parse-known-problem-attributes
+                                   :test #'prefixp)
+                             (progn
+                               (setq object (concat "(KNOWN) " object))
+                               ;; This attribute is known, don't display the
+                               ;; error based on it alone.
+                               nil)
+                             ;; Attribute is not known.
+                             t)
+                         ;; Otherwise, if we're already decided we need to
+                         ;; show them, respect that.
+                         display))
+               object)
+             (fontconfig-quote (string)
+              (mapconcat #'identity (split-string-by-char string ?:) #r"\:")))
+      (when (find ?: objects :test #'position) 
+        (setq objects (mapcar #'fontconfig-quote objects)))
+      (setq name (pop objects))
+      (dolist (object 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*).
+        (setq omits (mapconcat #'prepare-omit omits "\n"))
+        (lwarn 'fontconfig (if 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)
-      )))
+M-x report-xemacs-bug.  Objects:\n%sFontname:\n%s" omits fontname))
+      (fc-name-parse name))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;