From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 18 May 2000 20:55:05 +0000 (+0000)
Subject: Add indication of message's length to summary buffer.
X-Git-Tag: 20090517-FFI~3814
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=17a43236e79b5cb21cf9622ad141457fa50fde5e;p=mit-scheme.git

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 a88700b5e..2a86bec08 100644
--- 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))))
 
 (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 e216cd243..813241dbd 100644
--- 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