Skip to content

in the module language, drracket asks the #lang language what the default value of the annotations should be #805

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
rfindler merged 1 commit into from
Apr 8, 2026
Merged

in the module language, drracket asks the #lang language what the default value of the annotations should be #805

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions drracket-core-lib/drracket/private/in-irl-namespace.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -246,6 +246,7 @@
string?)
string?)))))]
[(documentation-language-family) (or/c #f string?)]
[(drracket:default-instrumentation) (or/c 'none 'debug 'debug/profile 'test-coverage)]
[else
(error 'key->contract "unknown key")]))

Expand Down
3 changes: 2 additions & 1 deletion drracket-core-lib/drracket/private/insulated-read-language.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,8 @@ Will not work with the definitions text surrogate interposition that
'drracket:quote-matches
'drracket:comment-delimiters
'drracket:define-popup
'documentation-language-family))
'documentation-language-family
'drracket:default-instrumentation))

(provide
(contract-out
Expand Down
125 changes: 83 additions & 42 deletions drracket-core-lib/drracket/private/language.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -203,10 +203,10 @@
repeating-decimal-e))
(boolean? (vector-ref printable 3))
(boolean? (vector-ref printable 4))
(memq (vector-ref printable 5) '(none debug debug/profile test-coverage))
(memq (vector-ref printable 5) '(none debug debug/profile test-coverage lang-default))
(apply make-simple-settings (vector->list printable))))
(define/public (default-settings)
(make-simple-settings #t 'print 'mixed-fraction-e #f #t 'debug))
(make-simple-settings #t 'print 'mixed-fraction-e #f #t 'lang-default))
(define/public (default-settings? x)
(equal? (simple-settings->vector x)
(simple-settings->vector (default-settings))))
Expand Down Expand Up @@ -254,6 +254,7 @@
#:debugging-radio-box-callback [debugging-radio-box-callback void]
#:include-print-mode? [include-print-mode? #t]
#:keyboard-shortcuts? [keyboard-shortcuts? #f]
#:lang-default-debugging? [lang-default-debugging? #f]

;; called whenever any of the settings changed; used when the settings
;; are put into the preferences dialog (which doesn't have an explicit
Expand All @@ -264,6 +265,7 @@
(define debugging-keystroke #\b)
(define debugging-and-profiling-keystroke #\p)
(define test-coverage-keystroke #\c)
(define default-debugging-keystroke #\i)

(letrec ([parent (new vertical-panel% (parent _parent) (alignment '(center center)))]

Expand Down Expand Up @@ -308,6 +310,7 @@
[debugging-left-callback
(λ ()
(send debugging-right set-selection #f)
(send debugging-bottom set-selection #f)
(debugging-radio-box-callback)
(something-changed))]
[debugging-right (new radio-box%
Expand All @@ -326,6 +329,24 @@
[debugging-right-callback
(λ ()
(send debugging-left set-selection #f)
(send debugging-bottom set-selection #f)
(debugging-radio-box-callback)
(something-changed))]
[debugging-bottom
(and lang-default-debugging?
(new radio-box%
[label #f]
[parent dynamic-panel]
[choices (list (add-menu-shortcut
(string-constant use-hash-langs-instrumentation)
(and keyboard-shortcuts? default-debugging-keystroke)))]
[callback
(λ (a b)
(debugging-bottom-callback))]))]
[debugging-bottom-callback
(λ ()
(send debugging-left set-selection #f)
(send debugging-right set-selection #f)
(debugging-radio-box-callback)
(something-changed))]
[output-style (make-object radio-box%
Expand Down Expand Up @@ -357,7 +378,11 @@
(make-object check-box% (string-constant decimal-notation-for-rationals)
output-panel
(λ (_1 _2) (something-changed)))])
(get-debugging-radio-box debugging-left debugging-right)
(cond
[(procedure-arity-includes? get-debugging-radio-box 3)
(get-debugging-radio-box debugging-left debugging-right debugging-bottom)]
[else
(get-debugging-radio-box debugging-left debugging-right)])
(dynamic-panel-extras dynamic-panel)

(define shortcuts
Expand All @@ -376,7 +401,11 @@
(list test-coverage-keystroke
(λ ()
(send debugging-right set-selection 1)
(debugging-right-callback)))))
(debugging-right-callback)))
(list default-debugging-keystroke
(λ ()
(send debugging-bottom set-selection 0)
(debugging-bottom-callback)))))


(drracket:language-configuration:config-panel-with-keystrokes
Expand All @@ -396,33 +425,40 @@
'mixed-fraction-e)
(send show-sharing get-value)
(send insert-newlines get-value)
(case (send debugging-left get-selection)
[(0) 'none]
[(1) 'debug]
[(#f)
(case (send debugging-right get-selection)
[(0) 'debug/profile]
[(1) 'test-coverage])]))]
(match (send debugging-left get-selection)
[0 'none]
[1 'debug]
[#f
(match (send debugging-right get-selection)
[0 'debug/profile]
[1 'test-coverage]
[#f (cond
[debugging-bottom
(match (send debugging-bottom get-selection)
[0 'lang-default])]
[else #f])])]))]
[(settings)
(when case-sensitive
(send case-sensitive set-value
(simple-settings-case-sensitive settings)))
(send output-style set-selection
(case (simple-settings-printing-style settings)
[(constructor) 0]
[(quasiquote) 1]
[(write trad-write) 2]
[(print) (if include-print-mode? 3 2)]))
(match (simple-settings-printing-style settings)
['constructor 0]
['quasiquote 1]
['write 2]
['trad-write 2]
['print (if include-print-mode? 3 2)]))
(enable-fraction-style)
(send fraction-style set-value (eq? (simple-settings-fraction-style settings)
'repeating-decimal-e))
(send show-sharing set-value (simple-settings-show-sharing settings))
(send insert-newlines set-value (simple-settings-insert-newlines settings))
(case (simple-settings-annotations settings)
[(none) (send debugging-right set-selection #f) (send debugging-left set-selection 0)]
[(debug) (send debugging-right set-selection #f) (send debugging-left set-selection 1)]
[(debug/profile) (send debugging-left set-selection #f) (send debugging-right set-selection 0)]
[(test-coverage) (send debugging-left set-selection #f) (send debugging-right set-selection 1)])])
(match (simple-settings-annotations settings)
['none (send debugging-right set-selection #f) (send debugging-left set-selection 0) (when debugging-bottom (send debugging-bottom set-selection #f))]
['debug (send debugging-right set-selection #f) (send debugging-left set-selection 1) (when debugging-bottom (send debugging-bottom set-selection #f))]
['debug/profile (send debugging-left set-selection #f) (send debugging-right set-selection 0) (when debugging-bottom (send debugging-bottom set-selection #f))]
['test-coverage (send debugging-left set-selection #f) (send debugging-right set-selection 1) (when debugging-bottom (send debugging-bottom set-selection #f))]
['lang-default (when debugging-bottom (send debugging-left set-selection #f) (send debugging-right set-selection #f) (send debugging-bottom set-selection 0))])])
(if keyboard-shortcuts? shortcuts '()))))

;; simple-module-based-language-render-value/format : TST settings port (union #f (snip% -> void)) (union 'infinity number) -> void
Expand Down Expand Up @@ -645,33 +681,38 @@
(to-snip-value? expr))
expr
(sh expr basic-convert sub-convert)))


(define lang-default-annotations (make-parameter 'debug))

;; initialize-simple-module-based-language : setting ((-> void) -> void)
(define (initialize-simple-module-based-language setting run-in-user-thread)
(define annotations
(cond
[(equal? (simple-settings-annotations setting) 'lang-default)
(lang-default-annotations)]
[else (simple-settings-annotations setting)]))
(run-in-user-thread
(λ ()

(let ([annotations (simple-settings-annotations setting)])
(case annotations
[(debug)
(current-compile (drracket:debug:make-debug-compile-handler (current-compile)))
(error-display-handler
(drracket:debug:make-debug-error-display-handler
(error-display-handler)))]
(case annotations
[(debug)
(current-compile (drracket:debug:make-debug-compile-handler (current-compile)))
(error-display-handler
(drracket:debug:make-debug-error-display-handler
(error-display-handler)))]

[(debug/profile)
(drracket:debug:profiling-enabled #t)
(error-display-handler
(drracket:debug:make-debug-error-display-handler
(error-display-handler)))
(current-eval (drracket:debug:make-debug-eval-handler (current-eval)))]
[(debug/profile)
(drracket:debug:profiling-enabled #t)
(error-display-handler
(drracket:debug:make-debug-error-display-handler
(error-display-handler)))
(current-eval (drracket:debug:make-debug-eval-handler (current-eval)))]

[(test-coverage)
(drracket:debug:test-coverage-enabled #t)
(error-display-handler
(drracket:debug:make-debug-error-display-handler
(error-display-handler)))
(current-eval (drracket:debug:make-debug-eval-handler (current-eval)))]))
[(test-coverage)
(drracket:debug:test-coverage-enabled #t)
(error-display-handler
(drracket:debug:make-debug-error-display-handler
(error-display-handler)))
(current-eval (drracket:debug:make-debug-eval-handler (current-eval)))])

(define-values (my-setup-printing-parameters
drracket-pretty-print-size-hook
Expand Down
66 changes: 47 additions & 19 deletions drracket-core-lib/drracket/private/module-language.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -229,7 +229,9 @@
[(debug/profile)
(string-constant module-language-repl-debug/profile-annotations)]
[(test-coverage)
(string-constant module-language-repl-test-annotations)]))]
(string-constant module-language-repl-test-annotations)]
[(lang-default)
(string-constant module-language-repl-no-annotations)]))]
[else
(get-language-name)]))

Expand All @@ -256,12 +258,12 @@
;; NOTE: this method is also used in the super class's implementation
;; of default-settings?, which is why the super call is appropriate
;; there, even tho these settings are not the same as the defaults
;; in other languages (here 'none is the default annotations,
;; in other languages (here 'lang-default is the default annotations,
;; there you get errortrace annotations).
(define/override (default-settings)
(let ([super-defaults (super default-settings)])
(make-module-language-settings
#t 'print 'mixed-fraction-e #f #t 'debug;; simple settings defaults
#t 'print 'mixed-fraction-e #f #t 'lang-default;; simple settings defaults

'(default)
#()
Expand All @@ -273,8 +275,15 @@

;; default-settings? : -> boolean
(define/override (default-settings? settings)

(and (super default-settings? settings)

;; first, check the simple settings defaults
(and (equal? (lmn:drracket:language:simple-settings-case-sensitive settings) #t)
(equal? (lmn:drracket:language:simple-settings-printing-style settings) 'print)
(equal? (lmn:drracket:language:simple-settings-fraction-style settings) 'mixed-fraction-e)
(equal? (lmn:drracket:language:simple-settings-show-sharing settings) #f)
(equal? (lmn:drracket:language:simple-settings-insert-newlines settings) #t)
;; except we want a different default for annotations
(equal? (lmn:drracket:language:simple-settings-annotations settings) 'lang-default)

(equal? (module-language-settings-collection-paths settings)
'(default))
Expand Down Expand Up @@ -359,15 +368,21 @@
;; versions might.
(and (memq
(drracket:language:simple-settings-annotations super)
'(none debug))
'(none debug lang-default))
compilation-on?)

full-trace?
submodules-to-run
enforce-module-constants)))))))))))

(define/override (on-execute settings run-in-user-thread)
(super on-execute settings run-in-user-thread)

;; drracket will always supply `the-irl`, but some tools might call this,
;; and they might not supply it
(define/override (on-execute settings run-in-user-thread [the-irl #f])
(parameterize ([drracket:language:lang-default-annotations
(call-read-language the-irl
'drracket:default-instrumentation
'debug)])
(super on-execute settings run-in-user-thread))

(let ([currently-open-files (get-currently-open-files)])
(run-in-user-thread
Expand Down Expand Up @@ -691,6 +706,7 @@
(define run-submodules-choice #f)
(define left-debugging-radio-box #f)
(define right-debugging-radio-box #f)
(define bottom-debugging-radio-box #f)
(define submodules-to-run #f)

(define (set-submodules-to-run l)
Expand Down Expand Up @@ -721,13 +737,15 @@
#:something-changed something-changed
#:case-sensitive #t

#:get-debugging-radio-box (λ (rb-l rb-r)
#:get-debugging-radio-box (λ (rb-l rb-r rb-b)
(set! left-debugging-radio-box rb-l)
(set! right-debugging-radio-box rb-r))
(set! right-debugging-radio-box rb-r)
(set! bottom-debugging-radio-box rb-b))

#:debugging-radio-box-callback
(λ ()
(update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box))
(update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box bottom-debugging-radio-box))
#:lang-default-debugging? #t

#:dynamic-panel-extras
(λ (dynamic-panel)
Expand Down Expand Up @@ -783,12 +801,19 @@
[font normal-control-font]
[parent dynamic-panel]
[label (string-constant submodules-to-run)])))))))
(define (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box)
(case (send left-debugging-radio-box get-selection)
[(0 1)
(define (update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box bottom-debugging-radio-box)
(define compilation-on-allowed?
(match* ((send left-debugging-radio-box get-selection)
(send bottom-debugging-radio-box get-selection))
[(0 _) #t]
[(1 _) #t]
[(_ 0) #t]
[(_ _) #f]))
(cond
[compilation-on-allowed?
(send compilation-on-check-box enable #t)
(send compilation-on-check-box set-value compilation-on?)]
[(#f)
[else
(send compilation-on-check-box enable #f)
(send compilation-on-check-box set-value #f)]))

Expand Down Expand Up @@ -924,7 +949,7 @@

(install-collection-paths '(default))
(update-buttons)
(update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box)
(update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box bottom-debugging-radio-box)

(define shortcuts
(append
Expand Down Expand Up @@ -954,7 +979,10 @@
#f ;; auto-text in the settings is ignored.
(case (send left-debugging-radio-box get-selection)
[(0 1) compilation-on?]
[(#f) #f])
[(#f)
(case (send bottom-debugging-radio-box get-selection)
[(0) compilation-on?]
[else #f])])
(send save-stacktrace-on-check-box get-value)
submodules-to-run
(send enforce-module-constants-checkbox get-value)))))]
Expand All @@ -964,7 +992,7 @@
(install-command-line-args (module-language-settings-command-line-args settings))
(set! compilation-on? (module-language-settings-compilation-on? settings))
(send compilation-on-check-box set-value (module-language-settings-compilation-on? settings))
(update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box)
(update-compilation-checkbox left-debugging-radio-box right-debugging-radio-box bottom-debugging-radio-box)
(send save-stacktrace-on-check-box set-value (module-language-settings-full-trace? settings))
(set-submodules-to-run (module-language-settings-submodules-to-run settings))
(send enforce-module-constants-checkbox set-value
Expand Down
Loading
Loading