From 35393fa8491be0cdc7b9b7b953570cf7d9e66ea9 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 14 Mar 2016 22:28:38 -0700
Subject: [PATCH] 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 <...>
---
 src/runtime/parse.scm  | 13 +++++++++++++
 src/runtime/unpars.scm | 14 +++++++++++---
 src/runtime/url.scm    | 13 +------------
 3 files changed, 25 insertions(+), 15 deletions(-)

diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm
index edbcdbe32..793a72205 100644
--- 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 bd690b51a..1a7edcd65 100644
--- 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 ">"))
 
 (define (unparse/pair pair)
   (cond ((unparse-list/prefix-pair? pair)
diff --git a/src/runtime/url.scm b/src/runtime/url.scm
index dc6bbe4e1..7b7c25e87 100644
--- 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)
 
 ;;;; Partial URIs
 
-- 
2.25.1