From ca29c03bae75927fceca5eb7421b3016acdf8dbf Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 23 May 2001 23:23:48 +0000 Subject: [PATCH] Generalize folder operations: open-folder => open-resource close-folder => close-resource save-folder => save-resource Add methods to each of these renamed operations so that they can handle containers. --- v7/src/imail/imail-core.scm | 26 +++++++++++++------------- v7/src/imail/imail-file.scm | 19 +++++++++++++++---- v7/src/imail/imail-imap.scm | 35 ++++++++++++++++++++++++----------- v7/src/imail/imail-rmail.scm | 8 ++++---- v7/src/imail/imail-top.scm | 12 ++++++------ v7/src/imail/imail-umail.scm | 8 ++++---- 6 files changed, 66 insertions(+), 42 deletions(-) diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm index e15028aff..e9ac81cb6 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.128 2001/05/23 21:29:50 cph Exp $ +;;; $Id: imail-core.scm,v 1.129 2001/05/23 23:23:18 cph Exp $ ;;; ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology ;;; @@ -380,24 +380,24 @@ ;;;; Folder operations ;; ------------------------------------------------------------------- -;; Open the folder named URL. +;; Open the resource named URL. -(define (open-folder url) +(define (open-resource url) (or (get-memoized-resource url) - (memoize-resource (%open-folder url) close-folder))) + (memoize-resource (%open-resource url) close-resource))) -(define-generic %open-folder (url)) +(define-generic %open-resource (url)) ;; ------------------------------------------------------------------- -;; Close FOLDER, freeing up connections, memory, etc. Subsequent use -;; of the folder must work, but may incur a significant time or space +;; Close RESOURCE, freeing up connections, memory, etc. Subsequent use +;; of the resource must work, but may incur a significant time or space ;; penalty. -(define (close-folder folder) - (save-folder folder) - (%close-folder folder)) +(define (close-resource resource) + (save-resource resource) + (%close-resource resource)) -(define-generic %close-folder (folder)) +(define-generic %close-resource (resource)) ;; ------------------------------------------------------------------- ;; Return the number of messages in FOLDER. @@ -437,10 +437,10 @@ (define-generic folder-sync-status (folder)) ;; ------------------------------------------------------------------- -;; Save any cached changes made to FOLDER. Returns a boolean +;; Save any cached changes made to RESOURCE. Returns a boolean ;; indicating whether anything was saved. -(define-generic save-folder (folder)) +(define-generic save-resource (resource)) ;; ------------------------------------------------------------------- ;; Discard cached contents of FOLDER. Subsequent use of FOLDER will diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm index 103a8368b..9a216f525 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.69 2001/05/23 21:29:54 cph Exp $ +;;; $Id: imail-file.scm,v 1.70 2001/05/23 23:23:23 cph Exp $ ;;; ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology ;;; @@ -273,7 +273,7 @@ (define (file-folder-pathname folder) (pathname-url-pathname (resource-locator folder))) -(define-method %close-folder ((folder )) +(define-method %close-resource ((folder )) (discard-file-folder-messages folder) (discard-file-folder-xstring folder)) @@ -390,7 +390,7 @@ 'PERSISTENT-DELETED) 'UNSYNCHRONIZED))) -(define-method save-folder ((folder )) +(define-method save-resource ((folder )) (and (let ((status (folder-sync-status folder))) (or (memq status '(FOLDER-MODIFIED PERSISTENT-DELETED)) (and (eq? status 'BOTH-MODIFIED) @@ -442,7 +442,7 @@ (call-with-input-xstring (file-folder-xstring folder) 0 reader))))) (define-method discard-folder-cache ((folder )) - (close-folder folder)) + (close-resource folder)) (define-method probe-folder ((folder )) folder @@ -472,6 +472,17 @@ (define-class ( (constructor (locator))) ()) +(define-method %open-resource ((url )) + (make-file-container url)) + +(define-method %close-resource ((container )) + container + unspecific) + +(define-method save-resource ((container )) + container + #f) + (define-method container-contents ((container )) (simple-directory-read (pathname-url-pathname (resource-locator container)) (lambda (name directory result) diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm index d035380ae..6ea8fe337 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.157 2001/05/23 21:30:02 cph Exp $ +;;; $Id: imail-imap.scm,v 1.158 2001/05/23 23:23:31 cph Exp $ ;;; ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology ;;; @@ -581,11 +581,6 @@ ;;;; Folder and container datatypes -(define-class ( (constructor (locator))) ()) - -(define-method container-contents ((container )) - (imap-container-url-contents (resource-locator container))) - (define-class ( (constructor (locator connection))) () (connection define accessor) (read-only? define standard) @@ -599,6 +594,8 @@ (n-messages define standard initial-value 0) (messages define standard initial-value '#())) +(define-class ( (constructor (locator))) ()) + (define (reset-imap-folder! folder) (without-interrupts (lambda () @@ -1297,7 +1294,7 @@ ;;;; Folder operations -(define-method %open-folder ((url )) +(define-method %open-resource ((url )) (let ((folder (make-imap-folder url (or (search-imap-connections @@ -1308,7 +1305,7 @@ (guarantee-imap-folder-open folder) folder)) -(define-method %close-folder ((folder )) +(define-method %close-resource ((folder )) (let ((connection (imap-folder-connection folder))) (maybe-close-imap-connection connection) (set-imap-connection-folder! connection #f)) @@ -1344,13 +1341,13 @@ folder 'SYNCHRONIZED) -(define-method save-folder ((folder )) +(define-method save-resource ((folder )) ;; Changes are always written through. folder #f) (define-method discard-folder-cache ((folder )) - (close-folder folder) + (close-resource folder) (reset-imap-folder! folder)) (define-method probe-folder ((folder )) @@ -1363,12 +1360,28 @@ 'OFFLINE)) (define-method disconnect-folder ((folder )) - (close-folder folder)) + (close-resource folder)) (define-method folder-supports-mime? ((folder )) folder #t) +;;;; Container operations + +(define-method %open-resource ((url )) + (make-imap-container url)) + +(define-method %close-resource ((container )) + container + unspecific) + +(define-method save-resource ((container )) + container + #f) + +(define-method container-contents ((container )) + (imap-container-url-contents (resource-locator container))) + ;;;; IMAP command invocation (define (imap:command:capability connection) diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm index e049d03d7..91a2a82a4 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.65 2001/05/23 05:05:11 cph Exp $ +;;; $Id: imail-rmail.scm,v 1.66 2001/05/23 23:23:34 cph Exp $ ;;; ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology ;;; @@ -38,9 +38,9 @@ ;;;; Server operations -(define-method %open-folder ((url )) +(define-method %open-resource ((url )) (if (not (file-readable? (pathname-url-pathname url))) - (error:bad-range-argument url 'OPEN-FOLDER)) + (error:bad-range-argument url 'OPEN-RESOURCE)) (make-rmail-folder url)) (define-method %create-folder ((url )) @@ -55,7 +55,7 @@ (set-file-folder-file-modification-count! folder (object-modification-count folder)) - (save-folder folder))) + (save-resource folder))) ;;;; Folder diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm index 44c41b167..2a80081a4 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.244 2001/05/23 21:20:28 cph Exp $ +;;; $Id: imail-top.scm,v 1.245 2001/05/23 23:23:45 cph Exp $ ;;; ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology ;;; @@ -231,7 +231,7 @@ regardless of the folder type." 'REQUIRE-MATCH? #t)))) (lambda (url-string) (let ((folder - (open-folder + (open-resource (if url-string (imail-parse-partial-url url-string) (imail-primary-url #f))))) @@ -826,7 +826,7 @@ With prefix argument N, removes FLAG from next N messages, 'REQUIRE-MATCH? #t))) (lambda (url-string) (let ((url (imail-parse-partial-url url-string))) - (copy-folder (open-folder url) + (copy-folder (open-resource url) (resource-locator (selected-folder)) (lambda () ((ref-command imail-get-new-mail) #f)) (string-append "from " (url->string url)))))) @@ -1390,7 +1390,7 @@ If it doesn't exist, it is created first." (url-base-name (imail-parse-partial-url from))) 'HISTORY 'IMAIL-COPY-FOLDER-TARGET)))) (lambda (from to) - (let ((folder (open-folder (imail-parse-partial-url from))) + (let ((folder (open-resource (imail-parse-partial-url from))) (to (imail-parse-partial-url to))) (if (eq? (resource-locator folder) to) (editor-error "Can't copy folder to itself:" to)) @@ -1426,7 +1426,7 @@ With prefix argument, closes and buries only selected IMAIL folder." (lambda (selected-only?) (let ((quit (lambda (folder) - (close-folder folder) + (close-resource folder) (imail-bury folder)))) (if selected-only? (quit (selected-folder)) @@ -1482,7 +1482,7 @@ With prefix argument, closes and buries only selected IMAIL folder." () (lambda () (message - (if (save-folder (selected-folder)) + (if (save-resource (selected-folder)) "Folder saved" "No changes need to be saved.")))) diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm index 50bdb8243..5f59e324b 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.46 2001/05/23 05:05:29 cph Exp $ +;;; $Id: imail-umail.scm,v 1.47 2001/05/23 23:23:48 cph Exp $ ;;; ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology ;;; @@ -35,9 +35,9 @@ ;;;; Server operations -(define-method %open-folder ((url )) +(define-method %open-resource ((url )) (if (not (file-readable? (pathname-url-pathname url))) - (error:bad-range-argument url 'OPEN-FOLDER)) + (error:bad-range-argument url 'OPEN-RESOURCE)) (make-umail-folder url)) (define-method %create-folder ((url )) @@ -49,7 +49,7 @@ (set-file-folder-file-modification-count! folder (object-modification-count folder)) - (save-folder folder))) + (save-resource folder))) ;;;; Folder -- 2.25.1