From: Chris Hanson Date: Tue, 23 May 2000 20:19:09 +0000 (+0000) Subject: Change definition of SAVE-FOLDER so that it does the save only if X-Git-Tag: 20090517-FFI~3698 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f54f151af1a0f648da4180d1e58fddc6da5a6c3f;p=mit-scheme.git Change definition of SAVE-FOLDER so that it does the save only if there are changes to be saved, and returns true only if it does the save. This prevents gratuitous saves of file folders. --- diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm index 76e4d11b1..ea967abc9 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.90 2000/05/23 18:52:02 cph Exp $ +;;; $Id: imail-core.scm,v 1.91 2000/05/23 20:19:01 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -358,7 +358,8 @@ (define-generic folder-sync-status (folder)) ;; ------------------------------------------------------------------- -;; Save any cached changes made to FOLDER. +;; Save any cached changes made to FOLDER. Returns a boolean +;; indicating whether anything was saved. (define-generic save-folder (folder)) diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm index 4a2e472ae..6b47999d5 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.39 2000/05/23 18:36:37 cph Exp $ +;;; $Id: imail-file.scm,v 1.40 2000/05/23 20:19:02 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -214,6 +214,19 @@ 'PERSISTENT-DELETED) 'UNSYNCHRONIZED))) +(define-method save-folder ((folder )) + (and (let ((status (folder-sync-status folder))) + (or (memq status '(FOLDER-MODIFIED PERSISTENT-DELETED)) + (and (eq? status 'BOTH-MODIFIED) + (imail-ui:prompt-for-yes-or-no? + "Disk file has changed since last read. Save anyway")))) + (begin + ;; **** Do backup of file here. + (synchronize-file-folder-write folder write-file-folder) + #t))) + +(define-generic write-file-folder (folder pathname)) + (define (synchronize-file-folder-write folder writer) (let ((pathname (file-folder-pathname folder))) (let loop () diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm index 634511627..c8ee91e16 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.86 2000/05/23 18:36:03 cph Exp $ +;;; $Id: imail-imap.scm,v 1.87 2000/05/23 20:19:04 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -892,7 +892,7 @@ (define-method save-folder ((folder )) ;; Changes are always written through. folder - unspecific) + #f) (define-method discard-folder-cache ((folder )) (close-folder folder) diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm index 076b16d4d..99f122b54 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.36 2000/05/22 14:50:02 cph Exp $ +;;; $Id: imail-rmail.scm,v 1.37 2000/05/23 20:19:05 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -66,9 +66,6 @@ (define-method rmail-folder-header-fields ((folder )) (compute-rmail-folder-header-fields folder)) -(define-method save-folder ((folder )) - (synchronize-file-folder-write folder write-rmail-file)) - (define (compute-rmail-folder-header-fields folder) (make-rmail-folder-header-fields (folder-flags folder))) @@ -188,8 +185,7 @@ ;;;; Write RMAIL file -(define (write-rmail-file folder pathname) - ;; **** Do backup of file here. +(define-method write-file-folder ((folder ) pathname) (call-with-binary-output-file pathname (lambda (port) (write-rmail-file-header (rmail-folder-header-fields folder) port) diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm index e684447bf..52c15b37c 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.101 2000/05/23 19:27:27 cph Exp $ +;;; $Id: imail-top.scm,v 1.102 2000/05/23 20:19:06 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -248,6 +248,9 @@ regardless of the folder type." ")"))) (define *imail-message-wrapper-prefix* #f) + +(define imail-ui:prompt-for-yes-or-no? + prompt-for-yes-or-no?) (define (imail-call-with-pass-phrase url receiver) (let ((key (url-pass-phrase-key url))) @@ -415,7 +418,7 @@ variable's documentation (using \\[describe-variable]) for details: (define-key 'imail #\o 'imail-output) (define-key 'imail #\i 'imail-input) (define-key 'imail #\+ 'imail-create-folder) -;(define-key 'imail #\- 'imail-delete-folder) +(define-key 'imail #\- 'imail-delete-folder) (define-key 'imail #\q 'imail-quit) (define-key 'imail #\? 'describe-mode) @@ -1312,9 +1315,7 @@ While composing the reply, use \\[mail-yank-original] to yank the "Quit out of IMAIL." () (lambda () - (let ((folder (selected-folder))) - (save-folder folder) - (close-folder folder)) + (close-folder (selected-folder)) ((ref-command bury-buffer)))) (define-command imail-get-new-mail @@ -1353,7 +1354,10 @@ Currently useful only for IMAP folders." "Save the currently selected IMAIL folder." () (lambda () - (save-folder (selected-folder)))) + (message + (if (save-folder (selected-folder)) + "Folder saved" + "(No changes need to be saved)")))) (define-command imail-toggle-header "Show full message headers if pruned headers currently shown, or vice versa." diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm index fd0d5cb92..19ee24704 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.29 2000/05/22 03:01:28 cph Exp $ +;;; $Id: imail-umail.scm,v 1.30 2000/05/23 20:19:08 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -59,9 +59,6 @@ (define-class ( (constructor (url))) ()) -(define-method save-folder ((folder )) - (synchronize-file-folder-write folder write-umail-file)) - ;;;; Message (define-class ( @@ -162,8 +159,7 @@ ;;;; Write unix mail file -(define (write-umail-file folder pathname) - ;; **** Do backup of file here. +(define-method write-file-folder ((folder ) pathname) (call-with-binary-output-file pathname (lambda (port) (for-each (lambda (message) (write-umail-message message port)) diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt index 65d27854f..81c79230c 100644 --- a/v7/src/imail/todo.txt +++ b/v7/src/imail/todo.txt @@ -1,5 +1,5 @@ IMAIL To-Do List -$Id: todo.txt,v 1.45 2000/05/23 18:37:04 cph Exp $ +$Id: todo.txt,v 1.46 2000/05/23 20:19:09 cph Exp $ Bug fixes --------- @@ -8,12 +8,6 @@ Bug fixes message that is written, when the target folder is not being visited. -* M-x imail-copy-messages rewrites an RMAIL file that is the source of - the copy. The problem is that closing a file folder writes the - folder to the file, whether it's needed or not. Both closing the - folder and M-x imail-save-folder should save the folder only if - needed. - * Implement operations for IMAP: URL-EXISTS?. * Must be able to handle malformed headers in incoming mail. @@ -52,11 +46,6 @@ New features * Set the IMAIL buffer's modification bit to indicate whether the folder is locally modified. Meaningful only for file folders. -* M-x imail-copy-messages needs prompt that distinguishes itself from - M-x imail-output. Both of these commands should provide feedback - for each message that is output, and should announce the total - number of messages output when finished. - * Optionally convert quoted-printable messages to 8bit for presentation. * Optionally wrap long lines for presentation. @@ -92,6 +81,3 @@ New features * Implement something closer to the IMAP COPY operation, e.g. APPEND-MESSAGES. - -* Commands such as create-folder and delete-folder should produce - status messages that indicate the result.