;;; -*-Scheme-*-
;;;
-;;; $Id: imail-core.scm,v 1.1 2000/01/04 22:50:53 cph Exp $
+;;; $Id: imail-core.scm,v 1.2 2000/01/07 23:08:48 cph Exp $
;;;
;;; Copyright (c) 1999 Massachusetts Institute of Technology
;;;
;; error for invalid INDEX.
(define (get-message folder index)
(guarantee-index index 'GET-MESSAGE)
- (if (not (fix:< index (length (count-messages folder))))
+ (if (not (fix:< index (count-messages folder)))
(error:bad-range-argument index 'GET-MESSAGE))
(%get-message folder index))
headers*
(append! (reverse! (cdr flags*)) flags)
properties)))
- ((header-field->message-property header)
+ ((header-field->message-property (car headers))
=> (lambda (property)
(loop (cdr headers)
headers*
(define (set-message-property message name value)
(guarantee-message-property-name name 'SET-MESSAGE-PROPERTY)
(guarantee-message-property-value value 'SET-MESSAGE-PROPERTY)
- (let ((headers (message-properties message)))
- (let loop ((headers headers))
- (if (pair? headers)
- (if (string-ci=? name (caar headers))
- (set-cdr! (car headers) value)
- (loop (cdr headers)))
+ (let ((alist (message-properties message)))
+ (let loop ((alist* alist))
+ (if (pair? alist*)
+ (if (string-ci=? name (caar alist*))
+ (set-cdr! (car alist*) value)
+ (loop (cdr alist*)))
(set-message-properties! message
- (cons (cons name value) headers))))))
+ (cons (cons name value) alist))))))
(define (message-property-name? object)
(header-field-name? object))
;;; -*-Scheme-*-
;;;
-;;; $Id: imail-rmail.scm,v 1.1 2000/01/04 22:51:02 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.2 2000/01/07 23:09:17 cph Exp $
;;;
;;; Copyright (c) 1999 Massachusetts Institute of Technology
;;;
(define-class (<rmail-folder> (constructor (url header-fields messages)))
(<file-folder>)
- (header-fields define standard accessor header-fields))
+ (header-fields accessor header-fields define modifier))
(define-method %write-folder ((folder <folder>) (url <rmail-url>))
- (write-rmail-file folder (file-url-pathname url)))
+ (write-rmail-file folder url))
(define-method poll-folder ((folder <rmail-folder>))
(rmail-get-new-mail folder))
(lambda (n.v)
(string-ci=? "summary-line" (car n.v))))))
(if summary-line
- (%write-header-field (car n.v) (cdr n.v) port)))
+ (%write-header-field (car summary-line) (cdr summary-line) port)))
(for-each
(lambda (n.v)
(if (not (or (string-ci=? "summary-line" (car n.v))