Reimplement low-level IMAP tracing code to be a complete transcript

mechanism.

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 3686c25614804ba53e44761de114454cfa3a4497..face7ab539f439b6c9d6df54229ffe552d06b4bd 100644 (file)
--- 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.56 2000/05/18 22:11:14 cph Exp $
+;;; $Id: imail-imap.scm,v 1.57 2000/05/19 02:31:07 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -897,18 +897,18 @@
        (port (imap-connection-port connection)))
     (if imail-trace?
        (imail-trace-record-output (cons* 'SEND tag command arguments)))
-    (write-string tag port)
-    (write-char #\space port)
-    (write command port)
+    (imap-transcript-write-string tag port)
+    (imap-transcript-write-char #\space port)
+    (imap-transcript-write command port)
     (for-each (lambda (argument)
                (if argument
                    (begin
-                     (write-char #\space port)
+                     (imap-transcript-write-char #\space port)
                      (imap:send-command-argument connection tag argument))))
              arguments)
-    (write-char #\return port)
-    (write-char #\linefeed port)
-    (flush-output port)
+    (imap-transcript-write-char #\return port)
+    (imap-transcript-write-char #\linefeed port)
+    (imap-transcript-flush-output port)
     tag))
 
 (define (imap:send-command-argument connection tag argument)
@@ -916,11 +916,11 @@
     (let loop ((argument argument))
       (cond ((or (symbol? argument)
                 (exact-nonnegative-integer? argument))
-            (write argument port))
+            (imap-transcript-write argument port))
            ((and (pair? argument)
                  (eq? (car argument) 'ATOM)
                  (string? (cdr argument)))
-            (write-string (cdr argument) port))
+            (imap-transcript-write-string (cdr argument) port))
            ((and (pair? argument)
                  (eq? (car argument) 'LITERAL)
                  (string? (cdr argument)))
@@ -930,21 +930,21 @@
                 (imap:write-quoted-string argument port)
                 (imap:write-literal-string connection tag argument)))
            ((list? argument)
-            (write-char #\( port)
+            (imap-transcript-write-char #\( port)
             (if (pair? argument)
                 (begin
                   (loop (car argument))
                   (for-each (lambda (object)
-                              (write-char #\space port)
+                              (imap-transcript-write-char #\space port)
                               (loop object))
                             (cdr argument))))
-            (write-char #\) port))
+            (imap-transcript-write-char #\) port))
            (else (error "Illegal IMAP syntax:" argument))))))
 
 (define (imap:write-literal-string connection tag string)
   (let ((port (imap-connection-port connection)))
     (imap:write-literal-string-header string port)
-    (flush-output port)
+    (imap-transcript-flush-output port)
     (let loop ()
       (let ((response (imap:read-server-response port)))
        (cond ((imap:response:continue? response)

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 0b91c1bbee18268da4fa3fa774c92241e5d3984f..e36282befe334bafbbed56b4a71c839cff0cc02a 100644 (file)
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.35 2000/05/18 19:53:25 cph Exp $
+;;; $Id: imail.pkg,v 1.36 2000/05/19 02:31:05 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -150,6 +150,11 @@
   (files "imap-response")
   (parent (edwin imail))
   (export (edwin imail)
+         imap-transcript-flush-output
+         imap-transcript-write
+         imap-transcript-write-char
+         imap-transcript-write-string
+         imap-transcript-write-substring
          imap:read-literal-progress-hook
          imap:read-server-response
          imap:response-code:alert?
@@ -191,7 +196,8 @@
          imap:response:status-response?
          imap:response:status?
          imap:response:tag
-         trace-imap-server-responses?))
+         start-imap-transcript
+         stop-imap-transcript))
 
 (define-package (edwin imail)
   (files "imail-util"

diff --git a/v7/src/imail/imap-syntax.scm b/v7/src/imail/imap-syntax.scm
index 0fa8f313a4b07cfc4ca28e67b5a491c62db950d6..0a539322a1531bcf30e6689fcb893cfad83aac09 100644 (file)
--- a/v7/src/imail/imap-syntax.scm
+++ b/v7/src/imail/imap-syntax.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-syntax.scm,v 1.9 2000/05/16 15:14:17 cph Exp $
+;;; $Id: imap-syntax.scm,v 1.10 2000/05/19 02:31:12 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -573,26 +573,26 @@
   (imap:write-quoted-substring string 0 (string-length string) port))
 
 (define (imap:write-quoted-substring string start end port)
-  (write-char #\" port)
+  (imap-transcript-write-char #\" port)
   (let loop ((start start))
     (if (fix:< start end)
        (let ((char (string-ref string start)))
          (if (or (char=? char #\\) (char=? char #\"))
-             (write-char #\\ port))
-         (write-char char port)
+             (imap-transcript-write-char #\\ port))
+         (imap-transcript-write-char char port)
          (loop (fix:+ start 1)))))
-  (write-char #\" port))
+  (imap-transcript-write-char #\" port))
 
 (define (imap:write-literal-string-header string port)
   (imap:write-literal-substring-header string 0 (string-length string) port))
 
 (define (imap:write-literal-substring-header string start end port)
   string
-  (write-char #\{ port)
-  (write (fix:- end start) port)
-  (write-char #\} port)
-  (write-char #\return port)
-  (write-char #\linefeed port))
+  (imap-transcript-write-char #\{ port)
+  (imap-transcript-write (fix:- end start) port)
+  (imap-transcript-write-char #\} port)
+  (imap-transcript-write-char #\return port)
+  (imap-transcript-write-char #\linefeed port))
 
 (define (imap:write-literal-string-body string port)
   (imap:write-literal-substring-body string 0 (string-length string) port))
@@ -604,11 +604,11 @@
        (let ((index (substring-find-next-char string start end #\newline)))
          (if index
              (begin
-               (write-substring string start index port)
-               (write-char #\return port)
-               (write-char #\linefeed port)
+               (imap-transcript-write-substring string start index port)
+               (imap-transcript-write-char #\return port)
+               (imap-transcript-write-char #\linefeed port)
                (loop (fix:+ index 1)))
-             (write-substring string start end port))))))
+             (imap-transcript-write-substring string start end port))))))
 
 (define (imap:universal-time->date-time time)
   (imap:decoded-time->date-time (universal-time->global-decoded-time time)))