Implement mechanism to poll the IMAP server in the background at a

specified interval.

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index e1acc54ca4ddb9b16f1a630628e7ce06f1759361..fe30e984cf7203aac26f011309e2f6f4471136df 100644 (file)
--- 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.107 2000/05/24 23:21:53 cph Exp $
+;;; $Id: imail-top.scm,v 1.108 2000/05/25 05:06:38 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -113,6 +113,16 @@ The pass phrase is deleted if unused for this long.
 Set this to zero if you don't want pass-phrase retention."
   30
   exact-nonnegative-integer?)
+
+(define-variable imail-update-interval
+  "How often to update a folder's contents, in seconds.
+IMAIL will periodically poll the mail server for changes at this interval.
+The polls will only occur when there is an open connection to the server;
+  it will not reestablish a connection when there is none.
+This has no effect on file-based folders.
+Set this variable to #F to disable updating."
+  600
+  (lambda (x) (or (not x) (and (exact-integer? x) (positive? x)))))
 \f
 (define-command imail
   "Read and edit incoming mail.
@@ -692,7 +702,9 @@ With prefix argument N moves backward N messages with these flags."
        (lambda (folder type parameters)
         type parameters
         (maybe-add-command-suffix! notice-folder-modifications folder)))
-     (add-kill-buffer-hook buffer delete-associated-buffers))))
+     (add-kill-buffer-hook buffer delete-associated-buffers)
+     (add-kill-buffer-hook buffer stop-probe-folder-thread)
+     (start-probe-folder-thread buffer))))
 
 (define (delete-associated-buffers folder-buffer)
   (for-each (lambda (buffer)
@@ -728,6 +740,57 @@ With prefix argument N moves backward N messages with these flags."
   (or (buffer-get buffer 'IMAIL-FOLDER-BUFFER #f)
       buffer))
 \f
+(define (start-probe-folder-thread buffer)
+  (stop-probe-folder-thread buffer)
+  (let ((folder (buffer-get buffer 'IMAIL-FOLDER #f))
+       (interval (ref-variable imail-update-interval #f)))
+    (if (and folder interval
+            (not (get-property folder 'PROBE-REGISTRATION #f)))
+       (let ((registration (list #f)))
+         (set-car! registration
+                   (register-inferior-thread!
+                    (let ((thread
+                           (create-thread
+                            editor-thread-root-continuation
+                            (probe-folder-thread registration
+                                                 (* 1000 interval)))))
+                      (detach-thread thread)
+                      thread)
+                    (probe-folder-output-processor
+                     (weak-cons folder unspecific))))
+         (store-property! folder 'PROBE-REGISTRATION registration)))))
+
+(define ((probe-folder-thread registration interval))
+  (do () (#f)
+    (let ((registration (car registration)))
+      (cond ((eq? registration 'KILL-THREAD) (exit-current-thread unspecific))
+           (registration (inferior-thread-output! registration))))
+    (sleep-current-thread interval)))
+
+(define ((probe-folder-output-processor folder))
+  (let ((folder (weak-car folder)))
+    (and folder
+        (eq? (folder-connection-status folder) 'ONLINE)
+        (begin
+          (probe-folder folder)
+          #t))))
+
+(define (stop-probe-folder-thread buffer)
+  (without-interrupts
+   (lambda ()
+     (let ((folder (buffer-get buffer 'IMAIL-FOLDER #f)))
+       (if folder
+          (begin
+            (let ((holder (get-property folder 'PROBE-REGISTRATION #f)))
+              (if holder
+                  (begin
+                    (let ((registration (car holder)))
+                      (if (and registration
+                               (not (eq? registration 'KILL-THREAD)))
+                          (deregister-inferior-thread! registration)))
+                    (set-car! holder 'KILL-THREAD))))
+            (remove-property! folder 'PROBE-REGISTRATION)))))))
+\f
 (define (selected-folder #!optional error? buffer)
   (let ((buffer
         (chase-imail-buffer

diff --git a/v7/src/imail/load.scm b/v7/src/imail/load.scm
index 2ded80a46cac670200c522076c04a55dd790eefe..c6f0498d35747be517e46143d2db68193cd9d96b 100644 (file)
--- a/v7/src/imail/load.scm
+++ b/v7/src/imail/load.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: load.scm,v 1.10 2000/05/24 20:23:07 cph Exp $
+;;; $Id: load.scm,v 1.11 2000/05/25 05:06:45 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -94,4 +94,5 @@
            edwin-variable$imail-summary-mode-hook
            edwin-variable$imail-summary-pop-up-message
            edwin-variable$imail-summary-show-date
-           edwin-variable$imail-summary-subject-width))
\ No newline at end of file
+           edwin-variable$imail-summary-subject-width
+           edwin-variable$imail-update-interval))
\ No newline at end of file

diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index 2f191663220c057315df04a238a70610b9d1319b..1102d46cba511aa8eb0df7c95b90a8344fa3681b 100644 (file)
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,5 +1,5 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.49 2000/05/24 19:45:21 cph Exp $
+$Id: todo.txt,v 1.50 2000/05/25 05:06:55 cph Exp $
 
 Bug fixes
 ---------
@@ -38,9 +38,6 @@ New features
 * Add mail notification in mode line, active across the editor as long
   as there is an IMAP connection open in some buffer.
 
-* Implement background thread to periodically send NOOP to IMAP server
-  both to check for new mail and to keep the connection alive.
-
 * Implement cache that saves information about messages on disk.  This
   should use UIDs for IMAP folders; for other folders perhaps the
   message ID can be used.  (Or perhaps no cache is required for