From cd01fffbefd0ebd2c046161994d4e3d06add46de Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 12 Apr 2000 03:50:32 +0000
Subject: [PATCH] Define URL:REGEXP:HOSTPORT and subsidiaries.

---
 v7/src/imail/imail.pkg |  6 +++++-
 v7/src/imail/url.scm   | 27 ++++++++++++++++++++++++++-
 v7/src/runtime/url.scm | 27 ++++++++++++++++++++++++++-
 3 files changed, 57 insertions(+), 3 deletions(-)

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index a06853ba4..864c0da1d 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.4 2000/04/12 03:08:15 cph Exp $
+;;; $Id: imail.pkg,v 1.5 2000/04/12 03:50:32 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -54,6 +54,10 @@
 	  url:encode-string
 	  url:encode-substring
 	  url:regexp:escape
+	  url:regexp:host
+	  url:regexp:hostname
+	  url:regexp:hostnumber
+	  url:regexp:hostport
 	  url:regexp:uchar
 	  url:regexp:xchar
 	  url:string-encoded?
diff --git a/v7/src/imail/url.scm b/v7/src/imail/url.scm
index 5f6853cae..80039621e 100644
--- a/v7/src/imail/url.scm
+++ b/v7/src/imail/url.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: url.scm,v 1.2 2000/04/12 03:08:11 cph Exp $
+;;; $Id: url.scm,v 1.3 2000/04/12 03:47:51 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -51,6 +51,31 @@
   (regexp-group (char-set->regexp url:char-set:unescaped)
 		url:regexp:escape))
 
+(define url:regexp:hostname
+  (let ((c1 (char-set->regexp char-set:alphanumeric)))
+    (let ((tail
+	   (regexp-group
+	    ""
+	    (string-append
+	     (char-set->regexp
+	      (char-set-union char-set:alphanumeric (string->char-set "-")))
+	     "*"
+	     c1))))
+      (string-append (regexp-group (string-append c1 tail "."))
+		     "*"
+		     (char-set->regexp char-set:alphabetic)
+		     tail))))
+
+(define url:regexp:hostnumber
+  "[0-9]+.[0-9]+.[0-9]+.[0-9]+")
+
+(define url:regexp:host
+  (regexp-group url:regexp:hostname
+		url:regexp:hostnumber))
+
+(define url:regexp:hostport
+  (string-append url:regexp:host (regexp-group ":[0-9]+") "?"))
+
 (define (url:string-encoded? string)
   (url:substring-encoded? string 0 (string-length string)))
 
diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm
index 5f6853cae..80039621e 100644
--- a/v7/src/runtime/url.scm
+++ b/v7/src/runtime/url.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: url.scm,v 1.2 2000/04/12 03:08:11 cph Exp $
+;;; $Id: url.scm,v 1.3 2000/04/12 03:47:51 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -51,6 +51,31 @@
   (regexp-group (char-set->regexp url:char-set:unescaped)
 		url:regexp:escape))
 
+(define url:regexp:hostname
+  (let ((c1 (char-set->regexp char-set:alphanumeric)))
+    (let ((tail
+	   (regexp-group
+	    ""
+	    (string-append
+	     (char-set->regexp
+	      (char-set-union char-set:alphanumeric (string->char-set "-")))
+	     "*"
+	     c1))))
+      (string-append (regexp-group (string-append c1 tail "."))
+		     "*"
+		     (char-set->regexp char-set:alphabetic)
+		     tail))))
+
+(define url:regexp:hostnumber
+  "[0-9]+.[0-9]+.[0-9]+.[0-9]+")
+
+(define url:regexp:host
+  (regexp-group url:regexp:hostname
+		url:regexp:hostnumber))
+
+(define url:regexp:hostport
+  (string-append url:regexp:host (regexp-group ":[0-9]+") "?"))
+
 (define (url:string-encoded? string)
   (url:substring-encoded? string 0 (string-length string)))
 
-- 
2.25.1