From: Chris Hanson Date: Thu, 6 Apr 2000 03:25:27 +0000 (+0000) Subject: Eliminate half-baked notion of "importing" and "exporting" files. If X-Git-Tag: 20090517-FFI~4096 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6ccacda9fb2c4ec980318cd2aec07fd66a9dff0c;p=mit-scheme.git Eliminate half-baked notion of "importing" and "exporting" files. If pursued, this results in particular files being marked as "external", and others as "internal", and it becomes clumsy. --- diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm index 918c2ed54..dcc54ba01 100644 --- a/v7/src/imail/imail-rmail.scm +++ b/v7/src/imail/imail-rmail.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-rmail.scm,v 1.13 2000/02/07 22:31:53 cph Exp $ +;;; $Id: imail-rmail.scm,v 1.14 2000/04/06 03:25:19 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -38,7 +38,7 @@ ;;;; Server operations (define-method %open-folder ((url )) - (read-rmail-file (file-url-pathname url) #f)) + (read-rmail-file (file-url-pathname url))) (define-method %new-folder ((url )) (let ((folder (make-rmail-folder url))) @@ -57,7 +57,7 @@ (folder-put! folder 'RMAIL-HEADER-FIELDS headers)) (define-method %write-folder ((folder ) (url )) - (write-rmail-file folder (file-url-pathname url) #f) + (write-rmail-file folder (file-url-pathname url)) (if (eq? url (folder-url folder)) (update-file-folder-modification-time! folder))) @@ -80,24 +80,21 @@ ;;;; Read RMAIL file -(define (read-rmail-file pathname import?) - (call-with-binary-input-file pathname - (lambda (port) - (read-rmail-folder (make-rmail-url pathname) port import?)))) - -(define (read-rmail-folder url port import?) - (let ((folder (make-rmail-folder url))) +(define (read-rmail-file pathname) + (let ((folder (make-rmail-folder (make-rmail-url pathname)))) (%revert-folder folder) folder)) (define-method %revert-folder ((folder )) - (set-header-fields! folder (read-rmail-prolog port)) - (let loop () - (let ((message (read-rmail-message port import?))) - (if message - (begin - (append-message folder message) - (loop))))) + (call-with-binary-input-file (file-folder-pathname folder) + (lambda (port) + (set-header-fields! folder (read-rmail-prolog port)) + (let loop () + (let ((message (read-rmail-message port))) + (if message + (begin + (append-message folder message) + (loop))))))) (update-file-folder-modification-time! folder)) (define (read-rmail-prolog port) @@ -105,7 +102,7 @@ (error "Not an RMAIL file:" port)) (lines->header-fields (read-lines-to-eom port))) -(define (read-rmail-message port import?) +(define (read-rmail-message port) ;; **** This must be generalized to recognize an RMAIL file that has ;; unix-mail format messages appended to it. (let ((line (read-line port))) @@ -113,21 +110,17 @@ #f) ((and (fix:= 1 (string-length line)) (char=? rmail-message:start-char (string-ref line 0))) - (read-rmail-message-1 port import?)) + (read-rmail-message-1 port)) (else (error "Malformed RMAIL file:" port))))) -(define (read-rmail-message-1 port import?) +(define (read-rmail-message-1 port) (call-with-values (lambda () (parse-attributes-line (read-required-line port))) (lambda (formatted? flags) - (let* ((headers - (maybe-strip-imail-headers import? - (read-rmail-header-fields port))) + (let* ((headers (read-rmail-header-fields port)) (displayed-headers - (maybe-strip-imail-headers - import? - (lines->header-fields (read-header-lines port)))) + (lines->header-fields (read-header-lines port))) (body (read-to-eom port)) (finish (lambda (headers) @@ -187,21 +180,18 @@ ;;;; Write RMAIL file -(define (write-rmail-file folder pathname export?) +(define (write-rmail-file folder pathname) ;; **** Do backup of file here. (call-with-binary-output-file pathname (lambda (port) - (write-rmail-folder folder port export?)))) - -(define (write-rmail-folder folder port export?) - (write-string "BABYL OPTIONS: -*- rmail -*-" port) - (newline port) - (write-header-fields (header-fields folder) port) - (write-char rmail-message:end-char port) - (for-each (lambda (message) (write-rmail-message message port export?)) - (file-folder-messages folder))) - -(define (write-rmail-message message port export?) + (write-string "BABYL OPTIONS: -*- rmail -*-" port) + (newline port) + (write-header-fields (header-fields folder) port) + (write-char rmail-message:end-char port) + (for-each (lambda (message) (write-rmail-message message port)) + (file-folder-messages folder))))) + +(define (write-rmail-message message port) (write-char rmail-message:start-char port) (newline port) (let ((headers (header-fields message)) @@ -210,14 +200,14 @@ (write-rmail-attributes-line message displayed-headers port) (if (not (eq? 'NONE displayed-headers)) (begin - (write-rmail-properties message port export?) + (write-rmail-properties message port) (write-header-fields headers port) (newline port))) (write-string rmail-message:headers-separator port) (newline port) (if (eq? 'NONE displayed-headers) (begin - (write-rmail-properties message port export?) + (write-rmail-properties message port) (write-header-fields headers port)) (write-header-fields displayed-headers port)) (newline port) @@ -242,7 +232,7 @@ (write-markers labels)))) (newline port)) -(define (write-rmail-properties message port export?) +(define (write-rmail-properties message port) (let ((alist (message-properties message))) (let ((summary-line (list-search-positive alist @@ -250,15 +240,14 @@ (string-ci=? "summary-line" (car n.v)))))) (if summary-line (%write-header-field (car summary-line) (cdr summary-line) port))) - (if (not export?) - (for-each - (lambda (n.v) - (if (not (or (string-ci=? "summary-line" (car n.v)) - (string-ci=? "displayed-header-fields" (car n.v)))) - (write-header-field - (message-property->header-field (car n.v) (cdr n.v)) - port))) - alist)))) + (for-each + (lambda (n.v) + (if (not (or (string-ci=? "summary-line" (car n.v)) + (string-ci=? "displayed-header-fields" (car n.v)))) + (write-header-field + (message-property->header-field (car n.v) (cdr n.v)) + port))) + alist))) ;;;; Get new mail @@ -318,7 +307,7 @@ (else (rename-inbox-using-rename pathname))))) (and (file-exists? pathname) - (read-umail-file pathname #t)))) + (read-umail-file pathname)))) (define (rename-inbox-using-movemail pathname directory) (let ((pathname diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm index 0c5dd5f9a..e2813295c 100644 --- a/v7/src/imail/imail-umail.scm +++ b/v7/src/imail/imail-umail.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-umail.scm,v 1.9 2000/02/07 22:31:56 cph Exp $ +;;; $Id: imail-umail.scm,v 1.10 2000/04/06 03:25:27 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -38,7 +38,7 @@ ;;;; Server operations (define-method %open-folder ((url )) - (read-umail-file (file-url-pathname url) #f)) + (read-umail-file (file-url-pathname url))) (define-method %new-folder ((url )) (let ((folder (make-umail-folder url))) @@ -50,7 +50,7 @@ (define-class ( (constructor (url))) ()) (define-method %write-folder ((folder ) (url )) - (write-umail-file folder (file-url-pathname url) #f) + (write-umail-file folder (file-url-pathname url)) (if (eq? url (folder-url folder)) (update-file-folder-modification-time! folder))) @@ -60,43 +60,39 @@ ;;;; Read unix mail file -(define (read-umail-file pathname import?) - (call-with-binary-input-file pathname - (lambda (port) - (read-umail-folder (make-umail-url pathname) port import?)))) - -(define (read-umail-folder url port import?) - (let ((folder (make-umail-folder url))) +(define (read-umail-file pathname) + (let ((folder (make-umail-folder (make-umail-url pathname)))) (%revert-folder folder) folder)) (define-method %revert-folder ((folder )) (set-file-folder-messages! folder - (let ((from-line (read-line port))) - (if (eof-object? from-line) - '() - (begin - (if (not (umail-delimiter? from-line)) - (error "Malformed unix mail file:" port)) - (let loop ((from-line from-line) (messages '())) - (call-with-values - (lambda () (read-umail-message from-line port import?)) - (lambda (message from-line) - (let ((messages (cons message messages))) - (if from-line - (loop from-line messages) - (reverse! messages)))))))))) - (update-file-folder-modification-time! folder)) - -(define (read-umail-message from-line port import?) + (call-with-binary-input-file pathname + (lambda (port) + (let ((from-line (read-line port))) + (if (eof-object? from-line) + '() + (begin + (if (not (umail-delimiter? from-line)) + (error "Malformed unix mail file:" port)) + (let loop ((from-line from-line) (messages '())) + (call-with-values + (lambda () (read-umail-message from-line port)) + (lambda (message from-line) + (let ((messages (cons message messages))) + (if from-line + (loop from-line messages) + (reverse! messages)))))))))))) + (update-file-folder-modification-time! folder)) + +(define (read-umail-message from-line port) (let read-headers ((header-lines '())) (let ((line (read-line port))) (cond ((eof-object? line) (values (make-umail-message from-line (reverse! header-lines) - '() - import?) + '()) #f)) ((string-null? line) (let read-body ((body-lines '())) @@ -104,25 +100,22 @@ (cond ((eof-object? line) (values (make-umail-message from-line (reverse! header-lines) - (reverse! body-lines) - import?) + (reverse! body-lines)) #f)) ((umail-delimiter? line) (values (make-umail-message from-line (reverse! header-lines) - (reverse! body-lines) - import?) + (reverse! body-lines)) line)) (else (read-body (cons line body-lines))))))) (else (read-headers (cons line header-lines))))))) -(define (make-umail-message from-line header-lines body-lines import?) +(define (make-umail-message from-line header-lines body-lines) (let ((message (make-detached-message - (maybe-strip-imail-headers import? - (lines->header-fields header-lines)) + (lines->header-fields header-lines) (lines->string (map (lambda (line) (if (string-prefix-ci? ">From " line) (string-tail line 1) @@ -136,17 +129,14 @@ ;;;; Write unix mail file -(define (write-umail-file folder pathname export?) +(define (write-umail-file folder pathname) ;; **** Do backup of file here. (call-with-binary-output-file pathname (lambda (port) - (write-umail-folder folder port export?)))) - -(define (write-umail-folder folder port export?) - (for-each (lambda (message) (write-umail-message message port export?)) - (file-folder-messages folder))) + (for-each (lambda (message) (write-umail-message message port)) + (file-folder-messages folder))))) -(define (write-umail-message message port export?) +(define (write-umail-message message port) (let ((from-line (get-message-property message "umail-from-line" #f))) (if from-line (write-string from-line port) @@ -163,17 +153,15 @@ (write-string (universal-time->unix-ctime (get-universal-time)) port)))) (newline port) - (if (not export?) - (begin - (write-header-field - (message-flags->header-field (message-flags message)) - port) - (for-each (lambda (n.v) - (if (not (string-ci=? "umail-from-line" (car n.v))) - (write-header-field - (message-property->header-field (car n.v) (cdr n.v)) - port))) - (message-properties message)))) + (write-header-field + (message-flags->header-field (message-flags message)) + port) + (for-each (lambda (n.v) + (if (not (string-ci=? "umail-from-line" (car n.v))) + (write-header-field + (message-property->header-field (car n.v) (cdr n.v)) + port))) + (message-properties message)) (write-header-fields (header-fields message) port) (newline port) (for-each (lambda (line)