From 301d94c23211958ce2caa31ada4733efbea0bd0d Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 28 Apr 2000 19:05:53 +0000 Subject: [PATCH] Implement TRANSLATE-STRING-LINE-ENDINGS. --- v7/src/imail/imail-util.scm | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/v7/src/imail/imail-util.scm b/v7/src/imail/imail-util.scm index 33ccb3944..374fb94a8 100644 --- 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)) - + (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 -- 2.25.1