From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 13 Apr 2000 20:16:07 +0000 (+0000)
Subject: Move this code into the runtime system's package heirarchy.
X-Git-Tag: 20090517-FFI~4024
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=91eb590a1468fc91e8daae16e439ef2761185487;p=mit-scheme.git

Move this code into the runtime system's package heirarchy.
---

diff --git a/v7/src/imail/ed-ffi.scm b/v7/src/imail/ed-ffi.scm
index fb4923132..a21ac3c14 100644
--- a/v7/src/imail/ed-ffi.scm
+++ b/v7/src/imail/ed-ffi.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: ed-ffi.scm,v 1.4 2000/04/13 18:00:53 cph Exp $
+;;; $Id: ed-ffi.scm,v 1.5 2000/04/13 20:16:05 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -28,6 +28,6 @@
     ("imail-top" (edwin imail) edwin-syntax-table)
     ("imail-umail" (edwin imail) system-global-syntax-table)
     ("imail-util" (edwin imail) system-global-syntax-table)
-    ("rexp" (edwin imail rexp) system-global-syntax-table)
+    ("rexp" (runtime rexp) system-global-syntax-table)
     ("rfc822" (edwin imail) system-global-syntax-table)
-    ("url" (edwin imail url) system-global-syntax-table)))
\ No newline at end of file
+    ("url" (runtime url) system-global-syntax-table)))
\ No newline at end of file
diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index a7d1a540e..fad749e86 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.11 2000/04/13 19:47:14 cph Exp $
+;;; $Id: imail.pkg,v 1.12 2000/04/13 20:16:07 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -24,10 +24,10 @@
 (global-definitions "$bscm/sos/sos")
 (global-definitions "$bscm/edwin/edwinunx")
 
-(define-package (edwin imail rexp)
+(define-package (runtime rexp)
   (files "rexp")
-  (parent (edwin imail))
-  (export (edwin imail)
+  (parent ())
+  (export ()
 	  rexp*
 	  rexp+
 	  rexp->regexp
@@ -52,10 +52,10 @@
 	  rexp-word-start
 	  rexp?))
 
-(define-package (edwin imail url)
+(define-package (runtime url)
   (files "url")
-  (parent (edwin imail))
-  (export (edwin imail)
+  (parent ())
+  (export ()
 	  url:char-set:escaped
 	  url:char-set:extra
 	  url:char-set:national
diff --git a/v7/src/imail/rexp.scm b/v7/src/imail/rexp.scm
index 0035ff73f..58d3b5a0e 100644
--- a/v7/src/imail/rexp.scm
+++ b/v7/src/imail/rexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rexp.scm,v 1.10 2000/04/13 19:47:34 cph Exp $
+;;; $Id: rexp.scm,v 1.11 2000/04/13 20:14:59 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -193,7 +193,7 @@
 		 ((NOT-SYNTAX-CHAR) (string-append "\\S" (syntax-type)))
 		 (else (lose))))))
 	  (else (lose)))))
-
+
 (define (case-fold-string s)
   (let ((end (string-length s)))
     (let loop ((start 0) (parts '()))
@@ -210,4 +210,27 @@
 			 (re-quote-string
 			  (substring s start index))
 			 parts))
-	    (apply string-append (reverse! parts)))))))
\ No newline at end of file
+	    (apply string-append (reverse! parts)))))))
+
+(define (separated-append tokens separator)
+  (cond ((not (pair? tokens)) "")
+	((not (pair? (cdr tokens))) (car tokens))
+	(else
+	 (let ((string
+		(make-string
+		 (let ((ns (string-length separator)))
+		   (do ((tokens (cdr tokens) (cdr tokens))
+			(count (string-length (car tokens))
+			       (fix:+ count
+				      (fix:+ (string-length (car tokens))
+					     ns))))
+		       ((not (pair? tokens)) count))))))
+	   (let loop
+	       ((tokens (cdr tokens))
+		(index (string-move! (car tokens) string 0)))
+	     (if (pair? tokens)
+		 (loop (cdr tokens)
+		       (string-move! (car tokens)
+				     string
+				     (string-move! separator string index)))))
+	   string))))
\ No newline at end of file
diff --git a/v7/src/runtime/rexp.scm b/v7/src/runtime/rexp.scm
index 0035ff73f..58d3b5a0e 100644
--- a/v7/src/runtime/rexp.scm
+++ b/v7/src/runtime/rexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rexp.scm,v 1.10 2000/04/13 19:47:34 cph Exp $
+;;; $Id: rexp.scm,v 1.11 2000/04/13 20:14:59 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -193,7 +193,7 @@
 		 ((NOT-SYNTAX-CHAR) (string-append "\\S" (syntax-type)))
 		 (else (lose))))))
 	  (else (lose)))))
-
+
 (define (case-fold-string s)
   (let ((end (string-length s)))
     (let loop ((start 0) (parts '()))
@@ -210,4 +210,27 @@
 			 (re-quote-string
 			  (substring s start index))
 			 parts))
-	    (apply string-append (reverse! parts)))))))
\ No newline at end of file
+	    (apply string-append (reverse! parts)))))))
+
+(define (separated-append tokens separator)
+  (cond ((not (pair? tokens)) "")
+	((not (pair? (cdr tokens))) (car tokens))
+	(else
+	 (let ((string
+		(make-string
+		 (let ((ns (string-length separator)))
+		   (do ((tokens (cdr tokens) (cdr tokens))
+			(count (string-length (car tokens))
+			       (fix:+ count
+				      (fix:+ (string-length (car tokens))
+					     ns))))
+		       ((not (pair? tokens)) count))))))
+	   (let loop
+	       ((tokens (cdr tokens))
+		(index (string-move! (car tokens) string 0)))
+	     (if (pair? tokens)
+		 (loop (cdr tokens)
+		       (string-move! (car tokens)
+				     string
+				     (string-move! separator string index)))))
+	   string))))
\ No newline at end of file