;;; -*-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
;;;
(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))
;;; -*-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
;;;
'PERSISTENT-DELETED)
'UNSYNCHRONIZED)))
+(define-method save-folder ((folder <file-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 ()
;;; -*-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
;;;
(define-method save-folder ((folder <imap-folder>))
;; Changes are always written through.
folder
- unspecific)
+ #f)
(define-method discard-folder-cache ((folder <imap-folder>))
(close-folder folder)
;;; -*-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
;;;
(define-method rmail-folder-header-fields ((folder <folder>))
(compute-rmail-folder-header-fields folder))
-(define-method save-folder ((folder <rmail-folder>))
- (synchronize-file-folder-write folder write-rmail-file))
-
(define (compute-rmail-folder-header-fields folder)
(make-rmail-folder-header-fields (folder-flags folder)))
\f
;;;; Write RMAIL file
-(define (write-rmail-file folder pathname)
- ;; **** Do backup of file here.
+(define-method write-file-folder ((folder <rmail-folder>) pathname)
(call-with-binary-output-file pathname
(lambda (port)
(write-rmail-file-header (rmail-folder-header-fields folder) port)
;;; -*-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
;;;
")")))
(define *imail-message-wrapper-prefix* #f)
+
+(define imail-ui:prompt-for-yes-or-no?
+ prompt-for-yes-or-no?)
\f
(define (imail-call-with-pass-phrase url receiver)
(let ((key (url-pass-phrase-key url)))
(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)
"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
"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."
;;; -*-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
;;;
(define-class (<umail-folder> (constructor (url))) (<file-folder>))
-(define-method save-folder ((folder <umail-folder>))
- (synchronize-file-folder-write folder write-umail-file))
-
;;;; Message
(define-class (<umail-message>
\f
;;;; Write unix mail file
-(define (write-umail-file folder pathname)
- ;; **** Do backup of file here.
+(define-method write-file-folder ((folder <umail-folder>) pathname)
(call-with-binary-output-file pathname
(lambda (port)
(for-each (lambda (message) (write-umail-message message port))
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
---------
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.
* 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.
* 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.
projects / mit-scheme.git / commitdiff