Define URL:REGEXP:HOSTPORT and subsidiaries.

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index a06853ba414265294a094f395ac17728f6bf9114..864c0da1dad1d395381bdd72cc51f90c48a4143c 100644 (file)
--- 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 5f6853cae6ea299f1e772ff798931d721bbb3d50..80039621e36fdc7bbc479f73987bf9b52bf26264 100644 (file)
--- 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 5f6853cae6ea299f1e772ff798931d721bbb3d50..80039621e36fdc7bbc479f73987bf9b52bf26264 100644 (file)
--- 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)))