From 1abaa1a1a0fe04ff3f023ccd3b2ae7bfdf483da6 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 6 Apr 2025 00:11:21 +0000 Subject: [PATCH 1/7] Fix 7 occurrences of `let-to-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. --- drracket-core-lib/browser/external.rkt | 383 +++++++++++++------------ drracket/gui-debugger/debug-tool.rkt | 139 +++++---- drracket/setup/plt-installer-unit.rkt | 12 +- 3 files changed, 269 insertions(+), 265 deletions(-) diff --git a/drracket-core-lib/browser/external.rkt b/drracket-core-lib/browser/external.rkt index 2fba81299..a237fe9eb 100644 --- a/drracket-core-lib/browser/external.rkt +++ b/drracket-core-lib/browser/external.rkt @@ -40,10 +40,11 @@ ;; sync-current-proxy-servers : proxy-pref -> void ;; syncs current-proxy-servers parameter with the proxy-pref-val (define (sync-current-proxy-servers pref-val) - (let* ([ops (current-proxy-servers)] - [removed (remove-all-proxies "http" ops)]) - (current-proxy-servers - (if pref-val (cons pref-val removed) removed)))) + (define ops (current-proxy-servers)) + (define removed (remove-all-proxies "http" ops)) + (current-proxy-servers (if pref-val + (cons pref-val removed) + removed))) (define (remove-all-proxies scheme proxies) (filter (lambda (x) (and (pair? x) (not (equal? (car x) scheme)))) @@ -94,38 +95,37 @@ ;; and in that case, the user can choose to use the internal ;; broswer. (define (choose-browser url) - (let* ([title (string-constant choose-browser)] - [d (make-object dialog% title)] - [main-pane (make-object vertical-pane% d)] - [internal-ok? (not url)] - [ok? #f] - [orig-external (fw:preferences:get 'external-browser)]) - (make-object message% title main-pane) - ;; No need to show the URL (it can be very long) - ;; (when url - ;; (make-object message% (format "URL: ~a" url) main-pane)) - (let-values ([(panel callbacks) (make-help-browser-preference-panel internal-ok? #f (lambda (f) (f main-pane)))]) - (let*-values ([(button-pane) (instantiate horizontal-panel% (main-pane) - (alignment '(right center)))] - [(ok-button cancel-button) - (fw:gui-utils:ok/cancel-buttons - button-pane - (lambda (b e) (set! ok? #t) (send d show #f)) - (lambda (b e) - (fw:preferences:set 'external-browser orig-external) - (send d show #f)))] - [(enable-button) (lambda (_n _v) - (queue-callback - (lambda () - (send ok-button enable (fw:preferences:get 'external-browser)))))]) - (send ok-button enable #f) - (set! callbacks - (cons - (fw:preferences:add-callback 'external-browser enable-button) - callbacks))) - (send d show #t) - (map (lambda (f) (f)) callbacks) - ok?))) + (define title (string-constant choose-browser)) + (define d (make-object dialog% title)) + (define main-pane (make-object vertical-pane% d)) + (define internal-ok? (not url)) + (define ok? #f) + (define orig-external (fw:preferences:get 'external-browser)) + (make-object message% title main-pane) + ;; No need to show the URL (it can be very long) + ;; (when url + ;; (make-object message% (format "URL: ~a" url) main-pane)) + (define-values (panel callbacks) + (make-help-browser-preference-panel internal-ok? #f (lambda (f) (f main-pane)))) + (let*-values ([(button-pane) (instantiate horizontal-panel% (main-pane) + [alignment '(right center)])] + [(ok-button cancel-button) (fw:gui-utils:ok/cancel-buttons + button-pane + (lambda (b e) + (set! ok? #t) + (send d show #f)) + (lambda (b e) + (fw:preferences:set 'external-browser orig-external) + (send d show #f)))] + [(enable-button) + (lambda (_n _v) + (queue-callback + (lambda () (send ok-button enable (fw:preferences:get 'external-browser)))))]) + (send ok-button enable #f) + (set! callbacks (cons (fw:preferences:add-callback 'external-browser enable-button) callbacks))) + (send d show #t) + (map (lambda (f) (f)) callbacks) + ok?) (define panel-installed? #f) (define prefs-panel #f) @@ -140,11 +140,11 @@ (lambda (f) (fw:preferences:add-panel (string-constant browser) (lambda (parent) - (let-values ([(panel cbs) (f parent)]) - (set! prefs-panel panel) - (map (lambda (f) (f panel)) additions) - (set! additions null) - panel))))))) + (define-values (panel cbs) (f parent)) + (set! prefs-panel panel) + (map (lambda (f) (f panel)) additions) + (set! additions null) + panel)))))) (define (add-to-browser-prefs-panel proc) (if prefs-panel @@ -155,150 +155,157 @@ (mk (lambda (parent) (define callbacks null) - (let ([pref-panel (instantiate vertical-panel% () - [parent parent] - [alignment '(left center)])]) - - ;; -------------------- external browser for Unix -------------------- - (when (unix-browser?) - (unless synchronized? - ;; Keep 'external-browser in sync - (fw:preferences:add-callback 'external-browser - (lambda (name browser) - (try-put-preferences (list 'external-browser) (list browser))))) - - (letrec ([v-panel (instantiate group-box-panel% () - (parent pref-panel) - (alignment '(right center)) - (stretchable-height #f) - (label (string-constant external-browser-choice-title)))] - [h-panel (instantiate horizontal-panel% () - (parent v-panel) - (alignment '(center bottom)))] - [none-index (length raw:unix-browser-list)] - [custom-index (add1 none-index)] - [r (instantiate radio-box% () - (label #f) - (choices (append unix-browser-names - (list (string-constant no-browser) - (string-constant browser-command-line-label)))) - (parent h-panel) - (callback - (lambda (radio event) - (let ([n (send radio get-selection)]) - (set-browser! - (cond - [(= n none-index) #f] - [(= n custom-index) (get-custom)] - [else (list-ref raw:unix-browser-list n)]))))))] - [select-custom - (lambda (_ __) - (send r set-selection custom-index) - (set-browser! (get-custom)))] - [get-custom - (lambda () (cons (send pre get-value) (send post get-value)))] - [template-panel (instantiate horizontal-panel% (h-panel) - (spacing 0) - (stretchable-height #f))] - [pre (instantiate text-field% () - (label #f) (parent template-panel) (callback select-custom) - (horiz-margin 0))] - [mess (instantiate message% () (label "") (parent template-panel) - (horiz-margin 0))] - [post (instantiate text-field% () - (label #f) (parent template-panel) (callback select-custom) - (horiz-margin 0))] - [note1 (instantiate message% ((string-constant browser-cmdline-expl-line-1) - v-panel))] - [note2 (instantiate message% ((string-constant browser-cmdline-expl-line-2) - v-panel))] - [refresh-controls (lambda (pref) - (if (pair? pref) - (begin - (send r set-selection custom-index) - (send pre set-value (car pref)) - (send post set-value (cdr pref))) - (let init ([x raw:unix-browser-list] [n 0]) - (cond - [(null? x) (send r set-selection n)] - [else (if (eq? pref (car x)) - (send r set-selection n) - (init (cdr x) (add1 n)))]))))]) - - (unless ask-later? - (send r enable none-index #f)) - - (refresh-controls (fw:preferences:get 'external-browser)) - (set! callbacks - (cons (fw:preferences:add-callback 'external-browser - (lambda (name browser) (refresh-controls browser))) - callbacks)))) - - ;; -------------------- proxy for doc downloads -------------------- - (when set-help? - (letrec ([p (instantiate group-box-panel% () - [label (string-constant http-proxy)] - [parent pref-panel] - [stretchable-height #f] - [alignment '(left top)])] - [rb (make-object radio-box% - #f (list (string-constant proxy-direct-connection) - (string-constant proxy-use-proxy)) - p - (lambda (r e) - (let ([proxy? (= 1 (send r get-selection))]) - (send proxy-spec enable proxy?) - (if proxy? - (update-proxy) - (fw:preferences:set http-proxy-preference #f)))))] - [proxy-spec (instantiate horizontal-panel% (p) - [stretchable-width #f] - [stretchable-height #f] - [alignment '(left center)])] - [update-proxy (lambda () - (let ([host (send host get-value)] - [port (send port get-value)]) - (let ([ok? (and (regexp-match? #rx"^[-0-9a-zA-Z.]+$" host) - (regexp-match? #rx"^[0-9]+$" port) - (string->number port) - (<= 1 (string->number port) 65535))]) - (when ok? - (fw:preferences:set - http-proxy-preference - (list "http" host (string->number port)))) - (send bad-host show (not ok?)))))] - [host (make-object text-field% - (string-constant proxy-host) - proxy-spec (lambda (x y) (update-proxy)) - "www.someplacethatisaproxy.domain.com")] - [port (make-object text-field% - (string-constant proxy-port) - proxy-spec (lambda (x y) (update-proxy)) "65535")] - [bad-host (make-object message% - (string-constant proxy-bad-host) - p)] - [update-gui - (lambda (proxy-val) - (send bad-host show #f) - (if proxy-val - (begin - (send rb set-selection 1) - (send proxy-spec enable #t) - (unless (string=? (cadr proxy-val) (send host get-value)) - (send host set-value (cadr proxy-val))) - (unless (equal? (caddr proxy-val) (string->number (send port get-value))) - (send port set-value (number->string (caddr proxy-val))))) - (begin - (send rb set-selection 0) - (send proxy-spec enable #f) - (send host set-value "") - (send port set-value ""))))]) - - (fw:preferences:add-callback http-proxy-preference - (lambda (name val) - (update-gui val))) - (update-gui (fw:preferences:get http-proxy-preference)) - (send bad-host show #f))) - - (set! synchronized? #t) - (values pref-panel callbacks))))) + (define pref-panel + (instantiate vertical-panel% () + [parent parent] + [alignment '(left center)])) + + ;; -------------------- external browser for Unix -------------------- + (when (unix-browser?) + (unless synchronized? + ;; Keep 'external-browser in sync + (fw:preferences:add-callback + 'external-browser + (lambda (name browser) (try-put-preferences (list 'external-browser) (list browser))))) + + (letrec + ([v-panel (instantiate group-box-panel% () + [parent pref-panel] + [alignment '(right center)] + [stretchable-height #f] + [label (string-constant external-browser-choice-title)])] + [h-panel (instantiate horizontal-panel% () + [parent v-panel] + [alignment '(center bottom)])] + [none-index (length raw:unix-browser-list)] + [custom-index (add1 none-index)] + [r (instantiate radio-box% () + [label #f] + [choices + (append unix-browser-names + (list (string-constant no-browser) + (string-constant browser-command-line-label)))] + [parent h-panel] + [callback + (lambda (radio event) + (let ([n (send radio get-selection)]) + (set-browser! (cond + [(= n none-index) #f] + [(= n custom-index) (get-custom)] + [else (list-ref raw:unix-browser-list n)]))))])] + [select-custom (lambda (_ __) + (send r set-selection custom-index) + (set-browser! (get-custom)))] + [get-custom (lambda () (cons (send pre get-value) (send post get-value)))] + [template-panel (instantiate horizontal-panel% (h-panel) + [spacing 0] + [stretchable-height #f])] + [pre (instantiate text-field% () + [label #f] + [parent template-panel] + [callback select-custom] + [horiz-margin 0])] + [mess (instantiate message% () + [label ""] + [parent template-panel] + [horiz-margin 0])] + [post (instantiate text-field% () + [label #f] + [parent template-panel] + [callback select-custom] + [horiz-margin 0])] + [note1 (instantiate message% ((string-constant browser-cmdline-expl-line-1) v-panel))] + [note2 (instantiate message% ((string-constant browser-cmdline-expl-line-2) v-panel))] + [refresh-controls (lambda (pref) + (if (pair? pref) + (begin + (send r set-selection custom-index) + (send pre set-value (car pref)) + (send post set-value (cdr pref))) + (let init ([x raw:unix-browser-list] + [n 0]) + (cond + [(null? x) (send r set-selection n)] + [else + (if (eq? pref (car x)) + (send r set-selection n) + (init (cdr x) + (add1 n)))]))))]) + + (unless ask-later? + (send r enable none-index #f)) + + (refresh-controls (fw:preferences:get 'external-browser)) + (set! callbacks + (cons (fw:preferences:add-callback 'external-browser + (lambda (name browser) + (refresh-controls browser))) + callbacks)))) + + ;; -------------------- proxy for doc downloads -------------------- + (when set-help? + (letrec ([p (instantiate group-box-panel% () + [label (string-constant http-proxy)] + [parent pref-panel] + [stretchable-height #f] + [alignment '(left top)])] + [rb (make-object radio-box% + #f + (list (string-constant proxy-direct-connection) + (string-constant proxy-use-proxy)) + p + (lambda (r e) + (let ([proxy? (= 1 (send r get-selection))]) + (send proxy-spec enable proxy?) + (if proxy? + (update-proxy) + (fw:preferences:set http-proxy-preference #f)))))] + [proxy-spec (instantiate horizontal-panel% (p) + [stretchable-width #f] + [stretchable-height #f] + [alignment '(left center)])] + [update-proxy (lambda () + (let ([host (send host get-value)] + [port (send port get-value)]) + (let ([ok? (and (regexp-match? #rx"^[-0-9a-zA-Z.]+$" host) + (regexp-match? #rx"^[0-9]+$" port) + (string->number port) + (<= 1 (string->number port) 65535))]) + (when ok? + (fw:preferences:set http-proxy-preference + (list "http" host (string->number port)))) + (send bad-host show (not ok?)))))] + [host (make-object text-field% + (string-constant proxy-host) + proxy-spec + (lambda (x y) (update-proxy)) + "www.someplacethatisaproxy.domain.com")] + [port (make-object text-field% + (string-constant proxy-port) + proxy-spec + (lambda (x y) (update-proxy)) + "65535")] + [bad-host (make-object message% (string-constant proxy-bad-host) p)] + [update-gui (lambda (proxy-val) + (send bad-host show #f) + (if proxy-val + (begin + (send rb set-selection 1) + (send proxy-spec enable #t) + (unless (string=? (cadr proxy-val) (send host get-value)) + (send host set-value (cadr proxy-val))) + (unless (equal? (caddr proxy-val) + (string->number (send port get-value))) + (send port set-value (number->string (caddr proxy-val))))) + (begin + (send rb set-selection 0) + (send proxy-spec enable #f) + (send host set-value "") + (send port set-value ""))))]) + + (fw:preferences:add-callback http-proxy-preference (lambda (name val) (update-gui val))) + (update-gui (fw:preferences:get http-proxy-preference)) + (send bad-host show #f))) + + (set! synchronized? #t) + (values pref-panel callbacks)))) diff --git a/drracket/gui-debugger/debug-tool.rkt b/drracket/gui-debugger/debug-tool.rkt index cc54b8510..768edd093 100644 --- a/drracket/gui-debugger/debug-tool.rkt +++ b/drracket/gui-debugger/debug-tool.rkt @@ -764,69 +764,69 @@ (run-in-evaluation-thread (lambda () ;(print-struct #t) - (let ([self (current-thread)] - [oeh (uncaught-exception-handler)] - [err-hndlr (error-display-handler)]) - (set! debugged-thread self) - (error-display-handler - (lambda (msg exn) - (err-hndlr msg exn) - (when (and (eq? self (current-thread)) (exn:fail? exn)) - (send (get-tab) suspend - oeh - (continuation-mark-set->list (exn-continuation-marks exn) debug-key) - 'error)))) ; this breaks the buttons because it looks like we can resume - (current-eval - (make-debug-eval-handler - (current-eval) - ; break? -- curried to avoid looking up defs from source each time - (lambda (src) - (let* ([defs (filename->defs src)] - [src-tab (if defs - (send defs get-tab) - (get-tab))] - [breakpoints (if src - (send src-tab get-breakpoints) - breakpoints)] - [single-step? (send tab get-single-step-box)] - [closed? (send src-tab get-closed-box)]) - (lambda (pos) - (and (not (unbox closed?)) - (or (unbox single-step?) - (let ([bp (hash-ref breakpoints pos #f)]) - (if (procedure? bp) - (bp) - bp))))))) - ; break-before - (lambda (top-mark ccm) - (define debug-marks (continuation-mark-set->list ccm debug-key)) - (send (get-tab) suspend oeh (cons top-mark debug-marks) 'entry-break)) - ; break-after - (case-lambda - [(top-mark ccm val) - (let* ([debug-marks (continuation-mark-set->list ccm debug-key)]) - (car (send (get-tab) suspend - oeh - (cons top-mark debug-marks) - (list 'exit-break val))))] - [(top-mark ccm . vals) - (define debug-marks (continuation-mark-set->list ccm debug-key)) - (apply values - (send (get-tab) suspend - oeh - (cons top-mark debug-marks) - (cons 'exit-break vals)))]))) - (uncaught-exception-handler - (lambda (exn) - (if (and (exn:break? exn) (send (get-tab) suspend-on-break?)) - (let ([marks (exn-continuation-marks exn)] - [cont (exn:break-continuation exn)]) - (send (get-tab) suspend - oeh - (continuation-mark-set->list marks debug-key) - 'break) - (cont)) - (oeh exn)))))))))))) + (define self (current-thread)) + (define oeh (uncaught-exception-handler)) + (define err-hndlr (error-display-handler)) + (set! debugged-thread self) + (error-display-handler + (lambda (msg exn) + (err-hndlr msg exn) + (when (and (eq? self (current-thread)) (exn:fail? exn)) + (send (get-tab) suspend + oeh + (continuation-mark-set->list (exn-continuation-marks exn) debug-key) + 'error)))) ; this breaks the buttons because it looks like we can resume + (current-eval + (make-debug-eval-handler + (current-eval) + ; break? -- curried to avoid looking up defs from source each time + (lambda (src) + (let* ([defs (filename->defs src)] + [src-tab (if defs + (send defs get-tab) + (get-tab))] + [breakpoints (if src + (send src-tab get-breakpoints) + breakpoints)] + [single-step? (send tab get-single-step-box)] + [closed? (send src-tab get-closed-box)]) + (lambda (pos) + (and (not (unbox closed?)) + (or (unbox single-step?) + (let ([bp (hash-ref breakpoints pos #f)]) + (if (procedure? bp) + (bp) + bp))))))) + ; break-before + (lambda (top-mark ccm) + (define debug-marks (continuation-mark-set->list ccm debug-key)) + (send (get-tab) suspend oeh (cons top-mark debug-marks) 'entry-break)) + ; break-after + (case-lambda + [(top-mark ccm val) + (let* ([debug-marks (continuation-mark-set->list ccm debug-key)]) + (car (send (get-tab) suspend + oeh + (cons top-mark debug-marks) + (list 'exit-break val))))] + [(top-mark ccm . vals) + (define debug-marks (continuation-mark-set->list ccm debug-key)) + (apply values + (send (get-tab) suspend + oeh + (cons top-mark debug-marks) + (cons 'exit-break vals)))]))) + (uncaught-exception-handler + (lambda (exn) + (if (and (exn:break? exn) (send (get-tab) suspend-on-break?)) + (let ([marks (exn-continuation-marks exn)] + [cont (exn:break-continuation exn)]) + (send (get-tab) suspend + oeh + (continuation-mark-set->list marks debug-key) + 'break) + (cont)) + (oeh exn))))))))))) (define (debug-tab-mixin super%) (class super% @@ -1198,13 +1198,12 @@ [else (already-debugging tab)])) (define/override (execute-callback) - (let ([tab (get-current-tab)]) - (cond - [(eq? tab (send tab get-primary)) - (send (get-current-tab) prepare-execution debug?) - (super execute-callback)] - [else - (already-debugging tab)]))) + (define tab (get-current-tab)) + (cond + [(eq? tab (send tab get-primary)) + (send (get-current-tab) prepare-execution debug?) + (super execute-callback)] + [else (already-debugging tab)])) (define/private (already-debugging tab) (message-box diff --git a/drracket/setup/plt-installer-unit.rkt b/drracket/setup/plt-installer-unit.rkt index a31eee5f8..aba9b2ca9 100644 --- a/drracket/setup/plt-installer-unit.rkt +++ b/drracket/setup/plt-installer-unit.rkt @@ -41,12 +41,10 @@ (sleep 0.2) ; kludge to allow f to appear first (end-busy-cursor) ;; do these strings ever appear? (should move to string-constants, if so) - (let ([d (get-directory - "Select the destination for unpacking" - frame)]) - (unless d - (printf ">>> Cancelled <<<\n")) - (begin-busy-cursor) - d)) + (define d (get-directory "Select the destination for unpacking" frame)) + (unless d + (printf ">>> Cancelled <<<\n")) + (begin-busy-cursor) + d) #:show-beginning-of-file? #t)) cleanup-thunk))) From e793ec59ca814383cefd701ac37a6559362f23f3 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 6 Apr 2025 00:11:21 +0000 Subject: [PATCH 2/7] Fix 1 occurrence of `map-to-for` This `map` operation can be replaced with a `for/list` loop. --- drracket-core-lib/browser/external.rkt | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/drracket-core-lib/browser/external.rkt b/drracket-core-lib/browser/external.rkt index a237fe9eb..52b9c0cac 100644 --- a/drracket-core-lib/browser/external.rkt +++ b/drracket-core-lib/browser/external.rkt @@ -85,9 +85,8 @@ (loop (add1 tries))))))) (define unix-browser-names - (map (lambda (s) - (string-titlecase (regexp-replace* #rx"-" (symbol->string s) " "))) - raw:unix-browser-list)) + (for/list ([s (in-list raw:unix-browser-list)]) + (string-titlecase (regexp-replace* #rx"-" (symbol->string s) " ")))) ;; : (U str #f) -> (U symbol #f) ;; to prompt the user for a browser preference From 80bc4a73f922adfcf70934bdc91e1635be948aa2 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 6 Apr 2025 00:11:21 +0000 Subject: [PATCH 3/7] Fix 1 occurrence of `cond-let-to-cond-define` Internal definitions are recommended instead of `let` expressions, to reduce nesting. --- drracket/gui-debugger/debug-tool.rkt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/drracket/gui-debugger/debug-tool.rkt b/drracket/gui-debugger/debug-tool.rkt index 768edd093..959f28af1 100644 --- a/drracket/gui-debugger/debug-tool.rkt +++ b/drracket/gui-debugger/debug-tool.rkt @@ -266,10 +266,10 @@ (cond [(not (unbox on-it?)) (values #f #f)] [else - (let ([snip (send editor find-snip pos 'after-or-none)]) - (if (and snip (is-a? snip editor-snip%)) - (loop (send snip get-editor)) - (values pos editor)))])] + (define snip (send editor find-snip pos 'after-or-none)) + (if (and snip (is-a? snip editor-snip%)) + (loop (send snip get-editor)) + (values pos editor))])] [(is-a? editor pasteboard%) (define snip (send editor find-snip x y)) (if (and snip (is-a? snip editor-snip%)) From 9b60899fac6b0b91ca1f2dc76d9b9c87bf8cda73 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 6 Apr 2025 00:11:21 +0000 Subject: [PATCH 4/7] Fix 1 occurrence of `if-let-to-cond` `cond` with internal definitions is preferred over `if` with `let`, to reduce nesting --- drracket/gui-debugger/debug-tool.rkt | 57 ++++++++++++++-------------- 1 file changed, 29 insertions(+), 28 deletions(-) diff --git a/drracket/gui-debugger/debug-tool.rkt b/drracket/gui-debugger/debug-tool.rkt index 959f28af1..2234dc72b 100644 --- a/drracket/gui-debugger/debug-tool.rkt +++ b/drracket/gui-debugger/debug-tool.rkt @@ -1038,34 +1038,35 @@ (send (get-frame) register-stack-frames frames already-stopped?) (send (get-frame) register-vars (list-ref frames (get-frame-num)))) (send status-message set-label - (if (and (cons? status) top-of-stack?) - (let ([expr (mark-source (first frames))]) - (cond - ; should succeed unless the user closes a secondary tab during debugging - [(filename->defs (syntax-source expr)) - => (lambda (defs) - (clean-status - (string-append - (if (syntax-position expr) - (trim-expr-str - (send defs get-text - (sub1 (syntax-position expr)) - (+ -1 (syntax-position expr) (syntax-span expr)))) - "??") - " => " - (if (= 2 (length status)) - (or (render (cadr status)) "??") - (string-append - "(values" - (let loop ([vals (rest status)]) - (cond - [(cons? vals) (string-append " " - (or (render (first vals)) - "??") - (loop (rest vals)))] - [else ")"])))))))] - [""])) - "")) + (cond + [(and (cons? status) top-of-stack?) + (define expr (mark-source (first frames))) + (cond + ; should succeed unless the user closes a secondary tab during debugging + [(filename->defs (syntax-source expr)) + => + (lambda (defs) + (clean-status + (string-append + (if (syntax-position expr) + (trim-expr-str + (send defs get-text + (sub1 (syntax-position expr)) + (+ -1 (syntax-position expr) (syntax-span expr)))) + "??") + " => " + (if (= 2 (length status)) + (or (render (cadr status)) "??") + (string-append "(values" + (let loop ([vals (rest status)]) + (cond + [(cons? vals) + (string-append " " + (or (render (first vals)) "??") + (loop (rest vals)))] + [else ")"])))))))] + [""])] + [else ""])) (cond [(get-current-frame-endpoints) => (lambda (start/end) (cond [(and (first start/end) (defs-containing-current-frame)) From 5b95ae6ce3030d0bc4670505fce3def22e168fb2 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 6 Apr 2025 00:11:21 +0000 Subject: [PATCH 5/7] Fix 7 occurrences of `instantiate-to-new` The `instantiate` form is for mixing positional and by-name constructor arguments. When no positional arguments are needed, use `new` instead. --- drracket-core-lib/browser/external.rkt | 71 ++++++++++++-------------- 1 file changed, 32 insertions(+), 39 deletions(-) diff --git a/drracket-core-lib/browser/external.rkt b/drracket-core-lib/browser/external.rkt index 52b9c0cac..04d99eebf 100644 --- a/drracket-core-lib/browser/external.rkt +++ b/drracket-core-lib/browser/external.rkt @@ -155,9 +155,7 @@ (lambda (parent) (define callbacks null) (define pref-panel - (instantiate vertical-panel% () - [parent parent] - [alignment '(left center)])) + (new vertical-panel% [parent parent] [alignment '(left center)])) ;; -------------------- external browser for Unix -------------------- (when (unix-browser?) @@ -168,30 +166,28 @@ (lambda (name browser) (try-put-preferences (list 'external-browser) (list browser))))) (letrec - ([v-panel (instantiate group-box-panel% () - [parent pref-panel] - [alignment '(right center)] - [stretchable-height #f] - [label (string-constant external-browser-choice-title)])] - [h-panel (instantiate horizontal-panel% () - [parent v-panel] - [alignment '(center bottom)])] + ([v-panel (new group-box-panel% + [parent pref-panel] + [alignment '(right center)] + [stretchable-height #f] + [label (string-constant external-browser-choice-title)])] + [h-panel (new horizontal-panel% [parent v-panel] [alignment '(center bottom)])] [none-index (length raw:unix-browser-list)] [custom-index (add1 none-index)] - [r (instantiate radio-box% () - [label #f] - [choices - (append unix-browser-names - (list (string-constant no-browser) - (string-constant browser-command-line-label)))] - [parent h-panel] - [callback - (lambda (radio event) - (let ([n (send radio get-selection)]) - (set-browser! (cond - [(= n none-index) #f] - [(= n custom-index) (get-custom)] - [else (list-ref raw:unix-browser-list n)]))))])] + [r (new radio-box% + [label #f] + [choices + (append unix-browser-names + (list (string-constant no-browser) + (string-constant browser-command-line-label)))] + [parent h-panel] + [callback + (lambda (radio event) + (let ([n (send radio get-selection)]) + (set-browser! (cond + [(= n none-index) #f] + [(= n custom-index) (get-custom)] + [else (list-ref raw:unix-browser-list n)]))))])] [select-custom (lambda (_ __) (send r set-selection custom-index) (set-browser! (get-custom)))] @@ -199,20 +195,17 @@ [template-panel (instantiate horizontal-panel% (h-panel) [spacing 0] [stretchable-height #f])] - [pre (instantiate text-field% () - [label #f] - [parent template-panel] - [callback select-custom] - [horiz-margin 0])] - [mess (instantiate message% () - [label ""] - [parent template-panel] - [horiz-margin 0])] - [post (instantiate text-field% () - [label #f] - [parent template-panel] - [callback select-custom] - [horiz-margin 0])] + [pre (new text-field% + [label #f] + [parent template-panel] + [callback select-custom] + [horiz-margin 0])] + [mess (new message% [label ""] [parent template-panel] [horiz-margin 0])] + [post (new text-field% + [label #f] + [parent template-panel] + [callback select-custom] + [horiz-margin 0])] [note1 (instantiate message% ((string-constant browser-cmdline-expl-line-1) v-panel))] [note2 (instantiate message% ((string-constant browser-cmdline-expl-line-2) v-panel))] [refresh-controls (lambda (pref) From 883e6a2c50763f6df2c5e7093c5ab70acddbb08c Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 6 Apr 2025 00:11:21 +0000 Subject: [PATCH 6/7] Fix 2 occurrences of `instantiate-to-make-object` The `instantiate` form is for mixing positional and by-name constructor arguments. When no by-name arguments are needed, use `make-object` instead. --- drracket-core-lib/browser/external.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/drracket-core-lib/browser/external.rkt b/drracket-core-lib/browser/external.rkt index 04d99eebf..2d0bb8842 100644 --- a/drracket-core-lib/browser/external.rkt +++ b/drracket-core-lib/browser/external.rkt @@ -206,8 +206,8 @@ [parent template-panel] [callback select-custom] [horiz-margin 0])] - [note1 (instantiate message% ((string-constant browser-cmdline-expl-line-1) v-panel))] - [note2 (instantiate message% ((string-constant browser-cmdline-expl-line-2) v-panel))] + [note1 (make-object message% (string-constant browser-cmdline-expl-line-1) v-panel)] + [note2 (make-object message% (string-constant browser-cmdline-expl-line-2) v-panel)] [refresh-controls (lambda (pref) (if (pair? pref) (begin From 15b466487cb3cb7b02fa558d8d770fa6b53cd0ce Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 6 Apr 2025 00:11:21 +0000 Subject: [PATCH 7/7] Fix 1 occurrence of `if-begin-to-cond` Using `cond` instead of `if` here makes `begin` unnecessary --- drracket-core-lib/browser/external.rkt | 29 +++++++++++++------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/drracket-core-lib/browser/external.rkt b/drracket-core-lib/browser/external.rkt index 2d0bb8842..8c701a75e 100644 --- a/drracket-core-lib/browser/external.rkt +++ b/drracket-core-lib/browser/external.rkt @@ -209,20 +209,21 @@ [note1 (make-object message% (string-constant browser-cmdline-expl-line-1) v-panel)] [note2 (make-object message% (string-constant browser-cmdline-expl-line-2) v-panel)] [refresh-controls (lambda (pref) - (if (pair? pref) - (begin - (send r set-selection custom-index) - (send pre set-value (car pref)) - (send post set-value (cdr pref))) - (let init ([x raw:unix-browser-list] - [n 0]) - (cond - [(null? x) (send r set-selection n)] - [else - (if (eq? pref (car x)) - (send r set-selection n) - (init (cdr x) - (add1 n)))]))))]) + (cond + [(pair? pref) + (send r set-selection custom-index) + (send pre set-value (car pref)) + (send post set-value (cdr pref))] + [else + (let init ([x raw:unix-browser-list] + [n 0]) + (cond + [(null? x) (send r set-selection n)] + [else + (if (eq? pref (car x)) + (send r set-selection n) + (init (cdr x) + (add1 n)))]))]))]) (unless ask-later? (send r enable none-index #f))