Move this code into the runtime system's package heirarchy.
authorChris Hanson <org/chris-hanson/cph>
Thu, 13 Apr 2000 20:16:07 +0000 (20:16 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 13 Apr 2000 20:16:07 +0000 (20:16 +0000)
v7/src/imail/ed-ffi.scm
v7/src/imail/imail.pkg
v7/src/imail/rexp.scm
v7/src/runtime/rexp.scm

index fb4923132031fe8c7e803f9dbd0a7c75c3e23d49..a21ac3c149bd1f52e2d425f87a368c9385995e96 100644 (file)
@@ -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
index a7d1a540ea67826ea56d7ee5f82991f86e878917..fad749e8627f5c3832b3f386c36e0b8f59c0b6ff 100644 (file)
@@ -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
 ;;;
 (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
          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
index 0035ff73fb4c0e0b28a4fc2070725544b571865a..58d3b5a0ec2c5323e5b2a091bc5bca69b368f4ab 100644 (file)
@@ -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
 ;;;
                 ((NOT-SYNTAX-CHAR) (string-append "\\S" (syntax-type)))
                 (else (lose))))))
          (else (lose)))))
-
+\f
 (define (case-fold-string s)
   (let ((end (string-length s)))
     (let loop ((start 0) (parts '()))
                         (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
index 0035ff73fb4c0e0b28a4fc2070725544b571865a..58d3b5a0ec2c5323e5b2a091bc5bca69b368f4ab 100644 (file)
@@ -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
 ;;;
                 ((NOT-SYNTAX-CHAR) (string-append "\\S" (syntax-type)))
                 (else (lose))))))
          (else (lose)))))
-
+\f
 (define (case-fold-string s)
   (let ((end (string-length s)))
     (let loop ((start 0) (parts '()))
                         (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