diff --git a/collects/mred/mred-sig.ss b/collects/mred/mred-sig.ss index 3ddd2598e6..23d0fef9ff 100644 --- a/collects/mred/mred-sig.ss +++ b/collects/mred/mred-sig.ss @@ -178,6 +178,7 @@ style-list% style<%> subarea<%> subwindow<%> +system-position-ok-before-cancel? tab-snip% text% text-editor-load-handler diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss index 1adbd086b5..d4397a5498 100644 --- a/collects/mred/mred.ss +++ b/collects/mred/mred.ss @@ -28,6 +28,7 @@ "private/snipfile.ss" "private/repl.ss" "private/afm.ss" + "private/helper.ss" "private/dynamic.ss") ;; Initialize AFM/PS: @@ -300,4 +301,5 @@ file-creator-and-type current-ps-afm-file-paths current-ps-cmap-file-paths - hide-cursor-until-moved)) + hide-cursor-until-moved + system-position-ok-before-cancel?)) diff --git a/collects/mred/private/fontdialog.ss b/collects/mred/private/fontdialog.ss index 2b600d87aa..9e58232e0a 100644 --- a/collects/mred/private/fontdialog.ss +++ b/collects/mred/private/fontdialog.ss @@ -84,8 +84,14 @@ ;; Spacer: (make-object pane% bp)) (void))] - [cancel-button (make-object button% "Cancel" bp (done #f))] - [ok-button (make-object button% "OK" bp (done #t) '(border))] + [ok+cancel (call-with-values + (lambda () + (ok-cancel + (lambda () (make-object button% "OK" bp (done #t) '(border))) + (lambda () (make-object button% "Cancel" bp (done #f))))) + cons)] + [ok-button (car ok+cancel)] + [cancel-button (cdr ok+cancel)] [reset-font (lambda (font) (let* ([facen (if font diff --git a/collects/mred/private/helper.ss b/collects/mred/private/helper.ss index 8f7ad66548..2be01a71f1 100644 --- a/collects/mred/private/helper.ss +++ b/collects/mred/private/helper.ss @@ -20,7 +20,9 @@ traverse object->position container->children - filter-overlapping)) + filter-overlapping + system-position-ok-before-cancel? + ok-cancel)) ;; this structure holds the information that a child will need to send ;; to its parent when the parent must resize itself. @@ -318,4 +320,14 @@ (<= py y py2) (<= py y2 py2))))) rest) rest - (cons first rest)))))) + (cons first rest))))) + + (define (system-position-ok-before-cancel?) + (eq? (system-type) 'windows)) + + (define (ok-cancel mk-ok mk-cancel) + (if (system-position-ok-before-cancel?) + (values (mk-ok) (mk-cancel)) + (let ([c (mk-cancel)] + [o (mk-ok)]) + (values o c))))) diff --git a/collects/mred/private/messagebox.ss b/collects/mred/private/messagebox.ss index 21c871440a..b598fbccd2 100644 --- a/collects/mred/private/messagebox.ss +++ b/collects/mred/private/messagebox.ss @@ -183,7 +183,7 @@ (mk-button button3 3 (memq 'default=3 style))))]) (cond [(or (memq 'number-order style) - (not (memq (system-type) '(macos macosx)))) + (memq (system-type) '(windows))) (mk-1) (mk-2) (mk-3)] diff --git a/collects/mred/private/moredialogs.ss b/collects/mred/private/moredialogs.ss index 1dc8b881e5..6dbc0e9ca8 100644 --- a/collects/mred/private/moredialogs.ss +++ b/collects/mred/private/moredialogs.ss @@ -70,8 +70,10 @@ (define p (make-object horizontal-pane% f)) (define paper (make-object choice% #f papers p void)) (define _0 (make-object vertical-pane% p)) - (define cancel (make-object button% "Cancel" p (lambda (b e) (done #f)))) - (define ok (make-object button% "OK" p (lambda (b e) (done #t)) '(border))) + (define-values (ok cancel) + (ok-cancel + (lambda () (make-object button% "OK" p (lambda (b e) (done #t)) '(border))) + (lambda () (make-object button% "Cancel" p (lambda (b e) (done #f)))))) (define unix? (eq? (system-type) 'unix)) (define dp (make-object horizontal-pane% f)) (define orientation (make-object radio-box% "Orientation:" '("Portrait" "Landscape") dp void)) @@ -207,8 +209,9 @@ [p (make-object horizontal-pane% f)]) (send p set-alignment 'right 'center) (send f stretchable-height #f) - (make-object button% "Cancel" p (done #f)) - (make-object button% "OK" p (done #t) '(border)) + (ok-cancel + (lambda () (make-object button% "OK" p (done #t) '(border))) + (lambda () (make-object button% "Cancel" p (done #f)))) (send (send t get-editor) select-all) (send t focus) (send f center) @@ -255,8 +258,10 @@ (send l select i #t)) init-vals) (send p set-alignment 'right 'center) (send p stretchable-height #f) - (make-object button% "Cancel" p (done #f)) - (set! ok-button (make-object button% "OK" p (done #t) '(border))) + (ok-cancel (lambda () + (set! ok-button (make-object button% "OK" p (done #t) '(border)))) + (lambda () + (make-object button% "Cancel" p (done #f)))) (update-ok l) (send f center) (when (and (pair? init-vals) @@ -303,8 +308,11 @@ (send red set-value (send color red)) (send green set-value (send color green)) (send blue set-value (send color blue))) - (make-object button% "Cancel" bp (done #f)) - (send (make-object button% "OK" bp (done #t) '(border)) focus) + (ok-cancel + (lambda () + (make-object button% "Cancel" bp (done #f))) + (lambda () + (send (make-object button% "OK" bp (done #t) '(border)) focus))) (send bp set-alignment 'right 'center) (send p set-alignment 'right 'center) (send p stretchable-height #f) diff --git a/collects/scribblings/gui/dialog-funcs.scrbl b/collects/scribblings/gui/dialog-funcs.scrbl index 906a0cb73c..1c534b7322 100644 --- a/collects/scribblings/gui/dialog-funcs.scrbl +++ b/collects/scribblings/gui/dialog-funcs.scrbl @@ -184,18 +184,19 @@ Displays a message to the user in a (modal) dialog, using The style must include exactly one of the following: @itemize{ - @item{@scheme['ok] --- the dialog only has an ``OK'' button and always - returns @scheme['ok].} + @item{@scheme['ok] --- the dialog only has an @onscreen{OK} button + and always returns @scheme['ok].} - @item{@scheme['ok-cancel] --- the message dialog has ``Cancel'' and - ``OK'' buttons. If the user clicks ``Cancel'', the result is - @scheme['cancel], otherwise the result is @scheme['ok].} + @item{@scheme['ok-cancel] --- the message dialog has + @onscreen{Cancel} and @onscreen{OK} buttons. If the user clicks + @onscreen{Cancel}, the result is @scheme['cancel], otherwise the + result is @scheme['ok].} - @item{@scheme['yes-no] --- the message dialog has ``Yes'' and ``No'' - buttons. If the user clicks ``Yes'', the result is @scheme['yes], - otherwise the result is @scheme['no]. Note: instead of a - ``Yes''/``No'' dialog, best-practice GUI design is to use - @scheme[message-box/custom] and give the buttons meaningful + @item{@scheme['yes-no] --- the message dialog has @onscreen{Yes} and + @onscreen{No} buttons. If the user clicks @onscreen{Yes}, the result + is @scheme['yes], otherwise the result is @scheme['no]. Note: instead + of a @onscreen{Yes}/@onscreen{No} dialog, best-practice GUI design is + to use @scheme[message-box/custom] and give the buttons meaningful labels, so that the user does not have to read the message text carefully to make a selection.} @@ -247,7 +248,7 @@ If the user clicks the button labelled @scheme[button1-label], a @scheme[1] does not contain @scheme['disallow-close]---then the result is the value of @scheme[close-result]. For example, the user can usually close a dialog by typing an Escape. Often, @scheme[2] is an appropriate value - for @scheme[close-result], especially when Button 2 is a ``Cancel'' + for @scheme[close-result], especially when Button 2 is a @onscreen{Cancel} button. If @scheme[style] does not include @scheme['number-order], the order of @@ -256,14 +257,15 @@ If @scheme[style] does not include @scheme['number-order], the order of @itemize{ @item{Button 1 is the normal action, and it is usually the default - button. For example, if the dialog has an ``OK'' button, it is this - one. Under Windows and X, this button is leftmost; under - Mac OS X, it is rightmost. Use this button for dialogs that - contain only one button.} + button. For example, if the dialog has an @onscreen{OK} button, it is + this one. Under Windows, this button is leftmost; under X and Mac OS + X, it is rightmost. (See also + @scheme[system-position-ok-before-cancel?].) Use this button for + dialogs that contain only one button.} @item{Button 2 is next to Button 1, and it often plays the role of - ``Cancel'' (even when the default action is to cancel, such as when - confirming a file replacement).} + @onscreen{Cancel} (even when the default action is to cancel, such as + when confirming a file replacement).} @item{Button 3 tends to be separated from the other two (under Mac OS X, it is left-aligned in the dialog). Use this button only diff --git a/collects/scribblings/gui/miscwin-funcs.scrbl b/collects/scribblings/gui/miscwin-funcs.scrbl index 1f5f871e4a..46bc41597c 100644 --- a/collects/scribblings/gui/miscwin-funcs.scrbl +++ b/collects/scribblings/gui/miscwin-funcs.scrbl @@ -420,11 +420,17 @@ If the AppleEvent reply contains a value that cannot be the method. If no Scheme window is at the given coordinates, or if it is covered by a non-Scheme window at (@scheme[x], @scheme[y]), @scheme[#f] is returned. - - - } + +@defproc[(system-position-ok-before-cancel?) boolean?]{ + +Returns @scheme[#t] under Windows---indicating that a dialog with +@onscreen{OK} and @onscreen{Cancel} buttons should place the +@onscreen{OK} button on to left of the @onscreen{Cancel} button---and +returns @scheme[#f] under Mac OS X and X.} + + @defthing[the-clipboard (is-a?/c clipboard<%>)]{ See @scheme[clipboard<%>]. diff --git a/collects/setup/setup-unit.ss b/collects/setup/setup-unit.ss index 9a4e4d3067..ab2dc1e792 100644 --- a/collects/setup/setup-unit.ss +++ b/collects/setup/setup-unit.ss @@ -188,7 +188,7 @@ "Internal error: cc had invalid info-path: ~e" path)))) (when (info 'compile-subcollections (lambda () #f)) (setup-printf "WARNING" - "ignoring `compile-subcollections' entry in info ~a\n" + "ignoring `compile-subcollections' entry in info ~a" path-name)) ;; this check is also done in compiler/compiler-unit, in compile-directory (and (not (or (regexp-match? #rx"^[.]" basename)