Implement URI syntax #<...> that's readable.

Old syntax was too verbose with useless hash number.
Also this nicely reflects the standard way to write a URI <...>

diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm
index edbcdbe32041e163e8032ac96391eda2156cfa63..793a72205a523426c61a95f85bcbb34a76cb1fa6 100644 (file)
--- a/src/runtime/parse.scm
+++ b/src/runtime/parse.scm
@@ -275,6 +275,7 @@ USA.
     (store-char-set special special-number-leaders handler:number)
     (store-char initial #\( handler:list)
     (store-char special #\( handler:vector)
+    (store-char special #\< handler:uri)
     (store-char special #\[ handler:hashed-object)
     (store-char initial #\) handler:close-parenthesis)
     (store-char initial #\] handler:close-bracket)
@@ -835,6 +836,18 @@ USA.
          ((string-ci=? name "unspecific") unspecific)
          (else (error:illegal-named-constant name)))))
 
+(define (handler:uri port db ctx char1 char2)
+  ctx char1 char2
+  (string->uri
+   (call-with-output-string
+     (lambda (port*)
+       (let loop ()
+        (let ((char (%read-char/no-eof port db)))
+          (if (not (char=? char #\>))
+              (begin
+                (%write-char char port*)
+                (loop)))))))))
+
 (define (handler:special-arg port db ctx char1 char2)
   ctx char1
   (let loop ((n (char->digit char2 10)))

diff --git a/src/runtime/unpars.scm b/src/runtime/unpars.scm
index bd690b51a58b3e6d03dde6810e31830be05cf225..1a7edcd65f7840194d7ec3b02beae56cb833f66c 100644 (file)
--- a/src/runtime/unpars.scm
+++ b/src/runtime/unpars.scm
@@ -647,9 +647,17 @@ USA.
   (map-reference-trap (lambda () (vector-ref vector index))))
 
 (define (unparse/record record)
-  (if (get-param:unparse-with-maximum-readability?)
-      (*unparse-readable-hash record)
-      (invoke-user-method unparse-record record)))
+  (cond ((uri? record)
+        (unparse/uri record))
+       ((get-param:unparse-with-maximum-readability?)
+        (*unparse-readable-hash record))
+       (else
+        (invoke-user-method unparse-record record))))
+
+(define (unparse/uri uri)
+  (*unparse-string "#<")
+  (*unparse-string (uri->string uri))
+  (*unparse-string ">"))
 \f
 (define (unparse/pair pair)
   (cond ((unparse-list/prefix-pair? pair)

diff --git a/src/runtime/url.scm b/src/runtime/url.scm
index dc6bbe4e1798601ec7a68056b4d87fa0112b8a7f..7b7c25e87e4a827a9735c40a6c5addb513d1017e 100644 (file)
--- a/src/runtime/url.scm
+++ b/src/runtime/url.scm
@@ -41,17 +41,6 @@ USA.
   (fragment uri-fragment)
   (string uri->string))
 
-(set-record-type-unparser-method! <uri>
-  (simple-unparser-method 'uri
-    (lambda (uri)
-      (list (uri->string uri)))))
-
-(define uri-parser-method
-  (simple-parser-method
-   (lambda (objects)
-     (and (pair? objects)
-         (string->uri (car objects))))))
-
 (define (make-uri scheme authority path query fragment)
   (let ((path (if (equal? path '("")) '() path)))
     (if scheme (guarantee-uri-scheme scheme 'MAKE-URI))
@@ -916,7 +905,7 @@ USA.
   (set! url:char-set:unescaped
        (char-set-union url:char-set:unreserved
                        (string->char-set ";/?:@&=")))
-  (define-bracketed-object-parser-method 'URI uri-parser-method))
+  unspecific)
 \f
 ;;;; Partial URIs