From: Chris Hanson Date: Tue, 23 May 2000 02:57:49 +0000 (+0000) Subject: Add "online" indicator to the modeline, and implement command to X-Git-Tag: 20090517-FFI~3722 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1d0f536e52aaddf9e110c5149dbadc48b3a120d7;p=mit-scheme.git Add "online" indicator to the modeline, and implement command to disconnect from server. --- diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm index 2a2700398..afdd37eb1 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.87 2000/05/22 20:51:00 cph Exp $ +;;; $Id: imail-core.scm,v 1.88 2000/05/23 02:57:13 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -375,6 +375,21 @@ ;; Probe FOLDER's server for changes. Useful as a check for new mail. (define-generic probe-folder (folder)) + +;; ------------------------------------------------------------------- +;; Return a symbol representing FOLDER's connection status. The +;; returned value is one of the following symbols: +;; ONLINE Open connection to the server. +;; OFFLINE No connection to the server. +;; NO-SERVER Folder is not server-based. + +(define-generic folder-connection-status (folder)) + +;; ------------------------------------------------------------------- +;; Disconnect FOLDER from its associated server. The folder will +;; automatically reconnect as needed. + +(define-generic disconnect-folder (folder)) ;;;; Message type diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm index 3f511f266..fef77ec39 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.37 2000/05/22 20:32:37 cph Exp $ +;;; $Id: imail-file.scm,v 1.38 2000/05/23 02:57:18 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -239,5 +239,13 @@ (close-folder folder)) (define-method probe-folder ((folder )) + folder + unspecific) + +(define-method folder-connection-status ((folder )) + folder + 'NO-SERVER) + +(define-method disconnect-folder ((folder )) folder unspecific) \ No newline at end of file diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm index a3c07189e..7f89ebbd6 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.79 2000/05/23 00:37:57 cph Exp $ +;;; $Id: imail-imap.scm,v 1.80 2000/05/23 02:57:21 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -823,18 +823,16 @@ (define-method %close-folder ((folder )) (let ((connection (imap-folder-connection folder))) (maybe-close-imap-connection connection) - (set-imap-connection-folder! connection #f))) + (set-imap-connection-folder! connection #f)) + (folder-modified! folder 'STATUS)) (define-method folder-length ((folder )) - (guarantee-imap-folder-open folder) (imap-folder-n-messages folder)) (define-method %get-message ((folder ) index) - (guarantee-imap-folder-open folder) (vector-ref (imap-folder-messages folder) index)) (define-method first-unseen-message-index ((folder )) - (guarantee-imap-folder-open folder) (or (imap-folder-unseen folder) 0)) (define-method expunge-deleted-messages ((folder )) @@ -870,6 +868,14 @@ (define-method probe-folder ((folder )) (guarantee-imap-folder-open folder) (imap:command:noop (imap-folder-connection folder))) + +(define-method folder-connection-status ((folder )) + (if (test-imap-connection-open (imap-folder-connection folder)) + 'ONLINE + 'OFFLINE)) + +(define-method disconnect-folder ((folder )) + (close-folder folder)) ;;;; IMAP command invocation diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm index f23ce59f5..419b07c7d 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.91 2000/05/23 02:26:01 cph Exp $ +;;; $Id: imail-top.scm,v 1.92 2000/05/23 02:57:28 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -292,6 +292,8 @@ DEL Scroll to previous screen of this message. \\[imail-expunge] Expunge deleted messages. \\[imail-save-folder] Save the current folder. +\\[imail-get-new-mail] Poll the server for changes. +\\[imail-disconnect] Disconnect from the server. \\[imail-quit] Quit IMAIL: save, then switch to another buffer. \\[imail-mail] Mail a message (same as \\[mail-other-window]). @@ -352,6 +354,7 @@ DEL Scroll to previous screen of this message. (define-key 'imail #\x 'imail-expunge) (define-key 'imail #\g 'imail-get-new-mail) +(define-key 'imail #\m-d 'imail-disconnect) (define-key 'imail #\s 'imail-save-folder) (define-key 'imail #\c-m-h 'imail-summary) @@ -706,8 +709,13 @@ With prefix argument N moves backward N messages with these flags." (index (message-index message))) (and folder (if index - (let ((n (folder-length folder))) + (let ((n (folder-length folder)) + (status (folder-connection-status folder))) (string-append + (case status + ((ONLINE) " online") + ((OFFLINE) " offline") + (else "")) " " (number->string (+ 1 index)) "/" @@ -1216,6 +1224,13 @@ Currently useful only for IMAP folders." message #t (not (get-property message 'FULL-HEADERS? #f)))))) + +(define-command imail-disconnect + "Disconnect the selected IMAIL folder from its server. +Has no effect on non-server-based folders." + () + (lambda () + (disconnect-folder (selected-folder)))) (define-command imail-search "Show message containing next match for given string. diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt index aa58190e6..548c61f75 100644 --- 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.39 2000/05/23 02:12:10 cph Exp $ +$Id: todo.txt,v 1.40 2000/05/23 02:57:49 cph Exp $ Bug fixes --------- @@ -54,8 +54,6 @@ New features * Write M-x imail-resend. -* Add an indication showing the connection status in the mode line. - * Add mail notification in mode line, active across the editor as long as there is an IMAP connection open in some buffer.