From cd01fffbefd0ebd2c046161994d4e3d06add46de Mon Sep 17 00:00:00 2001 From: Chris Hanson 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