From: Tom Breton (Tehom) <tehom@panix.com>
Date: Fri, 24 Dec 2010 21:35:23 +0000 (-0500)
Subject: New functions elinstall-get-restraint, elinstall-proceed-at-all-p.
X-Git-Url: https://repo.or.cz/w/elinstall.git/commitdiff_plain/b6bd2ec635ab9fdf3015746728f7d259a53d92fb

New functions elinstall-get-restraint, elinstall-proceed-at-all-p.
---

diff --git a/elinstall.el b/elinstall.el
index 7e63daa..8dd8110 100644
--- a/elinstall.el
+++ b/elinstall.el
@@ -226,6 +226,35 @@ PACKAGE can be `t' or a string naming a package."
 		  elinstall:*pkg-restraints*
 		  elinstall:*user-restraints*))
       (apply func args)))
+;;;_   , elinstall-get-restraint
+(defun elinstall-get-restraint (topic)
+   "Get the applicable restraint symbol for TOPIC.
+Call this transitively only thru `elinstall-call-with-restraints'."
+   (check-type topic symbol)
+   (declare (special 
+	       elinstall:*pkg-restraints*
+	       elinstall:*user-restraints*))
+   (unless (and 
+	      (boundp 'elinstall:*pkg-restraints*)
+	      (boundp 'elinstall:*user-restraints*))
+      (error "elinstall-proceed-p called out of scope"))
+   (let*
+      (
+	 (cell 
+	    (or
+	       (assq topic elinstall:*user-restraints*)
+	       (assq t     elinstall:*user-restraints*)))
+	 (cell
+	    ;;`t' means use the pkg-restraints value instead.
+	    (if 
+	       (or (not cell) (eq (second cell) t))
+	       (or
+		  (assq topic elinstall:*pkg-restraints*)
+		  (assq t     elinstall:*pkg-restraints*))
+	       cell)))
+      ;;Default is to just update.
+      (if cell (second cell) 'update)))
+
 ;;;_   , elinstall-proceed-p
 (defun elinstall-proceed-p 
    (topic message-params &optional already-p)
@@ -240,56 +269,35 @@ MESSAGE-PARAMS is a cons of:
  * The arguments to the formatter.
 ALREADY-P is an extended boolean whether the task has been done
    before, if caller can tell."
-   ;;$$FACTOR ME
-   (check-type topic symbol)
-   (declare (special 
-	       elinstall:*pkg-restraints*
-	       elinstall:*user-restraints*))
-   (unless (and 
-	      (boundp 'elinstall:*pkg-restraints*)
-	      (boundp 'elinstall:*user-restraints*))
-      (error "elinstall-proceed-p called out of scope"))
+
     
    (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 
-	       (or
-		  (assq topic elinstall:*user-restraints*)
-		  (assq t     elinstall:*user-restraints*)))
-	    (cell
-	       ;;`t' means use the pkg-restraints value instead.
-	       (if 
-		  (or (not cell) (eq (second cell) t))
-		  (or
-		     (assq topic elinstall:*pkg-restraints*)
-		     (assq t     elinstall:*pkg-restraints*))
-		  cell))
-	    (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)))))))
+      (case (elinstall-get-restraint topic)
+	 ((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))))))
 ;;;_   , elinstall-proceed-at-all-p
-;;$$WRITE ME Whether to proceed at all on a given topic.
+(defsubst elinstall-proceed-at-all-p (topic)
+   "Return non-nil if there's any possibility that actions on TOPIC should proceed."
+   ;;It just so happens that `nil' treatment corresponds to `nil'
+   ;;return value here.
+   (elinstall-get-restraint topic))
 
 ;;;_ , Work
 ;;;_  . Doing actions