From b862a5a80162ddbaf6e0674aa6d49ab83fad144e Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 23 May 2000 03:55:56 +0000
Subject: [PATCH] Add configurable confirmation for performing EXPUNGE.

---
 v7/src/imail/imail-top.scm | 59 ++++++++++++++++++++++++++++++++++----
 v7/src/imail/load.scm      |  3 +-
 2 files changed, 56 insertions(+), 6 deletions(-)

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index fa2ae8fba..29c376726 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.93 2000/05/23 03:27:07 cph Exp $
+;;; $Id: imail-top.scm,v 1.94 2000/05/23 03:55:50 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -66,11 +66,21 @@ The procedure is called with one argument, a list of headers,
   #f
   boolean?)
 
+(define-variable imail-expunge-confirmation
+  "Control what kind of confirmation is required for expunging messages.
+The following symbols are permissible values:
+NONE		no confirmation
+BRIEF		`y' or `n'
+VERBOSE		`yes' or `no'
+COMPLETE	`yes' or `no', showing messages to be expunged"
+  'COMPLETE
+  (lambda (object) (memq object '(NONE BRIEF VERBOSE COMPLETE))))
+
 (define-variable imail-reply-with-re
   "True means prepend subject with Re: in replies."
   #f
   boolean?)
-
+
 (define-variable imail-primary-folder
   "URL for the primary folder that you read your mail from."
   #f
@@ -872,7 +882,7 @@ With prefix argument N, undeletes backward N messages,
  or forward if N is negative."
   "p"
   (lambda (delta) ((ref-command imail-undelete-forward) (- delta))))
-
+
 (define-command imail-expunge
   "Actually erase all deleted messages in the folder."
   ()
@@ -886,8 +896,47 @@ With prefix argument N, undeletes backward N messages,
 		     (next-message message)
 		     (previous-message message))
 		 message))))
-      (expunge-deleted-messages folder)
-      (select-message folder message))))
+      (if (let ((confirmation (ref-variable imail-expunge-confirmation)))
+	    (or (eq? confirmation 'NONE)
+		(let ((n (count-messages folder message-deleted?)))
+		  (and (> n 0)
+		       (let ((prompt
+			      (string-append "Expunge "
+					     (number->string n)
+					     " message"
+					     (if (> n 1) "s" "")
+					     " marked for deletion")))
+			 (case (ref-variable imail-expunge-confirmation)
+			   ((BRIEF) (prompt-for-confirmation? prompt))
+			   ((VERBOSE) (prompt-for-yes-or-no? prompt))
+			   ((COMPLETE)
+			    (cleanup-pop-up-buffers
+			     (lambda ()
+			       (imail-expunge-pop-up-messages folder)
+			       (prompt-for-yes-or-no? prompt))))
+			   (else #t)))))))
+	  (begin
+	    (expunge-deleted-messages folder)
+	    (select-message folder message))))))
+
+(define (count-messages folder predicate)
+  (let ((n (folder-length folder)))
+    (do ((i 0 (+ i 1))
+	 (k 0 (if (predicate (get-message folder i)) (+ k 1) k)))
+	((= i n) k))))
+
+(define (imail-expunge-pop-up-messages folder)
+  (pop-up-temporary-buffer " *imail-message*" '(READ-ONLY SHRINK-WINDOW)
+    (lambda (buffer window)
+      (local-set-variable! truncate-partial-width-windows #f buffer)
+      (let ((mark (mark-left-inserting-copy (buffer-point buffer)))
+	    (n (folder-length folder)))
+	(let ((index-digits (exact-nonnegative-integer-digits (- n 1))))
+	  (do ((i 0 (+ i 1)))
+	      ((= i n))
+	    (let ((m (get-message folder i)))
+	      (if (message-deleted? m)
+		  (write-imail-summary-line! m index-digits mark)))))))))
 
 ;;;; Message flags
 
diff --git a/v7/src/imail/load.scm b/v7/src/imail/load.scm
index a8a160329..68669dfc3 100644
--- a/v7/src/imail/load.scm
+++ b/v7/src/imail/load.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: load.scm,v 1.8 2000/05/22 15:08:46 cph Exp $
+;;; $Id: load.scm,v 1.9 2000/05/23 03:55:56 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -82,6 +82,7 @@
 	    edwin-variable$imail-default-user-id
 	    edwin-variable$imail-delete-after-output
 	    edwin-variable$imail-dont-reply-to-names
+	    edwin-variable$imail-expunge-confirmation
 	    edwin-variable$imail-ignored-headers
 	    edwin-variable$imail-kept-headers
 	    edwin-variable$imail-message-filter
-- 
2.25.1