diff --git a/collects/framework/gui-utils.ss b/collects/framework/gui-utils.ss index 5b3af90ef1..9ec1820917 100644 --- 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) diff --git a/collects/framework/private/exit.ss b/collects/framework/private/exit.ss index 35617cf38e..cc74447122 100644 --- 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) diff --git a/collects/help/private/gui.ss b/collects/help/private/gui.ss index 785225396b..05a614fa62 100644 --- 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)))) \ No newline at end of file + result)))) diff --git a/collects/string-constants/danish-string-constants.ss b/collects/string-constants/danish-string-constants.ss index d555259670..75c8c40c79 100644 --- 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 diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss index 72357ecc97..91a8ff6a8d 100644 --- 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 diff --git a/collects/string-constants/french-string-constants.ss b/collects/string-constants/french-string-constants.ss index fc34352fe3..794e0688ef 100644 --- 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 diff --git a/collects/string-constants/german-string-constants.ss b/collects/string-constants/german-string-constants.ss index d444ee34ba..18cab02e2c 100644 --- 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") diff --git a/collects/string-constants/japanese-string-constants.ss b/collects/string-constants/japanese-string-constants.ss index f763def3bb..703ed71be6 100644 --- 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 diff --git a/collects/string-constants/portuguese-string-constants.ss b/collects/string-constants/portuguese-string-constants.ss index 4918339702..cbd14fd491 100644 --- 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 diff --git a/collects/string-constants/simplified-chinese-string-constants.ss b/collects/string-constants/simplified-chinese-string-constants.ss index 501b105411..4f7439d660 100644 --- 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 diff --git a/collects/string-constants/spanish-string-constants.ss b/collects/string-constants/spanish-string-constants.ss index 9570be9dd6..aa184f66b4 100644 --- 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") diff --git a/collects/string-constants/traditional-chinese-string-constants.ss b/collects/string-constants/traditional-chinese-string-constants.ss index 3d9d67331f..732be08cc1 100644 --- 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