Add indication of message's length to summary buffer.

diff --git a/v7/src/imail/imail-summary.scm b/v7/src/imail/imail-summary.scm
index a88700b5eed30c0516877cd6e9eccb2f4bbd4dcd..2a86bec08765a5e96e75fd0116a0be8c8cfa7012 100644 (file)
--- a/v7/src/imail/imail-summary.scm
+++ b/v7/src/imail/imail-summary.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-summary.scm,v 1.4 2000/05/18 17:16:28 cph Exp $
+;;; $Id: imail-summary.scm,v 1.5 2000/05/18 20:55:04 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -202,26 +202,32 @@ The recipients are specified as a comma-separated list of names."
        (set-buffer-point! buffer mark))))
 \f
 (define (fill-imail-summary-buffer! buffer folder predicate)
-  (let ((messages
-        (let ((end (folder-length folder)))
+  (let ((end (folder-length folder)))
+    (let ((messages
           (let loop ((i 0) (messages '()))
             (if (< i end)
                 (loop (+ i 1) (cons (get-message folder i) messages))
-                (reverse! messages))))))
-    (let ((mark (mark-left-inserting-copy (buffer-start buffer))))
-      (for-each (lambda (message)
-                 (if (or (not predicate) (predicate message))
-                     (write-imail-summary-line! message mark)))
-               messages)
-      (mark-temporary! mark))))
+                (reverse! messages))))
+         (index-digits
+          (let loop ((n 1) (k 10))
+            (if (< end k)
+                n
+                (loop (+ n 1) (* k 10))))))
+      (let ((mark (mark-left-inserting-copy (buffer-start buffer))))
+       (for-each (lambda (message)
+                   (if (or (not predicate) (predicate message))
+                       (write-imail-summary-line! message index-digits mark)))
+                 messages)
+       (mark-temporary! mark)))))
 
-(define (write-imail-summary-line! message mark)
+(define (write-imail-summary-line! message index-digits mark)
   (insert-char (if (message-deleted? message) #\D #\space) mark)
   (insert-string-pad-left (number->string (+ (message-index message) 1))
-                         4 #\space mark)
+                         index-digits #\space mark)
   (insert-string "  " mark)
-  (insert-string-pad-right (message-summary-date-string message)
-                          6 #\space mark)
+  (insert-string (message-summary-length-string message) mark)
+  (insert-string " " mark)
+  (insert-string (message-summary-date-string message) mark)
   (insert-string "  " mark)
   (let ((target-column (+ (mark-column mark) 40)))
     (insert-string (message-summary-subject-string message) mark)
@@ -233,6 +239,9 @@ The recipients are specified as a comma-separated list of names."
   (insert-string (message-summary-from-string message) mark)
   (insert-newline mark))
 
+(define (message-summary-length-string message)
+  (abbreviate-exact-nonnegative-integer (message-length message) 5))
+
 (define (message-summary-date-string message)
   (let ((t (message-time message)))
     (if t
@@ -241,7 +250,7 @@ The recipients are specified as a comma-separated list of names."
           (string-pad-left (number->string (decoded-time/day dt)) 2)
           " "
           (month/short-string (decoded-time/month dt))))
-       "")))
+       (make-string 6 #\space))))
 
 (define (message-summary-from-string message)
   (let* ((s

diff --git a/v7/src/imail/imail-util.scm b/v7/src/imail/imail-util.scm
index e216cd24320039cc9ff88b9cde8aec36b855fcb8..813241dbdfdab64e587731ca5e35cfd4f02c15a5 100644 (file)
--- a/v7/src/imail/imail-util.scm
+++ b/v7/src/imail/imail-util.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-util.scm,v 1.15 2000/05/16 15:15:14 cph Exp $
+;;; $Id: imail-util.scm,v 1.16 2000/05/18 20:55:05 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -210,4 +210,33 @@
     line))
 
 (define (edwin-variable-value name)
-  (variable-value (name->variable name 'ERROR)))
\ No newline at end of file
+  (variable-value (name->variable name 'ERROR)))
+
+(define (abbreviate-exact-nonnegative-integer n k)
+  (if (< n (expt 10 (- k 1)))
+      (string-append (string-pad-left (number->string n) (- k 1)) " ")
+      (let ((s
+            (fluid-let ((flonum-unparser-cutoff `(RELATIVE ,k ENGINEERING)))
+              (number->string (exact->inexact n)))))
+       (let ((regs (re-string-match "\\([0-9.]+\\)e\\([0-9]+\\)" s)))
+         (let ((mantissa (re-match-extract s regs 1))
+               (exponent (string->number (re-match-extract s regs 2))))
+           (if (> exponent 12)
+               (make-string k #\+)
+               (string-append
+                (let ((l (string-length mantissa))
+                      (k (- k 1)))
+                  (cond ((< l k)
+                         (string-pad-left mantissa k))
+                        ((= l k)
+                         mantissa)
+                        ((char=? #\. (string-ref mantissa (- k 1)))
+                         (string-append " " (string-head mantissa (- k 1))))
+                        (else
+                         (string-head mantissa k))))
+                (case exponent
+                  ((0) " ")
+                  ((3) "k")
+                  ((6) "M")
+                  ((9) "G")
+                  ((12) "T")))))))))
\ No newline at end of file