* Changed gui-utils:get-choice to take an optional argument for a checkbox

* Made the DrScheme quit dialog have a dont-ask-again option * Changed the string constant of dont-ask-again to have no parenthesis, put that in the dont-ask-again-always-current string constant svn: r3173
2006-06-01 20:51:23 +00:00 · 2006-06-01 20:51:23 +00:00 · caeb40004f
commit caeb40004f
parent b5a5531207
12 changed files with 78 additions and 37 deletions
--- a/collects/framework/gui-utils.ss
+++ b/collects/framework/gui-utils.ss
@ -176,13 +176,18 @@
     (string?
      any/c
      (or/c false/c (is-a?/c frame%) (is-a?/c dialog%))
-      (symbols 'app 'caution 'stop))
+      (symbols 'app 'caution 'stop)
+      (or/c false/c (case-> (boolean? . -> . void?)
+                            (-> boolean?)))
+      string?)
     any/c)
    ((message true-choice false-choice)
     ((title (string-constant warning))
      (default-result 'disallow-close)
-      (paren #f)
-      (style 'app)))
+      (parent #f)
+      (style 'app)
+      (checkbox-proc #f)
+      (checkbox-label (string-constant dont-ask-again))))

    "Opens a dialog that presents a binary choice to the user. The user is forced"
    "to choose between these two options, ie cancelling or closing the dialog"
@ -205,7 +210,16 @@
    ""
    "The \\var{style} parameter is (eventually) passed to"
    "@link message"
-    "as an icon in the dialog.")
+    "as an icon in the dialog."
+    ""
+    "If \\var{checkbox-proc} is given, it should be a procedure that behaves"
+    "like a parameter for getting/setting a boolean value.  The intention for"
+    "this value is that it can be used to disable the dialog.  When it is"
+    "given, a checkbox will appear with a \\var{checkbox-label} label"
+    "(defaults to the \\rawscm{dont-ask-again} string constant), and that"
+    "checkbox value will be sent to the \\var{checkbox-proc} when the dialog"
+    "is closed.  Note that the dialog will always pop-up --- it is the"
+    "caller's responsibility to avoid the dialog if not needed.")

   (gui-utils:get-clicked-clickback-delta
    (-> (is-a?/c style-delta%))
@ -452,27 +466,24 @@
                 (title (string-constant warning))
                 (default-result 'disallow-close)
                 (parent #f)
-                 (style 'app))
-      (let ([mb-res (message-box/custom
-                     title
-                     message
-                     true-choice
-                     false-choice
-                     #f
-                     parent
-                     (case default-result
-                       [(disallow-close) 
-                        (if (eq? style 'app)
-                            `(default=1 disallow-close)
-                            `(default=1 disallow-close ,style))]
-                       [else (if (eq? style 'app)
-                                 `(default=1)
-                                 `(default=1 ,style))])
-                     default-result)])
-        (case mb-res
-          [(1) #t]
-          [(2) #f]
-          [else mb-res]))))
+                 (style 'app)
+                 (checkbox-proc #f)
+                 (checkbox-label (string-constant dont-ask-again)))
+      (let* ([check? (and checkbox-proc (checkbox-proc))]
+             [style  (if (eq? style 'app) `(default=1) `(default=1 ,style))]
+             [style  (if (eq? 'disallow-close default-result)
+                       (cons 'disallow-close style) style)]
+             [style  (if check? (cons 'checked style) style)]
+             [return (λ (mb-res) (case mb-res [(1) #t] [(2) #f] [else mb-res]))])
+        (if checkbox-proc
+          (let-values ([(mb-res checked)
+                        (message+check-box/custom title message checkbox-label
+                                                  true-choice false-choice #f
+                                                  parent style default-result)])
+            (checkbox-proc checked)
+            (return mb-res))
+          (return (message-box/custom title message true-choice false-choice #f
+                                      parent style default-result))))))
  
  ;; manual renaming
  (define gui-utils:trim-string trim-string)
--- a/collects/framework/private/exit.ss
+++ b/collects/framework/private/exit.ss
@ -61,7 +61,12 @@
 		 (string-constant dont-exit)
 		 (string-constant dont-quit))
 	     (string-constant warning)
-	     #f)
+	     #f
+             #f
+             'app
+             (case-lambda
+              [() (not (preferences:get 'framework:verify-exit))]
+              [(new) (preferences:set 'framework:verify-exit (not new))]))
 	    #t))

      (define (-exit)
--- a/collects/help/private/gui.ss
+++ b/collects/help/private/gui.ss
@ -277,7 +277,7 @@
 		      (message+check-box/custom
 		       (string-constant help-desk)
 		       (string-constant plt:hd:ask-about-separate-browser)
-		       (string-constant dont-ask-again)
+		       (string-constant dont-ask-again-always-current)
 		       (string-constant plt:hd:homebrew-browser)
 		       (string-constant plt:hd:separate-browser)
 		       #f
@ -639,4 +639,4 @@
        (send d center)
        (send t focus)
        (send d show #t)
-        result))))
+        result))))
--- a/collects/string-constants/danish-string-constants.ss
+++ b/collects/string-constants/danish-string-constants.ss
@ -123,7 +123,10 @@ please adhere to these guidelines:
 ;; label for a generic check box, often supported on dialogs
 ;; that ask a binary choice of the user. If checked, the
 ;; dialog isn't going to be shown again.
- (dont-ask-again "Spørg ikke igen (brugt altid nuværende valg)")
+ ;; One version for always using the current choice:
+ (dont-ask-again-always-current "Spørg ikke igen (brugt altid nuværende valg)")
+ ;; One generic version (ie, on the Quit DrScheme dialog)
+ (dont-ask-again                "Spørg ikke igen")

 ;;; important urls
 (web-materials "Relaterede websites") ;; menu item title
--- a/collects/string-constants/english-string-constants.ss
+++ b/collects/string-constants/english-string-constants.ss
@ -125,7 +125,10 @@ please adhere to these guidelines:
 ;; label for a generic check box, often supported on dialogs
 ;; that ask a binary choice of the user. If checked, the
 ;; dialog isn't going to be shown again.
- (dont-ask-again "Do not ask again (always use current choice)")
+ ;; One version for always using the current choice:
+ (dont-ask-again-always-current "Do not ask again (always use current choice)")
+ ;; One generic version (ie, on the Quit DrScheme dialog)
+ (dont-ask-again                "Do not ask again")

 ;;; important urls
 (web-materials "Related Web Sites") ;; menu item title
--- a/collects/string-constants/french-string-constants.ss
+++ b/collects/string-constants/french-string-constants.ss
@ -125,7 +125,10 @@
  ;; label for a generic check box, often supported on dialogs
  ;; that ask a binary choice of the user. If checked, the
  ;; dialog isn't going to be shown again.
-  (dont-ask-again "Ne jamais redemander (utilisera toujours votre présent choix)")
+  ;; One version for always using the current choice:
+  (dont-ask-again-always-current "Ne jamais redemander (utilisera toujours votre présent choix)")
+  ;; One generic version (ie, on the Quit DrScheme dialog)
+  (dont-ask-again                "Ne jamais redemander")
  
  ;;; important urls
  (web-materials "Sites web apparentés") ;; menu item title
--- a/collects/string-constants/german-string-constants.ss
+++ b/collects/string-constants/german-string-constants.ss
@ -30,7 +30,8 @@
 (ignore "Ignorieren")
 (revert "Änderungen rückgängig machen")

- (dont-ask-again "Nicht wieder nachfragen (immer so wie jetzt)")
+ (dont-ask-again-always-current "Nicht wieder nachfragen (immer so wie jetzt)")
+ (dont-ask-again                "Nicht wieder nachfragen")

 (web-materials "Verwandte Web-Seiten")
 (tool-web-sites "Web-Seiten mit Tools")
--- a/collects/string-constants/japanese-string-constants.ss
+++ b/collects/string-constants/japanese-string-constants.ss
@ -125,7 +125,10 @@ please adhere to these guidelines:
 ;; label for a generic check box, often supported on dialogs
 ;; that ask a binary choice of the user. If checked, the
 ;; dialog isn't going to be shown again.
- (dont-ask-again "今後このメッセージを表示しない (現在の選択が使われます)")
+  ;; One version for always using the current choice:
+ (dont-ask-again-always-current "今後このメッセージを表示しない (現在の選択が使われます)")
+  ;; One generic version (ie, on the Quit DrScheme dialog)
+ (dont-ask-again                "今後このメッセージを表示しない")

 ;;; important urls
 (web-materials "関連するウェブサイト") ;; menu item title
--- a/collects/string-constants/portuguese-string-constants.ss
+++ b/collects/string-constants/portuguese-string-constants.ss
@ -125,7 +125,10 @@ please adhere to these guidelines:
 ;; label for a generic check box, often supported on dialogs
 ;; that ask a binary choice of the user. If checked, the
 ;; dialog isn't going to be shown again.
- (dont-ask-again "Não voltar a perguntar (utilizar sempre a escolha actual)")
+ ;; One version for always using the current choice:
+ (dont-ask-again-always-current "Não voltar a perguntar (utilizar sempre a escolha actual)")
+ ;; One generic version (ie, on the Quit DrScheme dialog)
+ (dont-ask-again                "Não voltar a perguntar")

 ;;; important urls
 (web-materials "Sitios na Web Relacionados") ;; menu item title
--- a/collects/string-constants/simplified-chinese-string-constants.ss
+++ b/collects/string-constants/simplified-chinese-string-constants.ss
@ -52,7 +52,10 @@
  ;; label for a generic check box, often supported on dialogs
  ;; that ask a binary choice of the user. If checked, the
  ;; dialog isn't going to be shown again.
-  (dont-ask-again "不再询问(总是使用当前设置)")
+  ;; One version for always using the current choice:
+  (dont-ask-again-always-current "不再询问(总是使用当前设置)")
+  ;; One generic version (ie, on the Quit DrScheme dialog)
+  (dont-ask-again                "不再询问")
  
  ;;; important urls
  (web-materials "相关网站") ;; menu item title
--- a/collects/string-constants/spanish-string-constants.ss
+++ b/collects/string-constants/spanish-string-constants.ss
@ -33,7 +33,10 @@
 ;; label for a generic check box, often supported on dialogs
 ;; that ask a binary choice of the user. If checked, the
 ;; dialog isn't going to be shown again.
- (dont-ask-again "No volver a preguntar (usar la selección actual siempre)")
+ ;; One version for always using the current choice:
+ (dont-ask-again-always-current "No volver a preguntar (usar la selección actual siempre)")
+ ;; One generic version (ie, on the Quit DrScheme dialog)
+ (dont-ask-again                "No volver a preguntar")
 
 ;; important urls
 (web-materials "Sitios de Web Relacionados")
--- a/collects/string-constants/traditional-chinese-string-constants.ss
+++ b/collects/string-constants/traditional-chinese-string-constants.ss
@ -52,7 +52,10 @@
  ;; label for a generic check box, often supported on dialogs
  ;; that ask a binary choice of the user. If checked, the
  ;; dialog isn't going to be shown again.
-  (dont-ask-again "不再詢問(總是使用當前設置)")
+  ;; One version for always using the current choice:
+  (dont-ask-again-always-current "不再詢問(總是使用當前設置)")
+  ;; One generic version (ie, on the Quit DrScheme dialog)
+  (dont-ask-again                "不再詢問")
  
  ;;; important urls
  (web-materials "相關網站") ;; menu item title