suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remove 'print' mode from the Pretty Big language

Browse Source 
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
This commit is contained in:
Robby Findler 2014-10-02 16:38:26 -05:00
parent 33e49d0aa2
commit ec82209950
4 changed files with 52 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/drracket-pkgs/drracket-test/tests/drracket/language-test.rkt
View File

@ -187,13 +187,15 @@ the settings above should match r5rs
(check-top-of-repl) (check-top-of-repl)
(generic-settings #f) (generic-settings #f)
(generic-output #t #t #t #t) (generic-output #t #t #t #f)
(test-hash-bang) (test-hash-bang)
(test-error-after-definition) (test-error-after-definition)
(prepare-for-test-expression) (prepare-for-test-expression)
(test-expression "(print '((x)))" "((x))")
(test-expression "'|.|" "|.|") (test-expression "'|.|" "|.|")
(test-expression '("(equal? (list " image ") (list " image "))") (test-expression '("(equal? (list " image ") (list " image "))")
"#t") "#t")
@ -1371,10 +1373,10 @@ the settings above should match r5rs
(unless (if (procedure? answer) (unless (if (procedure? answer)
(answer got) (answer got)
(whitespace-string=? answer got)) (whitespace-string=? answer got))
(eprintf "FAILED ~s ~a, sharing ~a pretty? ~a\n got ~s\n expected ~s\n" (eprintf "FAILED ~s ~a, sharing ~a \"Insert newlines in printed values\" ~a\n"
(language) option show-sharing pretty? (language) option show-sharing pretty?)
(shorten got) (eprintf " got ~s\n" (shorten got))
(if (procedure? answer) (answer) answer)))) (eprintf "expected ~s\n" (if (procedure? answer) (answer) answer))))
(clear-definitions drs) (clear-definitions drs)
(type-in-definitions drs expression) (type-in-definitions drs expression)

52
pkgs/drracket-pkgs/drracket/drracket/private/language-configuration.rkt
View File

