~ chicken-core (chicken-5) 6a5a70b0e39adcba2c106a035dfb7005b8841ebf

commit 6a5a70b0e39adcba2c106a035dfb7005b8841ebf
Author:     felix <bunny351@gmail.com>
AuthorDate: Thu Jun 3 09:08:00 2010 +0200
Commit:     felix <bunny351@gmail.com>
CommitDate: Thu Jun 3 09:08:00 2010 +0200

    fixed bug in handling of file-requirements table for extensions; fixed broken yes-or-no? in gui mode

diff --git a/eval.scm b/eval.scm
index cb00ab75..d557e62a 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1234,10 +1234,12 @@
 			      ,@(if s `((##core#require-for-syntax ',id)) '())
 			      ,@(if (or nr (and (not rr) s))
 				    '()
-				    `((##sys#require
-				       ,@(map (lambda (id) `',id)
-					      (cond (rr (cdr rr))
-						    (else (list id)) ) ) ) ) ) )
+				    (begin
+				      (add-req id #f)
+				      `((##sys#require
+					 ,@(map (lambda (id) `',id)
+						(cond (rr (cdr rr))
+						      (else (list id)) ) ) ) ) ) ) )
 			    impid #f)
 			   #t) ) )
 		       (else
diff --git a/manual/Unit utils b/manual/Unit utils
index d4515bbe..e1af0895 100644
--- a/manual/Unit utils	
+++ b/manual/Unit utils	
@@ -110,7 +110,8 @@ button in case of a dialog box). {{title}} specifies the text shown
 in the caption of the dialog box and is ignored when not running in
 GUI mode. {{abort}} should be a zero-argument procedure that is
 called when the user selects "abort". The default value for {{abort}}
-is the {{reset}} procedure.
+is the {{reset}} procedure. A value of {{#f}} for {{abort}} disables
+aborting completely.
 
 
 Previous: [[Unit posix]]
diff --git a/utils.scm b/utils.scm
index 418129ac..03bd4ed6 100644
--- a/utils.scm
+++ b/utils.scm
@@ -136,9 +136,10 @@
 # include <windows.h>
 # define C_HAS_MESSAGE_BOX 1
 static int
-C_confirmation_dialog(char *msg, char *caption, int def)
+C_confirmation_dialog(char *msg, char *caption, int def, int abort)
 {
   int d = 0, r;
+  int t = abort ? MB_YESNOCANCEL : MB_YESNO;
 
   switch(def) {
   case 0: d = MB_DEFBUTTON1; break;
@@ -146,7 +147,7 @@ C_confirmation_dialog(char *msg, char *caption, int def)
   case 2: d = MB_DEFBUTTON3;
   }
 
-  r = MessageBox(NULL, msg, caption, MB_YESNOCANCEL | MB_ICONQUESTION | d);
+  r = MessageBox(NULL, msg, caption, t | MB_ICONQUESTION | d);
 
   switch(r) {
   case IDYES: return 1;
@@ -157,39 +158,49 @@ C_confirmation_dialog(char *msg, char *caption, int def)
 #else
 # define C_HAS_MESSAGE_BOX 0
 static int
-C_confirmation_dialog(char *msg, char *caption, int def) { return -1; }
+C_confirmation_dialog(char *msg, char *caption, int def, int abort) { return -1; }
 #endif
 <#
 
+;; Note: for Mac OS X, "CFUserNotificationDisplayAlert" could be used,
+;;       unless that requires linking any libraries. This would also
+;;       be useful for runtime error messages.
+
 (define-foreign-variable C_HAS_MESSAGE_BOX bool)
 
 (define yes-or-no?
-  (let ((dialog (foreign-lambda int "C_confirmation_dialog" c-string c-string int)))
+  (let ((dialog (foreign-lambda int "C_confirmation_dialog" c-string c-string int bool)))
     (lambda (str #!key default title (abort reset))
-      (define (get-input)
-	(if (and C_HAS_MESSAGE_BOX (not (##sys#fudge 4))) ; C_gui_mode
-	    (let ((r (dialog 
-		      str
-		      (or title "CHICKEN Runtime")
-		      (cond ((string-ci=? default "yes") 0)
-			    ((string-ci=? default "no") 1)
-			    (else 2)))))
-	      (case r
-		((0) "no")
-		((1) "yes")
-		(else "abort")))
-	    (string-trim-both (read-line))))
-      (let loop ()
-	(printf "~%~A (yes/no/abort) " str)
-	(when default (printf "[~A] " default))
-	(flush-output)
-	(let ((ln (get-input)))
-	  (cond ((eof-object? ln) (set! ln "abort"))
-		((and default (string=? "" ln)) (set! ln default)) )
-	  (cond ((string-ci=? "yes" ln) #t)
-		((string-ci=? "no" ln) #f)
-		((string-ci=? "abort" ln) (abort))
-		(else
-		 (printf "~%Please enter \"yes\", \"no\" or \"abort\".~%")
-		 (loop) ) ) ) ) ) ) )
+      (let ((gui (and C_HAS_MESSAGE_BOX (not (##sys#fudge 4))))) ; C_gui_mode
+	(define (get-input)
+	  (if gui
+	      (let ((r (dialog 
+			str
+			(or title "CHICKEN Runtime")
+			(cond ((not default) 3)
+			      ((string-ci=? default "yes") 0)
+			      ((string-ci=? default "no") 1)
+			      (else 2))
+			abort)))
+		(case r
+		  ((0) "no")
+		  ((1) "yes")
+		  (else "abort")))
+	      (string-trim-both (read-line))))
+	(let loop ()
+	  (unless gui
+	    (printf "~%~A (yes/no~a) " str (if abort "/abort" ""))
+	    (when default (printf "[~A] " default))
+	    (flush-output))
+	  (let ((ln (get-input)))
+	    (cond ((eof-object? ln) (set! ln "abort"))
+		  ((and default (string=? "" ln)) (set! ln default)) )
+	    (cond ((string-ci=? "yes" ln) #t)
+		  ((string-ci=? "no" ln) #f)
+		  ((and abort (string-ci=? "abort" ln)) (abort))
+		  (else
+		   (if abort
+		       (printf "~%Please enter \"yes\" or \"no\".~%")
+		       (printf "~%Please enter \"yes\", \"no\" or \"abort\".~%"))
+		   (loop) ) ) ) ) ) ) ) )