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
This commit is contained in:
Robby Findler
parent
33e49d0aa2
commit
ec82209950
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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],
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user