From abbd2f60bc2e011b4ae8338032e00cb4723e1295 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 8 May 2000 14:59:06 +0000 Subject: [PATCH] Change LINES->HEADER-FIELDS to stop at a blank line, and to use memory more efficiently. --- v7/src/imail/imail-core.scm | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm index 9d92c584d..a9aac0c9e 100644 --- a/v7/src/imail/imail-core.scm +++ b/v7/src/imail/imail-core.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-core.scm,v 1.41 2000/05/05 17:18:10 cph Exp $ +;;; $Id: imail-core.scm,v 1.42 2000/05/08 14:59:06 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -735,7 +735,16 @@ (append-map! header-field->lines headers)) (define (lines->header-fields lines) - (map lines->header-field (burst-list lines header-field-initial-line?))) + (let loop ((lines lines) (headers '())) + (if (and (pair? lines) + (not (string-null? (car lines)))) + (let collect-group ((lines (cdr lines)) (group (list (car lines)))) + (if (or (not (pair? lines)) + (string-null? (car lines)) + (header-field-initial-line? (car lines))) + (loop lines (lines->header-field (reverse! group))) + (collect-group (cdr lines) (cons (car lines) group)))) + (reverse! headers)))) (define (header-field-initial-line? line) (let ((colon (string-find-next-char line #\:))) -- 2.25.1