Fix a handful of small bugs.
authorChris Hanson <org/chris-hanson/cph>
Fri, 7 Jan 2000 23:09:17 +0000 (23:09 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 7 Jan 2000 23:09:17 +0000 (23:09 +0000)
v7/src/imail/imail-core.scm
v7/src/imail/imail-rmail.scm

index 2dc45cf37a9686e3071266567e6853776f720f80..439e05050064b2ed0936c25b4f041d537a1e615f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-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))
index 6cdde14c1ec451feb04b599d31176a862f909db6..5b6e33c43ec432dc95bccce7e2ba74870944bde6 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-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))