diff --git a/pkgs/drracket-pkgs/drracket-test/tests/drracket/language-test.rkt b/pkgs/drracket-pkgs/drracket-test/tests/drracket/language-test.rkt index a3a67c442c..d1ec47ceaf 100644 --- a/pkgs/drracket-pkgs/drracket-test/tests/drracket/language-test.rkt +++ b/pkgs/drracket-pkgs/drracket-test/tests/drracket/language-test.rkt @@ -187,13 +187,15 @@ the settings above should match r5rs (check-top-of-repl) (generic-settings #f) - (generic-output #t #t #t #t) + (generic-output #t #t #t #f) (test-hash-bang) (test-error-after-definition) (prepare-for-test-expression) + (test-expression "(print '((x)))" "((x))") + (test-expression "'|.|" "|.|") (test-expression '("(equal? (list " image ") (list " image "))") "#t") @@ -1371,10 +1373,10 @@ the settings above should match r5rs (unless (if (procedure? answer) (answer got) (whitespace-string=? answer got)) - (eprintf "FAILED ~s ~a, sharing ~a pretty? ~a\n got ~s\n expected ~s\n" - (language) option show-sharing pretty? - (shorten got) - (if (procedure? answer) (answer) answer)))) + (eprintf "FAILED ~s ~a, sharing ~a \"Insert newlines in printed values\" ~a\n" + (language) option show-sharing pretty?) + (eprintf " got ~s\n" (shorten got)) + (eprintf "expected ~s\n" (if (procedure? answer) (answer) answer)))) (clear-definitions drs) (type-in-definitions drs expression) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt index 6fc63c6506..bc4f23a6f5 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt @@ -64,7 +64,7 @@ (import [prefix drracket:unit: drracket:unit^] [prefix drracket:rep: drracket:rep^] [prefix drracket:init: drracket:init^] - [prefix drracket:language: drracket:language^] + [prefix drracket:language: drracket:language/int^] [prefix drracket:app: drracket:app^] [prefix drracket:tools: drracket:tools^] [prefix drracket:help-desk: drracket:help-desk^] @@ -1968,22 +1968,22 @@ (and (vector-ref printable 6) #t)))))) (define/override (config-panel parent) - (let ([p (new vertical-panel% [parent parent])]) - (let ([base-config (super config-panel p)] - [assume-cb (new check-box% - [parent - (new group-box-panel% - [parent p] - [label (string-constant enforce-primitives-group-box-label)] - [stretchable-height #f] - [stretchable-width #f])] - [label (string-constant enforce-primitives-check-box-label)])]) - (case-lambda - [() (extend-simple-settings (base-config) - (send assume-cb get-value))] - [(c) - (base-config c) - (send assume-cb set-value (simple-settings+assume-no-redef? c))])))) + (define p (new vertical-panel% [parent parent])) + (define base-config (super config-panel p)) + (define assume-cb (new check-box% + [parent + (new group-box-panel% + [parent p] + [label (string-constant enforce-primitives-group-box-label)] + [stretchable-height #f] + [stretchable-width #f])] + [label (string-constant enforce-primitives-check-box-label)])) + (case-lambda + [() (extend-simple-settings (base-config) + (send assume-cb get-value))] + [(c) + (base-config c) + (send assume-cb set-value (simple-settings+assume-no-redef? c))])) (define/override (default-settings? x) (equal? (simple-settings+assume->vector x) @@ -2035,13 +2035,13 @@ (class % ;; since check syntax no longer shares the gui libraries, ;; we always share it explicitly here - (define/override (on-execute setting run-in-user-thread) + (define/override (on-execute settings run-in-user-thread) (let ([mred-name ((current-module-name-resolver) 'mred/mred #f #f #t)]) (run-in-user-thread (λ () (namespace-attach-module drracket:init:system-namespace mred-name)))) - (super on-execute setting run-in-user-thread)) - (define/override (default-settings) + (super on-execute settings run-in-user-thread)) + (define/override (default-settings) (let ([s (super default-settings)]) (make-simple-settings+assume (drracket:language:simple-settings-case-sensitive s) 'trad-write @@ -2052,6 +2052,14 @@ (simple-settings+assume-no-redef? s)))) (super-new))) + (define (pretty-big-config-panel-mixin %) + (class % + (define/override (config-panel parent) + (drracket:language:simple-module-based-language-config-panel + parent + #:include-print-mode? #f)) + (super-new))) + (define get-all-scheme-manual-keywords (let ([words #f]) (λ () @@ -2113,7 +2121,9 @@ (string-constant pretty-big-scheme-one-line-summary) (λ (%) (pretty-big-mixin (macro-stepper-mixin - (assume-mixin (add-errortrace-key-mixin %))))))) + (assume-mixin + (pretty-big-config-panel-mixin + (add-errortrace-key-mixin %)))))))) (add-language (make-simple '(lib "r5rs/lang.rkt") "plt:r5rs" diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt index 604f64d446..9aa117d8b2 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt @@ -217,7 +217,8 @@ #:case-sensitive [*case-sensitive '?] #:dynamic-panel-extras [dynamic-panel-extras void] #:get-debugging-radio-box [get-debugging-radio-box void] - #:debugging-radio-box-callback [debugging-radio-box-callback void]) + #:debugging-radio-box-callback [debugging-radio-box-callback void] + #:include-print-mode? [include-print-mode? #t]) (letrec ([parent (instantiate vertical-panel% () (parent _parent) (alignment '(center center)))] @@ -269,10 +270,13 @@ (debugging-radio-box-callback a b))))] [output-style (make-object radio-box% (string-constant output-style-label) - (list (string-constant constructor-printing-style) - (string-constant quasiquote-printing-style) - (string-constant write-printing-style) - (string-constant print-printing-style)) + (flatten + (list (string-constant constructor-printing-style) + (string-constant quasiquote-printing-style) + (string-constant write-printing-style) + (if include-print-mode? + (string-constant print-printing-style) + '()))) output-panel (λ (rb evt) (enable-fraction-style)) '(horizontal vertical-label))] @@ -305,7 +309,7 @@ [(0) 'constructor] [(1) 'quasiquote] [(2) 'trad-write] - [(3) 'print]) + [(3) (if include-print-mode? 'print 'trad-write)]) (if (send fraction-style get-value) 'repeating-decimal-e 'mixed-fraction-e) @@ -327,7 +331,7 @@ [(constructor) 0] [(quasiquote) 1] [(write trad-write) 2] - [(print) 3])) + [(print) (if include-print-mode? 3 2)])) (enable-fraction-style) (send fraction-style set-value (eq? (simple-settings-fraction-style settings) 'repeating-decimal-e)) @@ -507,7 +511,8 @@ ;; style, because the sharing is being taken care of ;; by the print-convert sexp construction when using ;; other printing styles. - (and (memq (simple-settings-printing-style settings) '(write print)) + (and (memq (simple-settings-printing-style settings) + '(trad-write write print)) (simple-settings-show-sharing settings))]) (thunk))))) diff --git a/pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt b/pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt index 74f5f39988..92f747727d 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt @@ -1955,7 +1955,7 @@ all of the names in the tools library, for use defining keybindings @racket[print] (or @racket[pretty-print]); the default second result is @racket[#t]. - The default implementation of this method depends on the + The result of this function depends on the @racket[simple-settings-printing-style] field of @racket[settings]. If it is @racket['print], the result is @racket[(values value #f)]. If it is @racket['write] or @racket['trad-write],