From 5cb13f15d8a944cd1bb6e2afdec68a0a362534e9 Mon Sep 17 00:00:00 2001
From: "Tom Breton (Tehom)" <tehom@panix.com>
Date: Fri, 24 Dec 2010 14:53:46 -0500
Subject: [PATCH] New signature for elinstall-proceed-p

---
 elinstall.el | 106 +++++++++++++++++++++++++++++------------------------------
 1 file changed, 53 insertions(+), 53 deletions(-)

diff --git a/elinstall.el b/elinstall.el
index e3bd056..9c41de4 100644
--- a/elinstall.el
+++ b/elinstall.el
@@ -190,9 +190,18 @@ PACKAGE can be `t' or a string naming a package."
       (apply func args)))
 ;;;_   , 
 (defun elinstall-proceed-p 
-   (topic ask-prompt &optional already-p redo-prompt noredo-msg)
+   (topic message-params &optional already-p)
    "Return non-nil if actions on TOPIC should proceed.
-Call this transitively only thru `elinstall-call-with-restraints'"
+Call this transitively only thru `elinstall-call-with-restraints'.
+TOPIC is a symbol indicating the topic, such as `byte-compile'.
+MESSAGE-PARAMS is a cons of:
+ * A list of format strings: 
+   * To ask whether to do this action
+   * To ask whether to redo this action, for `ask-for-old'
+   * To report that this action was skipped because already done.
+ * The arguments to the formatter.
+ALREADY-P is an extended boolean whether the task has been done
+   before, if caller can tell."
    
    (check-type topic symbol)
    (declare (special 
@@ -202,37 +211,42 @@ Call this transitively only thru `elinstall-call-with-restraints'"
 	      (boundp 'elinstall:*pkg-restraints*)
 	      (boundp 'elinstall:*user-restraints*))
       (error "elinstall-proceed-p called out of scope"))
-
-   (let*
-      (  (cell (assq topic elinstall:*user-restraints*))
-	 (cell (or cell (assq t elinstall:*user-restraints*)))
-	 (cell
-	    ;;`t' means use the pkg-restraints value instead.
-	    (if 
-	       (or (not cell) (eq (second cell) t))
-	       (assq topic elinstall:*pkg-restraints*)
-	       cell))
-	 (cell (or cell (assq t elinstall:*pkg-restraints*)))
-	 ;;Default is to just update.
-	 (treatment
-	    (if cell (second cell) 'update)))
-      (case treatment
-	 ((nil) 
-	    nil)
-	 ((t always) 
-	    t)
-	 (update 
-	    (if already-p
-	       (progn
-		  (message noredo-msg)
-		  nil)
-	       t))
-	 (ask-for-old
-	    (if already-p
-	       (y-or-n-p redo-prompt)
-	       t))
-	 (ask
-	    (y-or-n-p ask-prompt)))))
+    
+   (destructuring-bind
+      ((ask-prompt &optional redo-prompt noredo-msg) &rest message-args)
+      message-params
+      (let*
+	 (  ;;Get the applicable cell.  We look in several places. 
+	    (cell (assq topic elinstall:*user-restraints*))
+	    (cell (or cell (assq t elinstall:*user-restraints*)))
+	    (cell
+	       ;;`t' means use the pkg-restraints value instead.
+	       (if 
+		  (or (not cell) (eq (second cell) t))
+		  (assq topic elinstall:*pkg-restraints*)
+		  cell))
+	    (cell (or cell (assq t elinstall:*pkg-restraints*)))
+	    (treatment
+	       ;;Default is to just update.
+	       (if cell (second cell) 'update)))
+	 (case treatment
+	    ((nil) 
+	       nil)
+	    ((t always) 
+	       t)
+	    (update 
+	       (if already-p
+		  (progn
+		     (apply #'message noredo-msg message-args)
+		     nil)
+		  t))
+	    (ask-for-old
+	       (if already-p
+		  (y-or-n-p (apply #'format redo-prompt message-args))
+		  t))
+	    (ask
+	       (y-or-n-p 
+		  (apply #'format ask-prompt message-args)))))))
 
 ;;;_ , Work
 ;;;_  . Doing actions
@@ -1040,25 +1054,16 @@ Special variables are as noted in \"List of special variables\"."
 			(with-current-buffer buf 
 			   (not no-byte-compile)))
 		     (elinstall-proceed-p 'byte-compile 
-			(concat "Compile " filename "? ")
+			(list
+			   '( "Compile %s? "
+			       "Recompile %s? "
+			       "Already compiled %s.")
+			   filename)
 			(let
 			   ((dest (byte-compile-dest-file full-path)))
 			   (and 
 			      (file-exists-p dest) 
-			      (file-newer-than-file-p full-path dest)))
-			(concat "Recompile " filename "? ")
-			(concat "Already compiled " filename "."))
-		     '(elinstall-proceed-p 'byte-compile 
-			 (list
-			    '( "Compile %s? "
-				"Recompile %s? "
-				"Already compiled %s.")
-			    filename)
-			 (let
-			    ((dest (byte-compile-dest-file full-path)))
-			    (and 
-			       (file-exists-p dest) 
-			       (file-newer-than-file-p full-path dest)))))))
+			      (file-newer-than-file-p full-path dest)))))))
 	    
 	    (prog1
 	       (list
@@ -1367,11 +1372,6 @@ Recurse just if RECURSE-DIRS-P"
    "Install elisp files.  See doc for `elinstall'."
    (when 
       (elinstall-proceed-p 'install
-	 (format "Install %s? " project-name)
-	 (elinstall-already-installed project-name) 
-	 (format "Re-install %s? " project-name)
-	 (format "Already installed %s. " project-name))
-      '(elinstall-proceed-p 'install
 	  (list 
 	     '("Install %s? " 
 		 "Re-install %s? " 
-- 
2.11.4.GIT