Ticket #261: utils.scm.diff

utils.scm

@@ -136 +136 @@
 # 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 +147 @@
   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 +158 @@
 #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
 <#
 
 (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) ) ) ) ) ) ) ) )