From c63ab8d875ad8577c601cfc6ffb7c4ac2389db3c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 20 Jul 2000 02:30:03 +0000 Subject: [PATCH] Make sure continuation lines of mail-buffer headers are properly indented. --- v7/src/edwin/sendmail.scm | 52 +++++++++++++++++++++++++-------------- 1 file changed, 34 insertions(+), 18 deletions(-) diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm index dfa7c92f0..64370f891 100644 --- a/v7/src/edwin/sendmail.scm +++ b/v7/src/edwin/sendmail.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: sendmail.scm,v 1.66 2000/07/05 22:57:14 cph Exp $ +;;; $Id: sendmail.scm,v 1.67 2000/07/20 02:30:03 cph Exp $ ;;; ;;; Copyright (c) 1991-2000 Massachusetts Institute of Technology ;;; @@ -264,23 +264,39 @@ is inserted." "\t" (ref-variable fill-column buffer) #f)))) (let ((start (mark-right-inserting-copy point))) - (for-each (lambda (header) - (let ((key (car header)) - (value (cadr header))) - (if value - (begin - (move-mark-to! start point) - (insert-string key point) - (insert-string ": " point) - (insert-string value point) - (if (and (not (string-null? value)) - (if (null? (cddr header)) - (or (string-ci=? key "to") - (string-ci=? key "cc")) - (caddr header))) - (fill start point)) - (insert-newline point))))) - headers) + (for-each + (lambda (header) + (let ((key (car header)) + (value (cadr header))) + (if value + (begin + (move-mark-to! start point) + (insert-string key point) + (insert-string ": " point) + (let ((end (string-length value))) + (let loop ((start 0)) + (let ((index + (substring-find-next-char value start end + #\newline))) + (if index + (let ((index (fix:+ index 1))) + (insert-substring value start index point) + (if (and (fix:< index end) + (not + (let ((char (string-ref value index))) + (or (char=? char #\space) + (char=? char #\tab))))) + (insert-char #\tab point)) + (loop index)) + (insert-substring value start end point))))) + (if (and (not (string-null? value)) + (if (null? (cddr header)) + (or (string-ci=? key "to") + (string-ci=? key "cc")) + (caddr header))) + (fill start point)) + (insert-newline point))))) + headers) (mark-temporary! start)) (let ((mail-header-function (ref-variable mail-header-function buffer))) (if mail-header-function -- 2.25.1