From: Chris Hanson Date: Wed, 3 May 2000 19:29:48 +0000 (+0000) Subject: Change modification-tracking mechanism to use counter instead of X-Git-Tag: 20090517-FFI~3941 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b432fed06bfabc0cfa55f5ce70d673d9ff392f54;p=mit-scheme.git Change modification-tracking mechanism to use counter instead of boolean flag. This is necessary if more than one process is simultaneously tracking modifications. Sketch new synchronization interface. New interface consists of three procedures: FOLDER-SYNC-STATUS determines the synchronization relationship of the folder cache with the persistent folder; SAVE-FOLDER saves any cached changes to the persistent folder; DISCARD-FOLDER-CACHE discards all cached information. --- diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm index c557cbf99..b5522f237 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.36 2000/05/02 22:12:39 cph Exp $ +;;; $Id: imail-core.scm,v 1.37 2000/05/03 19:29:33 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -84,24 +84,6 @@ ;;;; Server operations -;;; In "online" mode, these server operations directly modify the -;;; server's state. - -;;; In "disconnected" mode, server operations don't interact with the -;;; server, but instead manipulate locally-cached copies of folders -;;; that reside on the server. The operations are recorded and saved -;;; in the file system, then played back when SYNCHRONIZE-FOLDER is -;;; called. In this mode, SYNCHRONIZE-FOLDER and POLL-FOLDER are the -;;; only operations that interact with the server. - -;;; [**** Note that SYNCHRONIZE-FOLDER is insufficient to properly -;;; implement "disconnected" mode. The client must also know how to -;;; enumerate the server's folder set, so that it can tell whether a -;;; given cached folder has been deleted or renamed on the server. -;;; Similarly, the SYNCHRONIZE-FOLDER operation must be able to tell -;;; the client that the folder being synchronized has been deleted or -;;; renamed, so that the client can take appropriate action.] - ;; ------------------------------------------------------------------- ;; Create a new folder named URL. Signal an error if the folder ;; already exists or can't be created. @@ -201,8 +183,8 @@ (define-class () (url define accessor) - (modified? define standard - initial-value #t) + (modification-count define standard + initial-value 0) (modification-event define accessor initial-value (make-event-distributor)) (properties define standard @@ -231,22 +213,12 @@ (folder-url folder)) (define (folder-modified! folder) - (if (not (folder-modified? folder)) - (begin - (set-folder-modified?! folder #t) - (event-distributor/invoke! (folder-modification-event folder) - folder)))) - -(define (folder-not-modified! folder) - (if (folder-modified? folder) - (begin - (let ((count (folder-length folder))) - (do ((index 0 (+ index 1))) - ((= index count)) - (message-not-modified! (get-message folder index)))) - (set-folder-modified?! folder #f) - (event-distributor/invoke! (folder-modification-event folder) - folder)))) + (without-interrupts + (lambda () + (set-folder-modification-count! + folder + (+ (folder-modification-count folder) 1)))) + (event-distributor/invoke! (folder-modification-event folder) folder)) (define (get-memoized-folder url) (let ((folder (hash-table/get memoized-folders url #f))) @@ -285,10 +257,7 @@ ;; of the folder must work, but may incur a significant time or space ;; penalty. -(define (close-folder folder) - (%close-folder folder)) - -(define-generic %close-folder (folder)) +(define-generic close-folder (folder)) ;; ------------------------------------------------------------------- ;; Return #T if FOLDER represents a real folder, i.e. has a @@ -315,17 +284,13 @@ (%get-message folder index)) (define-generic %get-message (folder index)) - + ;; ------------------------------------------------------------------- ;; Insert a copy of MESSAGE in FOLDER at the end of the existing ;; messages. Unspecified result. -(define (append-message folder message) - (guarantee-message message 'APPEND-MESSAGE) - (%append-message folder message)) +(define-generic append-message (folder message)) -(define-generic %append-message (folder message)) - ;; ------------------------------------------------------------------- ;; Remove all messages in FOLDER that are marked for deletion. ;; Unspecified result. @@ -339,41 +304,23 @@ (define-generic search-folder (folder criteria)) ;; ------------------------------------------------------------------- -;; Poll the inbox associated with FOLDER to see if there is new mail. -;; If so, the mail is appended to FOLDER. Return the number of new -;; messages. Return #F if FOLDER has no associated inbox. +;; Compare FOLDER's cache with the persistent folder and return a +;; symbol indicating whether they are synchronized, as follows: +;; SYNCHRONIZED FOLDER-MODIFIED PERSISTENT-MODIFIED BOTH-MODIFIED +;; PERSISTENT-DELETED UNSYNCHRONIZED -(define-generic poll-folder (folder)) +(define-generic folder-sync-status (folder)) ;; ------------------------------------------------------------------- -;; Synchronize the local copy of FOLDER with the server's copy. -;; Unspecified result. +;; Save any cached changes made to FOLDER. -(define-generic synchronize-folder (folder)) +(define-generic save-folder (folder)) ;; ------------------------------------------------------------------- -;; Save any changes made to FOLDER. This permits the use of caches -;; for improved performance. - -(define (save-folder folder) - (%save-folder folder)) +;; Discard cached contents of FOLDER. Subsequent use of FOLDER will +;; reload contents from the persistent folder. -(define-generic %save-folder (folder)) - -;; ------------------------------------------------------------------- -;; Check to see if the persistent copy of FOLDER has changed since it -;; was copied into memory, and update the memory copy if so. Return -;; #t if the memory copy is updated, #f if it is not. If both -;; the memory copy and the persistent copy have changed, the procedure -;; RESOLVE-CONFLICT is called with the folder as an argument. -;; RESOLVE-CONFLICT must return a boolean which if true indicates that -;; the folder should be reverted. - -(define (maybe-revert-folder folder resolve-conflict) - (%maybe-revert-folder folder resolve-conflict)) - -(define-generic %maybe-revert-folder (folder resolve-conflict)) -(define-generic %revert-folder (folder)) +(define-generic discard-folder-cache (folder)) ;;;; Message type @@ -382,8 +329,8 @@ (header-fields define accessor) (body define accessor) (flags define standard) - (modified? define standard - initial-value #t) + (modification-count define standard + initial-value 0) (properties define standard) (folder define standard initial-value #f) @@ -441,14 +388,13 @@ (define (message-modified! message) (without-interrupts (lambda () - (set-message-modified?! message #t) + (set-message-modification-count! + message + (+ (message-modification-count message) 1)) (let ((folder (message-folder message))) (if folder (folder-modified! folder)))))) -(define (message-not-modified! message) - (set-message-modified?! message #f)) - (define (message->string message) (string-append (header-fields->string (message-header-fields message)) "\n" diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm index 7de1581bd..af13eeee4 100644 --- a/v7/src/imail/imail-file.scm +++ b/v7/src/imail/imail-file.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-file.scm,v 1.14 2000/05/02 22:12:59 cph Exp $ +;;; $Id: imail-file.scm,v 1.15 2000/05/03 19:29:37 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -61,23 +61,20 @@ (messages define standard accessor %file-folder-messages initial-value 'UNKNOWN) - (modification-time define standard initial-value #f)) + (file-modification-time define standard + initial-value #f) + (file-modification-count define standard + initial-value #f)) (define (file-folder-messages folder) (if (eq? 'UNKNOWN (%file-folder-messages folder)) - (%revert-folder folder)) + (revert-file-folder folder)) (%file-folder-messages folder)) (define (file-folder-pathname folder) (file-url-pathname (folder-url folder))) -(define (update-file-folder-modification-time! folder) - (set-file-folder-modification-time! - folder - (file-modification-time (file-folder-pathname folder))) - (folder-not-modified! folder)) - -(define-method %close-folder ((folder )) +(define-method close-folder ((folder )) (without-interrupts (lambda () (let ((messages (%file-folder-messages folder))) @@ -95,7 +92,7 @@ (define-method %get-message ((folder ) index) (list-ref (file-folder-messages folder) index)) -(define-method %append-message ((folder ) message) +(define-method append-message ((folder ) (message )) (let ((message (attach-message message folder))) (without-interrupts (lambda () @@ -154,15 +151,47 @@ (error:wrong-type-argument criteria "search criteria" 'SEARCH-FOLDER)))) - -(define-method synchronize-folder ((folder )) - folder - unspecific) - -(define-method %maybe-revert-folder ((folder ) resolve-conflict) - (if (if (eqv? (file-folder-modification-time folder) - (file-modification-time (file-folder-pathname folder))) - (or (not (folder-modified? folder)) - (resolve-conflict folder)) - (folder-modified? folder)) - (%revert-folder folder))) \ No newline at end of file + +(define-generic revert-file-folder (folder)) + +(define-method folder-sync-status ((folder )) + (let ((sync-time (file-folder-file-modification-time folder)) + (sync-count (file-folder-file-modification-count folder)) + (current-count (folder-modification-count folder)) + (current-time (file-modification-time (file-folder-pathname folder)))) + (if (and sync-time sync-count) + (if current-time + (if (= sync-time current-time) + (if (= sync-count current-count) + 'SYNCHRONIZED + 'FOLDER-MODIFIED) + (if (= sync-count current-count) + 'PERSISTENT-MODIFIED + 'BOTH-MODIFIED)) + 'PERSISTENT-DELETED) + 'UNSYNCHRONIZED))) + +(define (synchronize-file-folder-write folder writer) + (let ((pathname (file-folder-pathname folder))) + (let loop () + (let ((count (folder-modification-count folder))) + (writer folder pathname) + (let ((t (file-modification-time pathname))) + (if (and t (= count (folder-modification-count folder))) + (begin + (set-file-folder-file-modification-count! folder count) + (set-file-folder-file-modification-time! folder t)) + (loop))))))) + +(define (synchronize-file-folder-read folder reader) + (let ((pathname (file-folder-pathname folder))) + (let loop () + (let ((t (file-modification-time pathname))) + (reader folder pathname) + (if (= t (file-modification-time pathname)) + (begin + (set-file-folder-file-modification-time! folder t) + (set-file-folder-file-modification-count! + folder + (folder-modification-count folder))) + (loop)))))) \ No newline at end of file diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm index 609e950f3..47cceb187 100644 --- a/v7/src/imail/imail-imap.scm +++ b/v7/src/imail/imail-imap.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-imap.scm,v 1.11 2000/05/02 22:13:00 cph Exp $ +;;; $Id: imail-imap.scm,v 1.12 2000/05/03 19:29:39 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -170,7 +170,7 @@ (begin (guarantee-imap-connection-open connection) connection) - (loop (weak-cdr connections) alist)) + (loop (weak-cdr connections) connections)) (let ((next (weak-cdr connections))) (if prev (weak-set-cdr! prev next) @@ -323,7 +323,7 @@ (select-imap-folder connection #f)) folder))) -(define-method %close-folder ((folder )) +(define-method close-folder ((folder )) (close-imap-connection (imap-folder-connection folder))) (define-method %folder-valid? ((folder )) @@ -368,7 +368,7 @@ (and unseen (get-message folder unseen)))) -(define-method %append-message ((folder ) message) +(define-method append-message ((folder ) (message )) ???) (define-method expunge-deleted-messages ((folder )) @@ -377,21 +377,18 @@ (define-method search-folder ((folder ) criteria) ???) -(define-method poll-folder ((folder )) - (imap:command:noop (imap-folder-connection folder)) - #f) - -(define-method synchronize-folder ((folder )) - ???) - -(define-method %save-folder ((folder )) - ???) +(define-method folder-sync-status ((folder )) + ;; Changes are always written through. + folder + 'SYNCHRONIZED) -(define-method %maybe-revert-folder ((folder ) resolve-conflict) - ???) +(define-method save-folder ((folder )) + ;; Changes are always written through. + folder + unspecific) -(define-method %revert-folder ((folder )) - ???) +(define-method discard-folder-cache ((folder )) + (close-imap-connection (imap-folder-connection folder))) ;;;; IMAP command invocation @@ -472,14 +469,14 @@ (write command port) (for-each (lambda (argument) (write-char #\space port) - (imap:send-command-argument connection tag command argument)) + (imap:send-command-argument connection tag argument)) arguments) (write-char #\return port) (write-char #\linefeed port) (flush-output port) tag)) -(define (imap:send-command-argument connection tag command argument) +(define (imap:send-command-argument connection tag argument) (let ((port (imap-connection-port connection))) (let loop ((argument argument)) (cond ((or (symbol? argument) diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm index e581915af..aebed779d 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.21 2000/05/02 22:13:01 cph Exp $ +;;; $Id: imail-rmail.scm,v 1.22 2000/05/03 19:29:42 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -61,12 +61,8 @@ (define-method rmail-folder-header-fields ((folder )) (compute-rmail-folder-header-fields folder)) -(define-method %save-folder ((folder )) - (write-rmail-file folder (file-folder-pathname folder)) - (update-file-folder-modification-time! folder)) - -(define-method poll-folder ((folder )) - (rmail-get-new-mail folder)) +(define-method save-folder ((folder )) + (synchronize-file-folder-write folder write-rmail-file)) (define (compute-rmail-folder-header-fields folder) (list (make-header-field "Version" " 5") @@ -81,17 +77,24 @@ ;;;; Read RMAIL file -(define-method %revert-folder ((folder )) - (call-with-binary-input-file (file-folder-pathname folder) - (lambda (port) - (set-rmail-folder-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-method revert-file-folder ((folder )) + (synchronize-file-folder-read folder + (lambda (folder pathname) + (without-interrupts + (lambda () + (let ((messages (%file-folder-messages folder))) + (if (not (eq? 'UNKNOWN messages)) + (for-each detach-message messages))) + (set-file-folder-messages! folder '()))) + (call-with-binary-input-file pathname + (lambda (port) + (set-rmail-folder-header-fields! folder (read-rmail-prolog port)) + (let loop () + (let ((message (read-rmail-message port))) + (if message + (begin + (append-message folder message) + (loop)))))))))) (define (read-rmail-prolog port) (if (not (string-prefix? "BABYL OPTIONS:" (read-required-line port))) diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm index 0183cd872..0711759ae 100644 --- a/v7/src/imail/imail-top.scm +++ b/v7/src/imail/imail-top.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-top.scm,v 1.27 2000/05/02 22:19:34 cph Exp $ +;;; $Id: imail-top.scm,v 1.28 2000/05/03 19:29:44 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -32,11 +32,6 @@ ;;; ;;; * Build generic message cache? Need to figure out when cached ;;; info can be deleted. -;;; -;;; * The following operations are all ways of doing synchronization, -;;; so try to figure out a more unified viewpoint: POLL-FOLDER, -;;; SYNCHRONIZE-FOLDER, SAVE-FOLDER, MAYBE-REVERT-FOLDER, -;;; REVERT-FOLDER. (declare (usual-integrations)) @@ -109,9 +104,7 @@ May be called with an IMAIL folder URL as argument; (let ((buffer (new-buffer (imail-url->buffer-name url)))) (associate-imail-folder-with-buffer folder buffer) (select-message folder (first-unseen-message folder) #t) - buffer)))))) - (if (not url-string) - ((ref-command imail-get-new-mail) #f)))) + buffer)))))))) (define (imail-authenticator host user-id receiver) (call-with-pass-phrase (string-append "Password for user " user-id @@ -164,39 +157,6 @@ May be called with an IMAIL folder URL as argument; (define (imail-url->buffer-name url) (url-body url)) -(define-command imail-get-new-mail - "Get new mail from this folder's inbox." - () - (lambda () - (let ((folder (selected-folder))) - (tl-maybe-revert-folder folder) - (let ((n-new (poll-folder folder))) - (cond ((not n-new) - (message "(This folder has no associated inbox.)")) - ((= 0 n-new) - (message "(No new mail has arrived.)")) - (else - (select-message folder (- (folder-length folder) n-new)) - (event-distributor/invoke! (ref-variable imail-new-mail-hook)) - (message n-new - " new message" - (if (= n-new 1) "" "s") - " read"))))))) - -(define (tl-maybe-revert-folder folder) - (maybe-revert-folder folder - (lambda (folder) - (prompt-for-yes-or-no? - (string-append - "Persistent copy of folder has changed since last read. " - (if (folder-modified? folder) - "Discard your changes" - "Re-read folder")))))) - -(define-variable imail-new-mail-hook - "An event distributor that is invoked when IMAIL incorporates new mail." - (make-event-distributor)) - (define-major-mode imail read-only "IMAIL" "IMAIL mode is used by \\[imail] for editing IMAIL files. All normal editing commands are turned off. @@ -222,8 +182,6 @@ DEL Scroll to previous screen of this message. \\[imail-quit] Quit IMAIL: save, then switch to another buffer. -\\[imail-get-new-mail] Read any new mail from the associated inbox into this folder. - \\[imail-mail] Mail a message (same as \\[mail-other-window]). \\[imail-reply] Reply to this message. Like \\[imail-mail] but initializes some fields. \\[imail-forward] Forward this message to another user. @@ -280,7 +238,6 @@ DEL Scroll to previous screen of this message. (define-key 'imail #\x 'imail-expunge) (define-key 'imail #\s 'imail-save-folder) -(define-key 'imail #\g 'imail-get-new-mail) (define-key 'imail #\c-m-h 'imail-summary) (define-key 'imail #\c-m-l 'imail-summary-by-flags) @@ -303,16 +260,30 @@ DEL Scroll to previous screen of this message. (let ((folder (selected-folder #f buffer)) (message (selected-message #f buffer))) (let ((index (and message (message-index message)))) - (if (or dont-confirm? - (prompt-for-yes-or-no? - (string-append "Revert buffer from folder " - (url->string (folder-url folder))))) - (select-message - folder - (cond ((eq? folder (message-folder message)) message) - ((and (<= 0 index) (< index (folder-length folder))) index) - (else (first-unseen-message folder))) - (tl-maybe-revert-folder folder)))))) + (if (let ((status (folder-sync-status folder))) + (case status + ((UNSYNCHRONIZED) + #t) + ((SYNCHRONIZED PERSISTENT-MODIFIED) + (or dont-confirm? + (prompt-for-yes-or-no? "Revert buffer from folder"))) + ((FOLDER-MODIFIED) + (prompt-for-yes-or-no? "Discard your changes to folder")) + ((BOTH-MODIFIED) + (prompt-for-yes-or-no? + "Persistent copy of folder changed; discard your changes")) + ((PERSISTENT-DELETED) + (editor-error "Persistent copy of folder deleted.")) + (else + (error "Unknown folder-sync status:" status)))) + (begin + (discard-folder-cache folder) + (select-message + folder + (cond ((eq? folder (message-folder message)) message) + ((and (<= 0 index) (< index (folder-length folder))) index) + (else (first-unseen-message folder))) + #t)))))) (define (imail-kill-buffer buffer) (let ((folder (selected-folder #f buffer))) @@ -331,13 +302,6 @@ DEL Scroll to previous screen of this message. () (lambda () (save-folder (selected-folder)))) - -(define-command imail-synchronize - "Synchronize the current folder with the master copy on the server. -Currently meaningless for file-based folders." - () - (lambda () - (synchronize-folder (selected-folder)))) ;;;; Navigation @@ -652,10 +616,10 @@ Completion is performed over known flags when reading." (let ((folder (open-folder url-string)) (message (selected-message))) (append-message folder message) - (save-folder folder) - (set-message-flag message "filed")) - (if (ref-variable imail-delete-after-output) - ((ref-command imail-delete-forward) #f)))) + (set-message-flag message "filed") + (if (ref-variable imail-delete-after-output) + ((ref-command imail-delete-forward) #f)) + (save-folder folder)))) ;;;; Sending mail diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm index 5a1dc62f8..84ff9bcd4 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.15 2000/05/02 22:13:03 cph Exp $ +;;; $Id: imail-umail.scm,v 1.16 2000/05/03 19:29:48 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -57,42 +57,40 @@ (define-class ( (constructor (url))) ()) -(define-method %save-folder ((folder )) - (write-umail-file folder (file-folder-pathname folder)) - (update-file-folder-modification-time! folder)) - -(define-method poll-folder ((folder )) - folder - #f) +(define-method save-folder ((folder )) + (synchronize-file-folder-write folder write-umail-file)) ;;;; Read unix mail file -(define-method %revert-folder ((folder )) - (set-file-folder-messages! - folder - (call-with-binary-input-file (file-folder-pathname folder) - (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) +(define-method revert-file-folder ((folder )) + (synchronize-file-folder-read folder + (lambda (folder pathname) + (set-file-folder-messages! + folder + (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 folder from-line port)) + (lambda (message from-line) + (let ((messages (cons message messages))) + (if from-line + (loop from-line messages) + (reverse! messages))))))))))))))) + +(define (read-umail-message folder from-line port) (let read-headers ((header-lines '())) (let ((line (read-line port))) (cond ((eof-object? line) - (values (make-umail-message from-line + (values (make-umail-message folder + from-line (reverse! header-lines) '()) #f)) @@ -100,12 +98,14 @@ (let read-body ((body-lines '())) (let ((line (read-line port))) (cond ((eof-object? line) - (values (make-umail-message from-line + (values (make-umail-message folder + from-line (reverse! header-lines) (reverse! body-lines)) #f)) ((umail-delimiter? line) - (values (make-umail-message from-line + (values (make-umail-message folder + from-line (reverse! header-lines) (reverse! body-lines)) line)) @@ -114,9 +114,10 @@ (else (read-headers (cons line header-lines))))))) -(define (make-umail-message from-line header-lines body-lines) +(define (make-umail-message folder from-line header-lines body-lines) (let ((message - (make-detached-message + (make-attached-message + folder (lines->header-fields header-lines) (lines->string (map (lambda (line) (if (string-prefix-ci? ">From " line)