Fix compiler warnings.

diff --git a/v7/src/imail/ed-ffi.scm b/v7/src/imail/ed-ffi.scm
index 460ec18a1aa45e0b18c2efd3ddd8d41943777fa4..fb4923132031fe8c7e803f9dbd0a7c75c3e23d49 100644 (file)
--- 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.3 2000/04/13 15:36:00 cph Exp $
+;;; $Id: ed-ffi.scm,v 1.4 2000/04/13 18:00:53 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" (runtime rexp) system-global-syntax-table)
+    ("rexp" (edwin imail rexp) system-global-syntax-table)
     ("rfc822" (edwin imail) system-global-syntax-table)
-    ("url" (runtime url) system-global-syntax-table)))
\ No newline at end of file
+    ("url" (edwin imail url) system-global-syntax-table)))
\ No newline at end of file

diff --git a/v7/src/imail/imail-imap-url.scm b/v7/src/imail/imail-imap-url.scm
index 02139457e8b2e15248685b11ba8a4618a8273537..dcaddb99af6e292efb848d728b6972d46d24c9f5 100644 (file)
--- a/v7/src/imail/imail-imap-url.scm
+++ b/v7/src/imail/imail-imap-url.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap-url.scm,v 1.5 2000/04/13 16:58:39 cph Exp $
+;;; $Id: imail-imap-url.scm,v 1.6 2000/04/13 17:57:52 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -165,10 +165,12 @@
   (or (imap:match-quoted-string string start end)
       (imap:match-literal string start end)))
 \f
+(define imap:char-set:achar
+  (char-set-union url:char-set:unreserved
+                 (string->char-set "&=~")))
+
 (define imap:rexp:achar+
-  (rexp+ (rexp-alternatives (char-set-union url:char-set:unreserved
-                                           (string->char-set "&=~"))
-                           url:rexp:escape)))
+  (rexp+ (rexp-alternatives imap:char-set:achar url:rexp:escape)))
 
 (define imap:rexp:bchar+
   (rexp+ (rexp-alternatives (char-set-union imap:char-set:achar

diff --git a/v7/src/imail/rexp.scm b/v7/src/imail/rexp.scm
index dcabc19fb4572fc9801a0711fd188ce7b5b2aa95..a54a4f255903dd13ea438dcb0811e91b4d67c5d5 100644 (file)
--- a/v7/src/imail/rexp.scm
+++ b/v7/src/imail/rexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rexp.scm,v 1.8 2000/04/13 16:56:49 cph Exp $
+;;; $Id: rexp.scm,v 1.9 2000/04/13 17:57:57 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -22,7 +22,7 @@
 
 (declare (usual-integrations))
 \f
-(define (rexp? object)
+(define (rexp? rexp)
   (or (string? rexp)
       (char-set? rexp)
       (and (pair? rexp)
@@ -133,15 +133,14 @@
 (define (rexp-not-syntax-char type) `(NOT-SYNTAX-CHAR ,type))
 
 (define (rexp-case-fold rexp)
-  (let ((lose (lambda () (error "Malformed rexp:" rexp))))
-    (cond ((string? rexp)
-          `(CASE-FOLD rexp))
-         ((and (pair? rexp)
-               (memq (car rexp) '(ALTERNATIVES SEQUENCE GROUP OPTIONAL * +))
-               (list? (cdr rexp)))
-          (cons (car rexp)
-                (map rexp-case-fold (cdr rexp))))
-         (else rexp))))
+  (cond ((string? rexp)
+        `(CASE-FOLD rexp))
+       ((and (pair? rexp)
+             (memq (car rexp) '(ALTERNATIVES SEQUENCE GROUP OPTIONAL * +))
+             (list? (cdr rexp)))
+        (cons (car rexp)
+              (map rexp-case-fold (cdr rexp))))
+       (else rexp)))
 \f
 (define (rexp-compile rexp)
   (re-compile-pattern (rexp->regexp rexp) #f))
@@ -193,7 +192,7 @@
                 ((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 '()))
@@ -210,27 +209,4 @@
                         (re-quote-string
                          (substring s start index))
                         parts))
-           (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
+           (apply string-append (reverse! parts)))))))
\ No newline at end of file

diff --git a/v7/src/runtime/rexp.scm b/v7/src/runtime/rexp.scm
index dcabc19fb4572fc9801a0711fd188ce7b5b2aa95..a54a4f255903dd13ea438dcb0811e91b4d67c5d5 100644 (file)
--- a/v7/src/runtime/rexp.scm
+++ b/v7/src/runtime/rexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rexp.scm,v 1.8 2000/04/13 16:56:49 cph Exp $
+;;; $Id: rexp.scm,v 1.9 2000/04/13 17:57:57 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -22,7 +22,7 @@
 
 (declare (usual-integrations))
 \f
-(define (rexp? object)
+(define (rexp? rexp)
   (or (string? rexp)
       (char-set? rexp)
       (and (pair? rexp)
@@ -133,15 +133,14 @@
 (define (rexp-not-syntax-char type) `(NOT-SYNTAX-CHAR ,type))
 
 (define (rexp-case-fold rexp)
-  (let ((lose (lambda () (error "Malformed rexp:" rexp))))
-    (cond ((string? rexp)
-          `(CASE-FOLD rexp))
-         ((and (pair? rexp)
-               (memq (car rexp) '(ALTERNATIVES SEQUENCE GROUP OPTIONAL * +))
-               (list? (cdr rexp)))
-          (cons (car rexp)
-                (map rexp-case-fold (cdr rexp))))
-         (else rexp))))
+  (cond ((string? rexp)
+        `(CASE-FOLD rexp))
+       ((and (pair? rexp)
+             (memq (car rexp) '(ALTERNATIVES SEQUENCE GROUP OPTIONAL * +))
+             (list? (cdr rexp)))
+        (cons (car rexp)
+              (map rexp-case-fold (cdr rexp))))
+       (else rexp)))
 \f
 (define (rexp-compile rexp)
   (re-compile-pattern (rexp->regexp rexp) #f))
@@ -193,7 +192,7 @@
                 ((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 '()))
@@ -210,27 +209,4 @@
                         (re-quote-string
                          (substring s start index))
                         parts))
-           (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
+           (apply string-append (reverse! parts)))))))
\ No newline at end of file