Implement TRANSLATE-STRING-LINE-ENDINGS.

diff --git a/v7/src/imail/imail-util.scm b/v7/src/imail/imail-util.scm
index 33ccb39444cb9345fffe5f0dbdb2e4797455994f..374fb94a8544e35917cc29494e242244faecdde7 100644 (file)
--- a/v7/src/imail/imail-util.scm
+++ b/v7/src/imail/imail-util.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-util.scm,v 1.10 2000/04/14 01:45:43 cph Exp $
+;;; $Id: imail-util.scm,v 1.11 2000/04/28 19:05:53 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -144,7 +144,7 @@
   (write-char #\: port)
   (write-string value port)
   (newline port))
-
+\f
 (define (read-lines port)
   (source->list (lambda () (read-line port))))
 
@@ -163,4 +163,18 @@
     line))
 
 (define (edwin-variable-value name)
-  (variable-value (name->variable name 'ERROR)))
\ No newline at end of file
+  (variable-value (name->variable name 'ERROR)))
+
+(define (translate-string-line-endings string)
+  (translate-substring-line-endings string 0 (string-length string)))
+
+(define (translate-substring-line-endings string start end)
+  (let ((indexes (substring-search-all "\r\n" string start end)))
+    (let ((s (make-string (fix:- (fix:- end start) (length indexes)))))
+      (let loop ((indexes indexes) (i start) (j 0))
+       (if (pair? indexes)
+           (let ((j (substring-move! string i (car indexes) s j)))
+             (string-set! s j #\newline)
+             (loop (cdr indexes) (fix:+ (car indexes) 2) (fix:+ j 1)))
+           (substring-move! string i end s j)))
+      s)))
\ No newline at end of file