Cache parsed date, subject, author, and recipient in memory in IMAIL.

This is not really the right thing, but it substantially speeds up
sorting, and slightly speeds up summarization, without requiring the
memory overhead of keeping whole headers strongly in memory.

What IMAIL should really do is

(1) store headers (and bodies and body structures and so on) strongly
in memory, and use a secondary GC daemon to discard them when space is
short; and

(2) use a generic, compact, on-disk cache, for every folder, of the
important information for each message: date, subject, author,
recipient, message-id, thread-id.

diff --git a/src/imail/imail-core.scm b/src/imail/imail-core.scm
index 627563ff434f056a23538bd5f0cd01a292b8d637..9dad4147deec7a1fe7ff1ff6ed8a4b8658733270 100644 (file)
--- a/src/imail/imail-core.scm
+++ b/src/imail/imail-core.scm
@@ -629,11 +629,51 @@ USA.
    (lambda (port)
      (write-header-fields (message-header-fields message) port)
      (write-message-body message port))))
-
+\f
 (define (message-time message)
-  (let ((date (get-first-header-field-value message "date" #f)))
-    (and date
-        (parse-header-field-date date))))
+  (intern-property! message '|#[(edwin imail)message-time]|
+    (lambda (message)
+      (let ((date (get-first-header-field-value message "date" #f)))
+       (and date
+            (parse-header-field-date date))))))
+
+(define (message-subject message)
+  (intern-property! message '|#[(edwin imail)message-subject|
+    (lambda (message)
+      (cond ((get-first-header-field-value message "subject" #f)
+            => strip-subject-re)
+           (else "")))))
+
+(define (strip-subject-re subject)
+  (let ((end (string-length subject)))
+    (let loop ((start 0))
+      (if (and (fix:<= 3 (fix:- end start))
+              (substring-prefix-ci? "Re:" 0 3 subject (fix:+ start 3) end))
+         (loop
+          (substring-find-next-char-in-set subject (fix:+ start 3) end
+                                           char-set:subject-content))
+         (string-tail subject start)))))
+
+(define char-set:subject-content (char-set-invert (char-set #\space #\tab)))
+
+(define (message-author message)
+  (intern-property! message '|#[(edwin imail)message-author|
+    (lambda (message)
+      (or (get-first-header-field-address message "from" #f)
+         (get-first-header-field-address message "sender" #f)
+         ""))))
+
+(define (message-recipient message)
+  (intern-property! message '|#[(edwin imail)message-recipient]|
+    (lambda ()
+      (or (get-first-header-field-address message "to" #f)
+         (get-first-header-field-address message "apparently-to" #f)
+         ""))))
+
+(define (get-first-header-field-address message name error?)
+  (let ((v (get-first-header-field-value message name error?)))
+    (and v
+        (rfc822:first-address v))))
 \f
 ;;;; Message Navigation
 

diff --git a/src/imail/imail-summary.scm b/src/imail/imail-summary.scm
index ab8af0f4a734b45d28807ae5d5950674462c094d..c7e732e76fcd1798a8c1be65506d5bd6d7db3193 100644 (file)
--- a/src/imail/imail-summary.scm
+++ b/src/imail/imail-summary.scm
@@ -591,16 +591,10 @@ SUBJECT is a string of regexps separated by commas."
          (else s))))
 
 (define (message-summary-subject-string message)
-  (let ((s
-        (let ((s (or (get-first-header-field-value message "subject" #f) "")))
-          (let ((regs (re-string-match "\\(re:[ \t]*\\)+" s #t)))
-            (if regs
-                (string-tail s (re-match-end-index 0 regs))
-                s)))))
-    (let ((i (string-find-next-char s #\newline)))
-      (if i
-         (string-head s i)
-         s))))
+  (let ((subject (message-subject message)))
+    (cond ((string-find-next-char subject #\newline)
+          => (lambda (line-end) (string-head subject line-end)))
+         (else subject))))
 \f
 ;;;; Navigation
 

diff --git a/src/imail/imail-top.scm b/src/imail/imail-top.scm
index b54359eeaacc20e233bcddd38aea7867b2734807..f8e0bfac9b01054f87177fd9580795c77be59190 100644 (file)
--- a/src/imail/imail-top.scm
+++ b/src/imail/imail-top.scm
@@ -1373,32 +1373,6 @@ ADDRESSES is a string consisting of several addresses separated by commas."
       (set-buffer-point! buffer point)
       (mark-temporary! point)
       value)))
-
-(define (message-subject message)
-  (let ((subject (get-first-header-field-value message "subject" #f)))
-    (if subject
-       (strip-subject-re subject)
-       "")))
-
-(define (strip-subject-re subject)
-  (if (string-prefix-ci? "re:" subject)
-      (strip-subject-re (string-trim-left (string-tail subject 3)))
-      subject))
-
-(define (message-author message)
-  (or (get-first-header-field-address message "from" #f)
-      (get-first-header-field-address message "sender" #f)
-      ""))
-
-(define (message-recipient message)
-  (or (get-first-header-field-address message "to" #f)
-      (get-first-header-field-address message "apparently-to" #f)
-      ""))
-
-(define (get-first-header-field-address message name error?)
-  (let ((v (get-first-header-field-value message name error?)))
-    (and v
-        (rfc822:first-address v))))
 \f
 ;;;; Folder Operations
 

diff --git a/src/imail/imail-util.scm b/src/imail/imail-util.scm
index 7003c7117508b8705f50399992643f67538154b6..c6ac48637d15eee9be4a7de2bd198cdb2abde13f 100644 (file)
--- a/src/imail/imail-util.scm
+++ b/src/imail/imail-util.scm
@@ -596,6 +596,15 @@ USA.
 (define (remove-property! object key)
   (set-object-properties! object (del-assq! key (object-properties object))))
 
+(define (intern-property! object key generator)
+  (let* ((default (cons 0 0))
+        (datum (get-property object key default)))
+    (if (eq? datum default)
+       (let ((datum (generator object)))
+         (store-property! object key datum)
+         datum)
+       datum)))
+\f
 ;;;; Modification events
 
 (define-class <modification-event-mixin> ()