@ -64,7 +64,7 @@
(import [prefix drracket:unit: drracket:unit^] (import [prefix drracket:unit: drracket:unit^]
[prefix drracket:rep: drracket:rep^] [prefix drracket:rep: drracket:rep^]
[prefix drracket:init: drracket:init^] [prefix drracket:init: drracket:init^]
[prefix drracket:language: drracket:language^] [prefix drracket:language: drracket:language/int^]
[prefix drracket:app: drracket:app^] [prefix drracket:app: drracket:app^]
[prefix drracket:tools: drracket:tools^] [prefix drracket:tools: drracket:tools^]
[prefix drracket:help-desk: drracket:help-desk^] [prefix drracket:help-desk: drracket:help-desk^]
@ -1968,22 +1968,22 @@
(and (vector-ref printable 6) #t)))))) (and (vector-ref printable 6) #t))))))
(define/override (config-panel parent) (define/override (config-panel parent)
(let ([p (new vertical-panel% [parent parent])]) (define p (new vertical-panel% [parent parent]))
(let ([base-config (super config-panel p)] (define base-config (super config-panel p))
[assume-cb (new check-box% (define assume-cb (new check-box%
[parent [parent
(new group-box-panel% (new group-box-panel%
[parent p] [parent p]
[label (string-constant enforce-primitives-group-box-label)] [label (string-constant enforce-primitives-group-box-label)]
[stretchable-height #f] [stretchable-height #f]
[stretchable-width #f])] [stretchable-width #f])]
[label (string-constant enforce-primitives-check-box-label)])]) [label (string-constant enforce-primitives-check-box-label)]))
(case-lambda (case-lambda
[() (extend-simple-settings (base-config) [() (extend-simple-settings (base-config)
(send assume-cb get-value))] (send assume-cb get-value))]
[(c) [(c)
(base-config c) (base-config c)
(send assume-cb set-value (simple-settings+assume-no-redef? c))])))) (send assume-cb set-value (simple-settings+assume-no-redef? c))]))
(define/override (default-settings? x) (define/override (default-settings? x)
(equal? (simple-settings+assume->vector x) (equal? (simple-settings+assume->vector x)
@ -2035,13 +2035,13 @@
(class % (class %
;; since check syntax no longer shares the gui libraries, ;; since check syntax no longer shares the gui libraries,
;; we always share it explicitly here ;; 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)]) (let ([mred-name ((current-module-name-resolver) 'mred/mred #f #f #t)])
(run-in-user-thread (run-in-user-thread
(λ () (λ ()
(namespace-attach-module drracket:init:system-namespace mred-name)))) (namespace-attach-module drracket:init:system-namespace mred-name))))
(super on-execute setting run-in-user-thread)) (super on-execute settings run-in-user-thread))
(define/override (default-settings) (define/override (default-settings)
(let ([s (super default-settings)]) (let ([s (super default-settings)])
(make-simple-settings+assume (drracket:language:simple-settings-case-sensitive s) (make-simple-settings+assume (drracket:language:simple-settings-case-sensitive s)
'trad-write 'trad-write
@ -2052,6 +2052,14 @@
(simple-settings+assume-no-redef? s)))) (simple-settings+assume-no-redef? s))))
(super-new))) (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 (define get-all-scheme-manual-keywords
(let ([words #f]) (let ([words #f])
(λ () (λ ()
@ -2113,7 +2121,9 @@
(string-constant pretty-big-scheme-one-line-summary) (string-constant pretty-big-scheme-one-line-summary)
(λ (%) (pretty-big-mixin (λ (%) (pretty-big-mixin
(macro-stepper-mixin (macro-stepper-mixin
(assume-mixin (add-errortrace-key-mixin %))))))) (assume-mixin
(pretty-big-config-panel-mixin
(add-errortrace-key-mixin %))))))))
(add-language (add-language
(make-simple '(lib "r5rs/lang.rkt") (make-simple '(lib "r5rs/lang.rkt")
"plt:r5rs" "plt:r5rs"

21
pkgs/drracket-pkgs/drracket/drracket/private/language.rkt
View File

@ -217,7 +217,8 @@
#:case-sensitive [*case-sensitive '?] #:case-sensitive [*case-sensitive '?]
#:dynamic-panel-extras [dynamic-panel-extras void] #:dynamic-panel-extras [dynamic-panel-extras void]
#:get-debugging-radio-box [get-debugging-radio-box 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% () (letrec ([parent (instantiate vertical-panel% ()
(parent _parent) (parent _parent)
(alignment '(center center)))] (alignment '(center center)))]
@ -269,10 +270,13 @@
(debugging-radio-box-callback a b))))] (debugging-radio-box-callback a b))))]
[output-style (make-object radio-box% [output-style (make-object radio-box%
(string-constant output-style-label) (string-constant output-style-label)
(list (string-constant constructor-printing-style) (flatten
(string-constant quasiquote-printing-style) (list (string-constant constructor-printing-style)
(string-constant write-printing-style) (string-constant quasiquote-printing-style)
(string-constant print-printing-style)) (string-constant write-printing-style)
(if include-print-mode?
(string-constant print-printing-style)
'())))
output-panel output-panel
(λ (rb evt) (enable-fraction-style)) (λ (rb evt) (enable-fraction-style))
'(horizontal vertical-label))] '(horizontal vertical-label))]
@ -305,7 +309,7 @@
[(0) 'constructor] [(0) 'constructor]
[(1) 'quasiquote] [(1) 'quasiquote]
[(2) 'trad-write] [(2) 'trad-write]
[(3) 'print]) [(3) (if include-print-mode? 'print 'trad-write)])
(if (send fraction-style get-value) (if (send fraction-style get-value)
'repeating-decimal-e 'repeating-decimal-e
'mixed-fraction-e) 'mixed-fraction-e)
@ -327,7 +331,7 @@
[(constructor) 0] [(constructor) 0]
[(quasiquote) 1] [(quasiquote) 1]
[(write trad-write) 2] [(write trad-write) 2]
[(print) 3])) [(print) (if include-print-mode? 3 2)]))
(enable-fraction-style) (enable-fraction-style)
(send fraction-style set-value (eq? (simple-settings-fraction-style settings) (send fraction-style set-value (eq? (simple-settings-fraction-style settings)
'repeating-decimal-e)) 'repeating-decimal-e))
@ -507,7 +511,8 @@
;; style, because the sharing is being taken care of ;; style, because the sharing is being taken care of
;; by the print-convert sexp construction when using ;; by the print-convert sexp construction when using
;; other printing styles. ;; 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))]) (simple-settings-show-sharing settings))])
(thunk))))) (thunk)))))

2
pkgs/drracket-pkgs/drracket/drracket/tool-lib.rkt
View File

@ -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 @racket[print] (or @racket[pretty-print]); the default second
result is @racket[#t]. 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]. @racket[simple-settings-printing-style] field of @racket[settings].
If it is @racket['print], the If it is @racket['print], the
result is @racket[(values value #f)]. If it is @racket['write] or @racket['trad-write], result is @racket[(values value #f)]. If it is @racket['write] or @racket['trad-write],