Fixing an error in the detecting of bad Xexprs and displaying the error prettily

svn: r15080

collects/tests/xml/test.ss

@@ -123,6 +123,8 @@ END
      (test-xexpr? (make-comment "Comment!"))
      (test-xexpr? (make-pcdata #f #f "quoted <b>"))
      
+     (test-not-xexpr? (list 'a (list (list 'href)) "content"))
+     
      (test-not-xexpr? +)
      (test-not-xexpr? #f))
     

collects/web-server/private/xexpr.ss

@@ -23,13 +23,17 @@
                            (make-exn:pretty
                             (exn-message exn)
                             marks
-                            `(span ,(drop-after "Context:\n" (exn-message exn))
+                            `(span ,(drop-after "Context:\n" (exn-message exn)) "\n"
                                    ,(make-cdata #f #f (format-xexpr/errors val))))))])
          (contract xexpr/c val pos neg src-info))))
    (lambda (v) #t)))
 
 (define (drop-after delim str)
-  (substring str 0 (cdr (first (regexp-match-positions (regexp-quote delim) str)))))
+  (match (regexp-match-positions (regexp-quote delim) str)
+    [(list-rest (list-rest start end) _rst)
+     (substring str 0 end)]
+    [_
+     str]))
 
 ; Formating Xexprs
 (define (format-xexpr/errors v)

collects/xml/private/xexpr.ss

@@ -26,11 +26,11 @@
         comment? p-i? cdata? pcdata?))
 
 #;(define xexpr/c
-  (flat-rec-contract xexpr
-    xexpr-datum/c
-    (cons/c symbol?
-            (or/c (cons/c (listof (list/c symbol? string?)) (listof xexpr))
-                  (listof xexpr)))))
+    (flat-rec-contract xexpr
+                       xexpr-datum/c
+                       (cons/c symbol?
+                               (or/c (cons/c (listof (list/c symbol? string?)) (listof xexpr))
+                                     (listof xexpr)))))
 
 (define xexpr/c 
   (make-proj-contract
@@ -129,13 +129,18 @@
 ;; True if the list is a list of String,Symbol pairs.
 (define (attribute-symbol-string? attr true false)
   (if (symbol? (car attr))
-      (if (or (string? (cadr attr))
-              (permissive?))
-          (true)
+      (if (pair? (cdr attr))
+          (if (or (string? (cadr attr))
+                  (permissive?))
+              (true)
+              (false (make-exn:invalid-xexpr
+                      (format "Expected a string, given ~a" (cadr attr))
+                      (current-continuation-marks)
+                      (cadr attr))))
           (false (make-exn:invalid-xexpr
-                  (format "Expected a string, given ~a" (cadr attr))
+                  (format "Expected an attribute value string for attribute ~a" attr)
                   (current-continuation-marks)
-                  (cadr attr))))
+                  attr)))
       (false (make-exn:invalid-xexpr
               (format "Expected a symbol, given ~a" (car attr))
               (current-continuation-marks)