From ec82209950585fbbcb34f949ff7d241d8529b659 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 2 Oct 2014 16:38:26 -0500 Subject: [PATCH] remove 'print' mode from the Pretty Big language it was buggy and fixing the bug makes it identical to write mode, so instead of that, lets just make there not be a print mode also, minor edits and Rackety --- .../tests/drracket/language-test.rkt | 12 +++-- .../private/language-configuration.rkt | 52 +++++++++++-------- .../drracket/drracket/private/language.rkt | 21 +++++--- .../drracket/drracket/tool-lib.rkt | 2 +- 4 files changed, 52 insertions(+), 35 deletions(-) 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],