From 6abf2177072b6474573e3bc7064358a1482cfdd6 Mon Sep 17 00:00:00 2001 From: "resyntax-ci[bot]" <181813515+resyntax-ci[bot]@users.noreply.github.com> Date: Sun, 20 Oct 2024 00:10:37 +0000 Subject: [PATCH] Automated Resyntax fixes This is an automated change generated by Resyntax. #### Pass 1 Applied 17 fixes to [`drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt`](../blob/HEAD/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt) * Line 3, `tidy-require`: Keep imports in `require` sorted and grouped by phase, with collections before files. * Line 51, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. * Line 684, `hash-set!-ref-to-hash-update!`: This expression can be replaced with a simpler, equivalent `hash-update!` expression. * Line 713, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. * Line 728, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. * Line 771, `nested-for-to-for*`: These nested `for` loops can be replaced by a single `for*` loop. * Line 785, `nested-for-to-for*`: These nested `for` loops can be replaced by a single `for*` loop. * Line 835, `nested-for-to-for*`: These nested `for` loops can be replaced by a single `for*` loop. * Line 906, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. * Line 972, `if-else-false-to-and`: This `if` expression can be refactored to an equivalent expression using `and`. * Line 1074, `if-else-false-to-and`: This `if` expression can be refactored to an equivalent expression using `and`. * Line 1098, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. * Line 1129, `when-expression-in-for-loop-to-when-keyword`: Use the `#:when` keyword instead of `when` to reduce loop body indentation. * Line 1275, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. * Line 1366, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. * Line 1424, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. * Line 1451, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. Applied 2 fixes to [`drracket/setup/plt-installer-unit.rkt`](../blob/HEAD/drracket/setup/plt-installer-unit.rkt) * Line 2, `tidy-require`: Keep imports in `require` sorted and grouped by phase, with collections before files. * Line 44, `let-to-define`: Internal definitions are recommended instead of `let` expressions, to reduce nesting. Applied 1 fix to [`drracket/repo-time-stamp/time-stamp.rkt`](../blob/HEAD/drracket/repo-time-stamp/time-stamp.rkt) * Line 2, `tidy-require`: Keep imports in `require` sorted and grouped by phase, with collections before files. ## Summary Fixed 20 issues in 3 files. * Fixed 10 occurrences of `let-to-define` * Fixed 3 occurrences of `tidy-require` * Fixed 3 occurrences of `nested-for-to-for*` * Fixed 2 occurrences of `if-else-false-to-and` * Fixed 1 occurrence of `hash-set!-ref-to-hash-update!` * Fixed 1 occurrence of `when-expression-in-for-loop-to-when-keyword` --- .../drracket/private/syncheck/traversals.rkt | 474 +++++++++--------- drracket/repo-time-stamp/time-stamp.rkt | 5 +- drracket/setup/plt-installer-unit.rkt | 22 +- 3 files changed, 259 insertions(+), 242 deletions(-) diff --git a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt index 4a52e9b1f..f28d04392 100644 --- a/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt +++ b/drracket-tool-text-lib/drracket/private/syncheck/traversals.rkt @@ -1,23 +1,23 @@ #lang racket/base -(require "colors.rkt" - "syncheck-intf.rkt" - "syncheck-local-member-names.rkt" - "annotate.rkt" - "contract-traversal.rkt" - "xref.rkt" - string-constants - racket/match - racket/set +(require (for-syntax racket/base) racket/class - racket/list racket/contract - racket/pretty - racket/path racket/dict - syntax/id-table + racket/list + racket/match + racket/path + racket/pretty + racket/set scribble/manual-struct - (for-syntax racket/base)) + string-constants + syntax/id-table + "annotate.rkt" + "colors.rkt" + "contract-traversal.rkt" + "syncheck-intf.rkt" + "syncheck-local-member-names.rkt" + "xref.rkt") (define-logger check-syntax) @@ -48,76 +48,81 @@ (λ (sexp [ignored void]) (parameterize ([current-directory (or user-directory (current-directory))] [current-load-relative-directory user-directory]) - (let ([is-module? (syntax-case sexp (module) - [(module . rest) #t] - [_ #f])]) - (cond - [is-module? - (let ([phase-to-binders (make-hash)] - [phase-to-varrefs (make-hash)] - [phase-to-varsets (make-hash)] - [phase-to-tops (make-hash)] - [phase-to-requires (make-hash)] - [binding-inits (make-hash)] - [templrefs (make-id-set 0)] - [module-lang-requires (make-hash)] - [requires (make-hash)] - [require-for-syntaxes (make-hash)] - [require-for-templates (make-hash)] - [require-for-labels (make-hash)] - [sub-identifier-binding-directives (make-hash)]) - (annotate-basic sexp - user-namespace user-directory - phase-to-binders - phase-to-varrefs - phase-to-varsets - phase-to-tops - binding-inits - templrefs - module-lang-requires - phase-to-requires - sub-identifier-binding-directives) - (annotate-variables user-namespace - user-directory - phase-to-binders - phase-to-varrefs - phase-to-varsets - phase-to-tops - templrefs - module-lang-requires - phase-to-requires - sub-identifier-binding-directives) - (annotate-contracts sexp - (hash-ref phase-to-binders 0 (λ () (make-id-set 0))) - (hash-ref binding-inits 0 (λ () (make-id-set 0))) - binder+mods-binder) - (when print-extra-info? - (print-extra-info (list (list 'phase-to-binders phase-to-binders) - (list 'phase-to-varrefs phase-to-varrefs) - (list 'phase-to-varsets phase-to-varsets) - (list 'phase-to-tops phase-to-tops) - (list 'phase-to-requires phase-to-requires) - (list 'binding-inits binding-inits) - (list 'templrefs templrefs) - (list 'module-lang-requires module-lang-requires) - (list 'requires requires) - (list 'require-for-syntaxes require-for-syntaxes) - (list 'require-for-templates require-for-templates) - (list 'require-for-labels require-for-labels) - (list 'sub-identifier-binding-directives - sub-identifier-binding-directives)))))] - [else + (define is-module? + (syntax-case sexp (module) + [(module . rest + ) + #t] + [_ #f])) + (cond + [is-module? + (let ([phase-to-binders (make-hash)] + [phase-to-varrefs (make-hash)] + [phase-to-varsets (make-hash)] + [phase-to-tops (make-hash)] + [phase-to-requires (make-hash)] + [binding-inits (make-hash)] + [templrefs (make-id-set 0)] + [module-lang-requires (make-hash)] + [requires (make-hash)] + [require-for-syntaxes (make-hash)] + [require-for-templates (make-hash)] + [require-for-labels (make-hash)] + [sub-identifier-binding-directives (make-hash)]) (annotate-basic sexp - user-namespace user-directory - tl-phase-to-binders - tl-phase-to-varrefs - tl-phase-to-varsets - tl-phase-to-tops - tl-binding-inits - tl-templrefs - tl-module-lang-requires - tl-phase-to-requires - tl-sub-identifier-binding-directives)]))))] + user-namespace + user-directory + phase-to-binders + phase-to-varrefs + phase-to-varsets + phase-to-tops + binding-inits + templrefs + module-lang-requires + phase-to-requires + sub-identifier-binding-directives) + (annotate-variables user-namespace + user-directory + phase-to-binders + phase-to-varrefs + phase-to-varsets + phase-to-tops + templrefs + module-lang-requires + phase-to-requires + sub-identifier-binding-directives) + (annotate-contracts sexp + (hash-ref phase-to-binders 0 (λ () (make-id-set 0))) + (hash-ref binding-inits 0 (λ () (make-id-set 0))) + binder+mods-binder) + (when print-extra-info? + (print-extra-info (list (list 'phase-to-binders phase-to-binders) + (list 'phase-to-varrefs phase-to-varrefs) + (list 'phase-to-varsets phase-to-varsets) + (list 'phase-to-tops phase-to-tops) + (list 'phase-to-requires phase-to-requires) + (list 'binding-inits binding-inits) + (list 'templrefs templrefs) + (list 'module-lang-requires module-lang-requires) + (list 'requires requires) + (list 'require-for-syntaxes require-for-syntaxes) + (list 'require-for-templates require-for-templates) + (list 'require-for-labels require-for-labels) + (list 'sub-identifier-binding-directives + sub-identifier-binding-directives)))))] + [else + (annotate-basic sexp + user-namespace + user-directory + tl-phase-to-binders + tl-phase-to-varrefs + tl-phase-to-varsets + tl-phase-to-tops + tl-binding-inits + tl-templrefs + tl-module-lang-requires + tl-phase-to-requires + tl-sub-identifier-binding-directives)])))] [expansion-completed (λ () (parameterize ([current-directory (or user-directory (current-directory))] @@ -681,10 +686,7 @@ (vector-ref the-vec 8) (vector-ref the-vec 9))) (define key (list level mods)) - (hash-set! sub-identifier-binding-directives - key - (cons new-entry - (hash-ref sub-identifier-binding-directives key '())))] + (hash-update! sub-identifier-binding-directives key (λ (v) (cons new-entry v)) '())] [(vector? prop) (log-check-syntax-debug "found a vector in a 'sub-range-binders property that is ill-formed ~s" @@ -710,32 +712,41 @@ ;; add-disappeared-bindings : syntax id-set integer -> void (define (add-disappeared-bindings stx binders sub-identifier-binding-directives disappeared-uses level level-of-enclosing-module mods) - (let ([prop (syntax-property stx 'disappeared-binding)]) - (when prop - (let loop ([prop prop]) - (cond - [(pair? prop) - (loop (car prop)) - (loop (cdr prop))] - [(identifier? prop) - (add-origins prop disappeared-uses level-of-enclosing-module) - (add-binders prop binders #f #f level level-of-enclosing-module - sub-identifier-binding-directives mods)]))))) + (define prop (syntax-property stx 'disappeared-binding)) + (when prop + (let loop ([prop prop]) + (cond + [(pair? prop) + (loop (car prop)) + (loop (cdr prop))] + [(identifier? prop) + (add-origins prop disappeared-uses level-of-enclosing-module) + (add-binders prop + binders + #f + #f + level + level-of-enclosing-module + sub-identifier-binding-directives + mods)])))) ;; add-disappeared-uses : syntax id-set integer -> void (define (add-disappeared-uses stx id-set sub-identifier-binding-directives level level-of-enclosing-module mods) - (let ([prop (syntax-property stx 'disappeared-use)]) - (when prop - (let loop ([prop prop]) - (cond - [(pair? prop) - (loop (car prop)) - (loop (cdr prop))] - [(identifier? prop) - (add-sub-range-binders prop sub-identifier-binding-directives - level level-of-enclosing-module mods) - (add-id id-set prop level-of-enclosing-module)]))))) + (define prop (syntax-property stx 'disappeared-use)) + (when prop + (let loop ([prop prop]) + (cond + [(pair? prop) + (loop (car prop)) + (loop (cdr prop))] + [(identifier? prop) + (add-sub-range-binders prop + sub-identifier-binding-directives + level + level-of-enclosing-module + mods) + (add-id id-set prop level-of-enclosing-module)])))) ;; annotate-variables : namespace directory string id-set[four of them] ;; (listof syntax) (listof syntax) @@ -768,13 +779,13 @@ (for ([(k v) (in-hash requires)]) (hash-set! new-hash k #t))) - (for ([(level binders) (in-hash phase-to-binders)]) - (for ([(_ binder+modss) (in-dict binders)]) - (for ([binder+mods (in-list binder+modss)]) - (define var (binder+mods-binder binder+mods)) - (define varset (lookup-phase-to-mapping phase-to-varsets level)) - (color-variable var level varset) - (document-variable var level)))) + (for* ([(level binders) (in-hash phase-to-binders)] + [(_ binder+modss) (in-dict binders)] + [binder+mods (in-list binder+modss)]) + (define var (binder+mods-binder binder+mods)) + (define varset (lookup-phase-to-mapping phase-to-varsets level)) + (color-variable var level varset) + (document-variable var level)) (for ([(level+mods varrefs) (in-hash phase-to-varrefs)]) (define level (list-ref level+mods 0)) @@ -782,21 +793,21 @@ (define binders (lookup-phase-to-mapping phase-to-binders level)) (define varsets (lookup-phase-to-mapping phase-to-varsets level)) (initialize-binder-connections binders connections) - (for ([vars (in-list (get-idss varrefs))]) - (for ([var (in-list vars)]) - (color-variable var level varsets) - (document-variable var level) - (connect-identifier var - mods - binders - unused/phases - phase-to-requires - level - user-namespace - user-directory - #t - connections - module-lang-requires)))) + (for* ([vars (in-list (get-idss varrefs))] + [var (in-list vars)]) + (color-variable var level varsets) + (document-variable var level) + (connect-identifier var + mods + binders + unused/phases + phase-to-requires + level + user-namespace + user-directory + #t + connections + module-lang-requires))) ;; build a set of all of the known phases @@ -832,10 +843,9 @@ (for ([(level tops) (in-hash phase-to-tops)]) (define binders (lookup-phase-to-mapping phase-to-binders level)) - (for ([vars (in-list (get-idss tops))]) - (for ([var (in-list vars)]) - (color/connect-top user-namespace user-directory binders var connections - module-lang-requires)))) + (for* ([vars (in-list (get-idss tops))] + [var (in-list vars)]) + (color/connect-top user-namespace user-directory binders var connections module-lang-requires))) (for ([(phase+mods require-hash) (in-hash phase-to-requires)]) ;; don't mark for-label requires as unused until we can properly handle them @@ -903,8 +913,8 @@ (color-range source start end unused-require-style-name)) (define (self-module? mpi) - (let-values ([(a b) (module-path-index-split mpi)]) - (and (not a) (not b)))) + (define-values (a b) (module-path-index-split mpi)) + (and (not a) (not b))) ;; connect-identifier : syntax ;; (or/c #f (listof symbol)) -- name of enclosing sub-modules @@ -969,7 +979,7 @@ (define source-id (list-ref source-req-path/pr 1)) (define req-phase+space-shift (list-ref req-path/pr 3)) (define req-phase-level (if (pair? req-phase+space-shift) (car req-phase+space-shift) req-phase+space-shift)) - (define req-space (if (pair? req-phase+space-shift) (cdr req-phase+space-shift) #f)) + (define req-space (and (pair? req-phase+space-shift) (cdr req-phase+space-shift))) (define require-hash-key (list req-phase-level mods)) (define require-ht (hash-ref phase-to-requires require-hash-key #f)) (when id @@ -1071,7 +1081,7 @@ (define phase-shift (if (pair? phase+space-shift) (car phase+space-shift) phase+space-shift)) (define phase+space (list-ref binding 6)) (define phase (if (pair? phase+space) (car phase+space) phase+space)) - (define space (if (pair? phase+space) (cdr phase+space) #f)) + (define space (and (pair? phase+space) (cdr phase+space))) (when (and (number? phase-level) (not (= phase-level (+ phase-shift @@ -1095,20 +1105,26 @@ ;; color/connect-top : namespace directory id-set syntax connections[see defn for ctc] -> void (define (color/connect-top user-namespace user-directory binders var connections module-lang-requires) - (let ([top-bound? - (or (get-ids binders var) - (parameterize ([current-namespace user-namespace]) - (let/ec k - (namespace-variable-value (syntax-e var) #t (λ () (k #f))) - #t)))]) - (cond - [top-bound? - (color var lexically-bound-variable-style-name)] - [else - (add-mouse-over var (format "~s is a free variable" (syntax-e var))) - (color var free-variable-style-name)]) - (connect-identifier var #f binders #f #f 0 user-namespace user-directory #t connections - module-lang-requires))) + (define top-bound? + (or (get-ids binders var) + (parameterize ([current-namespace user-namespace]) + (let/ec k (namespace-variable-value (syntax-e var) #t (λ () (k #f))) #t)))) + (cond + [top-bound? (color var lexically-bound-variable-style-name)] + [else + (add-mouse-over var (format "~s is a free variable" (syntax-e var))) + (color var free-variable-style-name)]) + (connect-identifier var + #f + binders + #f + #f + 0 + user-namespace + user-directory + #t + connections + module-lang-requires)) ;; annotate-counts : connections[see defn] -> void ;; this function doesn't try to show the number of uses at @@ -1126,39 +1142,39 @@ ;; records the src locs of each 'end' position of each arrow) ;; to do this, but maybe lets leave that for another day. (define (annotate-counts connections) - (for ([(key val) (in-hash connections)]) - (when (list? val) - (define start (first val)) - (define end (second val)) - (define color? (third val)) - (define (show-starts) - (when (zero? start) - (define defs-text (current-annotations)) - (when defs-text - (send defs-text syncheck:unused-binder - (list-ref key 0) (list-ref key 1) (list-ref key 2)))) - (add-mouse-over/loc (list-ref key 0) (list-ref key 1) (list-ref key 2) - (cond - [(zero? start) - (string-constant cs-zero-varrefs)] - [(= 1 start) - (string-constant cs-one-varref)] - [else - (format (string-constant cs-n-varrefs) start)]))) - (define (show-ends) - (unless (= 1 end) - (add-mouse-over/loc (list-ref key 0) (list-ref key 1) (list-ref key 2) - (format (string-constant cs-binder-count) end)))) - (cond - [(zero? end) ;; assume this is a binder, show uses - #;(when (and color? (zero? start)) - (color-unused-binder (list-ref key 0) (list-ref key 1) (list-ref key 2))) - (show-starts)] - [(zero? start) ;; assume this is a use, show bindings (usually just one, so do nothing) - (show-ends)] - [else ;; crazyness, show both - (show-starts) - (show-ends)])))) + (for ([(key val) (in-hash connections)] + #:when (list? val)) + (define start (first val)) + (define end (second val)) + (define color? (third val)) + (define (show-starts) + (when (zero? start) + (define defs-text (current-annotations)) + (when defs-text + (send defs-text syncheck:unused-binder (list-ref key 0) (list-ref key 1) (list-ref key 2)))) + (add-mouse-over/loc (list-ref key 0) + (list-ref key 1) + (list-ref key 2) + (cond + [(zero? start) (string-constant cs-zero-varrefs)] + [(= 1 start) (string-constant cs-one-varref)] + [else (format (string-constant cs-n-varrefs) start)]))) + (define (show-ends) + (unless (= 1 end) + (add-mouse-over/loc (list-ref key 0) + (list-ref key 1) + (list-ref key 2) + (format (string-constant cs-binder-count) end)))) + (cond + ;; assume this is a binder, show uses + #;(when (and color? (zero? start)) + (color-unused-binder (list-ref key 0) (list-ref key 1) (list-ref key 2))) + [(zero? end) (show-starts)] + ;; assume this is a use, show bindings (usually just one, so do nothing) + [(zero? start) (show-ends)] + [else ;; crazyness, show both + (show-starts) + (show-ends)]))) ;; color-variable : syntax phase-level identifier-mapping -> void (define (color-variable var phase-level varsets) @@ -1272,22 +1288,20 @@ ;; popup menu in this area allows the programmer to jump ;; to the definition of the id. (define (add-jump-to-definition stx id filename submods phase-level+space) - (let ([source (find-source-editor stx)] - [defs-text (current-annotations)]) - (when (and source - defs-text - (syntax-position stx) - (syntax-span stx)) - (let* ([pos-left (- (syntax-position stx) 1)] - [pos-right (+ pos-left (syntax-span stx))]) - (send defs-text syncheck:add-jump-to-definition/phase-level+space - source - pos-left - pos-right - id - filename - submods - phase-level+space))))) + (define source (find-source-editor stx)) + (define defs-text (current-annotations)) + (when (and source defs-text (syntax-position stx) (syntax-span stx)) + (let* ([pos-left (- (syntax-position stx) 1)] + [pos-right (+ pos-left (syntax-span stx))]) + (send defs-text + syncheck:add-jump-to-definition/phase-level+space + source + pos-left + pos-right + id + filename + submods + phase-level+space)))) ;; annotate-require-open : namespace string -> (stx -> void) ;; relies on current-module-name-resolver, which in turn depends on @@ -1363,10 +1377,10 @@ (unless (and (len . >= . 4) (bytes=? #".rkt" (subbytes bts (- len 4)))) (k rkt-path/f)) - (let ([ss-path (bytes->path (bytes-append (subbytes bts 0 (- len 4)) #".ss"))]) - (unless (file-exists? ss-path) - (k rkt-path/f)) - ss-path)))) + (define ss-path (bytes->path (bytes-append (subbytes bts 0 (- len 4)) #".ss"))) + (unless (file-exists? ss-path) + (k rkt-path/f)) + ss-path))) (values cleaned-up-path rkt-submods))) ;; add-origins : syntax? id-set exact-integer? -> void @@ -1421,20 +1435,21 @@ (add-init-exp binding-to-init stx init-exp level-of-enclosing-module)) (add-id id-set stx level-of-enclosing-module #:mods mods)) (let loop ([stx stx]) - (let ([e (if (syntax? stx) (syntax-e stx) stx)]) - (cond - [(cons? e) - (define fst (car e)) - (define rst (cdr e)) - (cond - [(syntax? fst) - (add-id&init&sub-range-binders fst) - (loop rst)] - [else - (loop rst)])] - [(null? e) (void)] - [else - (add-id&init&sub-range-binders stx)])))) + (define e + (if (syntax? stx) + (syntax-e stx) + stx)) + (cond + [(cons? e) + (define fst (car e)) + (define rst (cdr e)) + (cond + [(syntax? fst) + (add-id&init&sub-range-binders fst) + (loop rst)] + [else (loop rst)])] + [(null? e) (void)] + [else (add-id&init&sub-range-binders stx)]))) ;; add-definition-target : syntax[(sequence of identifiers)] (listof symbol) -> void (define (add-definition-target stx mods phase-level) @@ -1448,15 +1463,16 @@ defs-text (syntax-position id) (syntax-span id)) - (let* ([pos-left (- (syntax-position id) 1)] - [pos-right (+ pos-left (syntax-span id))]) - (send defs-text syncheck:add-definition-target/phase-level+space - source - pos-left - pos-right - (list-ref ib 1) - (map submodule-name mods) - phase-level)))))) + (define pos-left (- (syntax-position id) 1)) + (define pos-right (+ pos-left (syntax-span id))) + (send defs-text + syncheck:add-definition-target/phase-level+space + source + pos-left + pos-right + (list-ref ib 1) + (map submodule-name mods) + phase-level))))) ;; annotate-raw-keyword : syntax id-map integer -> void ;; annotates keywords when they were never expanded. eg. diff --git a/drracket/repo-time-stamp/time-stamp.rkt b/drracket/repo-time-stamp/time-stamp.rkt index 3d486c5f8..0c6961457 100644 --- a/drracket/repo-time-stamp/time-stamp.rkt +++ b/drracket/repo-time-stamp/time-stamp.rkt @@ -1,5 +1,8 @@ #lang racket/base -(require drracket/tool racket/unit framework "stamp.rkt") +(require drracket/tool + framework + racket/unit + "stamp.rkt") (provide tool@) (define tool@ diff --git a/drracket/setup/plt-installer-unit.rkt b/drracket/setup/plt-installer-unit.rkt index a31eee5f8..76fad0c26 100644 --- a/drracket/setup/plt-installer-unit.rkt +++ b/drracket/setup/plt-installer-unit.rkt @@ -1,11 +1,11 @@ #lang racket/base -(require racket/unit - mred/mred-sig +(require mred/mred-sig + mrlib/terminal racket/class - "plt-installer-sig.rkt" + racket/unit + string-constants (prefix-in single: setup/plt-single-installer) - mrlib/terminal - string-constants) + "plt-installer-sig.rkt") (provide plt-installer@) (define-unit plt-installer@ @@ -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)))