~ chicken-core (chicken-5) 5611e9995bcb2d04347a8a100a94a4bc65db93bf
commit 5611e9995bcb2d04347a8a100a94a4bc65db93bf
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Jan 22 16:15:19 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:34 2016 +1300
Move `yes-or-no?` into setup-api
diff --git a/chicken-install.scm b/chicken-install.scm
index ddb277f0..76a1b684 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -25,7 +25,7 @@
(require-library setup-download setup-api)
-(require-library posix data-structures utils irregex ports extras files)
+(require-library posix data-structures irregex ports extras files)
(module main ()
@@ -40,8 +40,7 @@
chicken.irregex
chicken.ports
chicken.posix
- chicken.pretty-print
- chicken.utils)
+ chicken.pretty-print)
(include "mini-srfi-1.scm")
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index fd9dc691..8717f126 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -24,10 +24,7 @@
; POSSIBILITY OF SUCH DAMAGE.
-(require-library
- setup-api
- posix data-structures utils ports irregex files)
-
+(require-library setup-api posix data-structures ports irregex files)
(module main ()
@@ -40,8 +37,7 @@
chicken.io
chicken.irregex
chicken.ports
- chicken.posix
- chicken.utils)
+ chicken.posix)
(include "mini-srfi-1.scm")
diff --git a/chicken.scm b/chicken.scm
index 386d9572..1b6d3ae4 100644
--- a/chicken.scm
+++ b/chicken.scm
@@ -39,8 +39,7 @@
chicken.compiler.batch-driver
chicken.compiler.c-platform
chicken.compiler.support
- chicken.data-structures
- chicken.utils)
+ chicken.data-structures)
(include "tweaks")
(include "mini-srfi-1.scm")
diff --git a/manual/Unit utils b/manual/Unit utils
index d4a63d2e..31108c5c 100644
--- a/manual/Unit utils
+++ b/manual/Unit utils
@@ -71,25 +71,6 @@ to {{csc}} after invocation of the {{compile-file}} procedure.
The initial default options are {{-O2 -d2}}.
-=== Asking the user for confirmation
-
-==== yes-or-no?
-
-<procedure>(yes-or-no? MESSAGE #!key default title abort)</procedure>
-
-Prints the string {{MESSAGE}} and asks for entering "yes", "no" or "abort".
-If running under Windows in GUI mode, then a suitable dialog box is shown.
-Returns either {{#t}} or {{#f}} depending on whether {{yes}} or {{no}}
-was entered. The {{default}} keyword argument specifies the default
-answer that is effective if the user just presses ENTER (or the default
-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. A value of {{#f}} for {{abort}} disables
-aborting completely.
-
-
Previous: [[Unit posix]]
Next: [[Unit tcp]]
diff --git a/rules.make b/rules.make
index a004bcab..c9ab1266 100644
--- a/rules.make
+++ b/rules.make
@@ -533,8 +533,7 @@ chicken.c: chicken.scm mini-srfi-1.scm \
chicken.compiler.batch-driver.import.scm \
chicken.compiler.c-platform.import.scm \
chicken.compiler.support.import.scm \
- chicken.data-structures.import.scm \
- chicken.utils.import.scm
+ chicken.data-structures.import.scm
batch-driver.c: batch-driver.scm mini-srfi-1.scm \
chicken.compiler.core.import.scm \
chicken.compiler.compiler-syntax.import.scm \
diff --git a/setup-api.scm b/setup-api.scm
index 2398ff84..39c5a387 100644
--- a/setup-api.scm
+++ b/setup-api.scm
@@ -63,8 +63,9 @@
read-info
register-program find-program
shellpath
- setup-error-handling)
-
+ setup-error-handling
+ yes-or-no?)
+
(import scheme chicken
chicken.data-structures
chicken.files
@@ -661,6 +662,80 @@
(print-error-message c (current-error-port))
(reset))))
+;;; Confirmation dialog
+
+#>
+#if defined(_WIN32) && !defined(__CYGWIN__)
+# include <windows.h>
+# define C_HAS_MESSAGE_BOX 1
+static int
+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;
+ case 1: d = MB_DEFBUTTON2; break;
+ case 2: d = MB_DEFBUTTON3;
+ }
+
+ r = MessageBox(NULL, msg, caption, t | MB_ICONQUESTION | d);
+
+ switch(r) {
+ case IDYES: return 1;
+ case IDNO: return 0;
+ default: return -1;
+ }
+}
+#else
+# define C_HAS_MESSAGE_BOX 0
+static int
+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 bool)))
+ (lambda (str #!key default title (abort reset))
+ (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")))
+ (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\", \"no\" or \"abort\".~%")
+ (printf "~%Please enter \"yes\" or \"no\".~%"))
+ (loop)))))))))
;;; Module Setup
diff --git a/types.db b/types.db
index 732cf11f..302ab216 100644
--- a/types.db
+++ b/types.db
@@ -2275,4 +2275,3 @@
(chicken.utils#qs (#(procedure #:clean #:enforce) chicken.utils#qs (string) string))
(chicken.utils#compile-file (#(procedure #:clean #:enforce) chicken.utils#compile-file (string #!rest) (or false string)))
(chicken.utils#compile-file-options (#(procedure #:clean #:enforce) chicken.utils#compile-file-options (#!optional (list-of string)) (list-of string)))
-(chicken.utils#yes-or-no? (#(procedure #:enforce) chicken.utils#yes-or-no? (string #!rest) *))
diff --git a/utils.scm b/utils.scm
index 94f4ca69..e38b852e 100644
--- a/utils.scm
+++ b/utils.scm
@@ -27,7 +27,7 @@
(declare
(unit utils)
- (uses data-structures eval extras posix files irregex)
+ (uses data-structures eval extras posix files)
(fixnum)
(disable-interrupts) )
@@ -35,7 +35,6 @@
(compile-file
compile-file-options
system*
- yes-or-no?
qs)
(import scheme chicken)
@@ -43,9 +42,7 @@
chicken.files
chicken.foreign
chicken.format
- chicken.io
- chicken.posix
- chicken.irregex)
+ chicken.posix)
(include "common-declarations.scm")
@@ -116,80 +113,4 @@
f))))
(else #f)))))))
-
-;; Ask for confirmation
-
-#>
-#if defined(_WIN32) && !defined(__CYGWIN__)
-# include <windows.h>
-# define C_HAS_MESSAGE_BOX 1
-static int
-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;
- case 1: d = MB_DEFBUTTON2; break;
- case 2: d = MB_DEFBUTTON3;
- }
-
- r = MessageBox(NULL, msg, caption, t | MB_ICONQUESTION | d);
-
- switch(r) {
- case IDYES: return 1;
- case IDNO: return 0;
- default: return -1;
- }
-}
-#else
-# define C_HAS_MESSAGE_BOX 0
-static int
-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 bool)))
- (lambda (str #!key default title (abort reset))
- (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")))
- (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\", \"no\" or \"abort\".~%")
- (printf "~%Please enter \"yes\" or \"no\".~%"))
- (loop) ) ) ) ) ) ) ) )
-
)
Trap