Skip to content
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.

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

Automated Resyntax fixes #705

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
40 changes: 20 additions & 20 deletions drracket-test/tests/drracket/gui-debugger/harness.rkt
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
#lang racket
(require gui-debugger/annotator gui-debugger/load-sandbox syntax/parse
gui-debugger/marks)
(require gui-debugger/annotator
gui-debugger/load-sandbox
gui-debugger/marks
syntax/parse)
(provide run-code-with-annotator break/test)

;; Syntax -> Any
Expand All @@ -20,24 +22,22 @@
(eval `(require ',(syntax->datum #'name)))]
[_ (void)])))

(define the-annotator
(lambda (stx)
(define source (syntax-source stx))
(define-values (annotated break-posns)
(annotate-for-single-stepping
(expand-syntax stx)
; always trigger breaks
(const (const #t))
; don't interpose on returned values
(const #f)
; if we are not in tail position don't interpose on returned values
(lambda (_ __ . vals) (apply values vals))
; record-bound-identifier (do nothing at annotation time)
void
; record-top-level-identifier (do nothing at runtime)
void
source))
annotated))
(define (the-annotator stx)
(define source (syntax-source stx))
(define-values (annotated break-posns)
(annotate-for-single-stepping (expand-syntax stx)
; always trigger breaks
(const (const #t))
; don't interpose on returned values
(const #f)
; if we are not in tail position don't interpose on returned values
(lambda (_ __ . vals) (apply values vals))
; record-bound-identifier (do nothing at annotation time)
void
; record-top-level-identifier (do nothing at runtime)
void
source))
annotated)

(define ((break/test id) [marks #f])
(define debug-marks
Expand Down
6 changes: 3 additions & 3 deletions drracket-test/tests/drracket/gui-debugger/in-drr.rkt
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
#lang racket
(require "../private/drracket-test-util.rkt"
(require racket/gui/base
rackunit
(prefix-in fw: framework)
racket/gui/base
rackunit)
"../private/drracket-test-util.rkt")

(define (start-debugger-and-run-to-completion drr)
(define debug-button
Expand Down
127 changes: 65 additions & 62 deletions drracket-tool-lib/drracket/private/standalone-module-browser.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -412,13 +412,13 @@
;; note: the preference drracket:module-browser:name-length is also used for
;; the View|Show Module Browser version of the module browser
;; here we just treat any pref value except '3' as if it were for the long names.
(let ([selection (send module-browser-name-length-choice get-selection)])
(preferences:set 'drracket:module-browser:name-length (+ 2 selection))
(send pasteboard
set-name-length
(case selection
[(0) 'long]
[(1) 'very-long])))))))
(define selection (send module-browser-name-length-choice get-selection))
(preferences:set 'drracket:module-browser:name-length (+ 2 selection))
(send pasteboard
set-name-length
(case selection
[(0) 'long]
[(1) 'very-long]))))))
(send pkg-choice set-string-selection (send pasteboard get-main-file-pkg))

(define ec (make-object overview-editor-canvas% vp pasteboard))
Expand Down Expand Up @@ -461,17 +461,18 @@

(set! update-label
(λ (s)
(if (and s (not (null? s)))
(let* ([currently-over (car s)]
[fn (send currently-over get-filename)]
[lines (send currently-over get-lines)])
(when (and fn lines)
(define label (format filename-constant fn lines))
(define pkg (send currently-over get-pkg))
(when pkg
(set! label (string-append (format pkg-constant pkg) " " label)))
(send label-message set-label label)))
(send label-message set-label ""))))
(cond
[(and s (not (null? s)))
(define currently-over (car s))
(define fn (send currently-over get-filename))
(define lines (send currently-over get-lines))
(when (and fn lines)
(define label (format filename-constant fn lines))
(define pkg (send currently-over get-pkg))
(when pkg
(set! label (string-append (format pkg-constant pkg) " " label)))
(send label-message set-label label))]
[else (send label-message set-label "")])))

(send pasteboard
set-name-length
Expand Down Expand Up @@ -937,7 +938,7 @@
(call-with-input-file filename
(λ (port)
(let loop ([n 0])
(define l (read-line port))
(define l (read-line port 'any))
(if (eof-object? l)
n
(loop (+ n 1)))))
Expand Down Expand Up @@ -1059,24 +1060,25 @@
(let loop ([snips this-level-snips]
[minor-dim (/ (- max-minor this-minor) 2)])
(unless (null? snips)
(let* ([snip (car snips)]
[new-major-coord (+ major-dim
(floor (- (/ this-major 2)
(/ (if vertical?
(get-snip-height snip)
(get-snip-width snip))
2))))])
(if vertical?
(move-to snip minor-dim new-major-coord)
(move-to snip new-major-coord minor-dim))
(loop (cdr snips)
(+ minor-dim
(if vertical?
(get-snip-hspace)
(get-snip-vspace))
(if vertical?
(get-snip-width snip)
(get-snip-height snip)))))))
(define snip (car snips))
(define new-major-coord
(+ major-dim
(floor (- (/ this-major 2)
(/ (if vertical?
(get-snip-height snip)
(get-snip-width snip))
2)))))
(if vertical?
(move-to snip minor-dim new-major-coord)
(move-to snip new-major-coord minor-dim))
(loop (cdr snips)
(+ minor-dim
(if vertical?
(get-snip-hspace)
(get-snip-vspace))
(if vertical?
(get-snip-width snip)
(get-snip-height snip))))))
(loop (cdr levels)
(+ major-dim
(if vertical?
Expand Down Expand Up @@ -1119,8 +1121,8 @@
(let loop ([snip (find-first-snip)])
(when snip
(when (is-a? snip boxed-word-snip<%>)
(let ([filename (send snip get-filename)])
(on-boxed-word-double-click filename)))
(define filename (send snip get-filename))
(on-boxed-word-double-click filename))
(loop (send snip next)))))])
(send canvas popup-menu right-button-menu (+ (send evt get-x) 1) (+ (send evt get-y) 1))]
[else (super on-event evt)]))
Expand Down Expand Up @@ -1256,19 +1258,20 @@
""
(string (string-ref word 0)))]
[(medium)
(let ([m (regexp-match #rx"^(.*)\\.[^.]*$" word)])
(let ([short-name (if m
(cadr m)
word)])
(if (string=? short-name "")
""
(let ([ms (regexp-match* #rx"-[^-]*" short-name)])
(cond
[(null? ms) (substring short-name 0 (min 2 (string-length short-name)))]
[else
(apply string-append
(cons (substring short-name 0 1)
(map (λ (x) (substring x 1 2)) ms)))])))))]
(define m (regexp-match #rx"^(.*)\\.[^.]*$" word))
(define short-name
(if m
(cadr m)
word))
(if (string=? short-name "")
""
(let ([ms (regexp-match* #rx"-[^-]*" short-name)])
(cond
[(null? ms) (substring short-name 0 (min 2 (string-length short-name)))]
[else
(apply string-append
(cons (substring short-name 0 1)
(map (λ (x) (substring x 1 2)) ms)))])))]
[(long) word]
[(very-long) (string-append word ": " (format "~s" require-phases))]))
last-name]))
Expand Down Expand Up @@ -1345,16 +1348,16 @@
(λ ()
(moddep-current-open-input-file
(λ (filename)
(let* ([p (open-input-file filename)]
[wxme? (regexp-match-peek #rx#"^WXME" p)])
(if wxme?
(let ([t (new text%)])
(close-input-port p)
(send t load-file filename)
(let ([prt (open-input-text-editor t)])
(port-count-lines! prt)
prt))
p))))
(define p (open-input-file filename))
(define wxme? (regexp-match-peek #rx#"^WXME" p))
(if wxme?
(let ([t (new text%)])
(close-input-port p)
(send t load-file filename)
(let ([prt (open-input-text-editor t)])
(port-count-lines! prt)
prt))
p)))
(current-load-relative-directory #f)
(define relative? (eq? init-dir 'relative))
(unless relative? ; already there
Expand Down
8 changes: 4 additions & 4 deletions drracket-tool-text-lib/drracket/check-syntax.rkt
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
#lang racket/base
(require racket/contract
racket/class
(require racket/class
racket/contract
racket/path
syntax/modread
"private/syncheck/traversals.rkt"
"private/syncheck/syncheck-intf.rkt"
"private/syncheck/syncheck-local-member-names.rkt")
"private/syncheck/syncheck-local-member-names.rkt"
"private/syncheck/traversals.rkt")

(provide
(contract-out
Expand Down
59 changes: 28 additions & 31 deletions drracket-tool-text-lib/drracket/find-module-path-completions.rkt
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
#lang racket/base

(require racket/contract/base
racket/system
racket/port
(require compiler/module-suffix
pkg/lib
racket/contract
racket/contract/base
racket/list
pkg/lib
compiler/module-suffix)
racket/port
racket/system)

(define current-library-collection-links-info/c
(listof (or/c #f
Expand Down Expand Up @@ -182,20 +182,20 @@
(and (regexp? (list-ref link-ent 2))
(regexp-match (list-ref link-ent 2) (version)))
#t))
`(,(list-ref link-ent 0)
,(simplify-path
(let* ([encoded-path (list-ref link-ent 1)]
[path (cond
[(string? encoded-path) encoded-path]
[(bytes? encoded-path) (bytes->path encoded-path)]
[else (apply build-path
(for/list ([elem (in-list encoded-path)])
(if (bytes? elem)
(bytes->path-element elem)
elem)))])])
(if (relative-path? path)
(build-path base path)
path)))))]
(list (list-ref link-ent 0)
(simplify-path (let* ([encoded-path (list-ref link-ent 1)]
[path (cond
[(string? encoded-path) encoded-path]
[(bytes? encoded-path) (bytes->path encoded-path)]
[else
(apply build-path
(for/list ([elem (in-list encoded-path)])
(if (bytes? elem)
(bytes->path-element elem)
elem)))])])
(if (relative-path? path)
(build-path base path)
path)))))]
[else '()])]
[else
(for/list ([clp (in-list library-collection-paths)])
Expand All @@ -207,15 +207,12 @@
(for/list ([just-one (in-list link-content)])
(define-values (what pth) (apply values just-one))
(cond
[(string? what)
(list just-one)]
[else
(cond
[(safe-directory-exists? pth)
(for/list ([dir (in-list (safe-directory-list pth))]
#:when (safe-directory-exists? (build-path pth dir)))
(list (path->string dir) (build-path pth dir)))]
[else '()])])))))
[(string? what) (list just-one)]
[(safe-directory-exists? pth)
(for/list ([dir (in-list (safe-directory-list pth))]
#:when (safe-directory-exists? (build-path pth dir)))
(list (path->string dir) (build-path pth dir)))]
[else '()])))))

(define-syntax-rule (thunk-and-quote e)
(values (λ () e) 'e))
Expand Down Expand Up @@ -296,10 +293,10 @@
[else (use-current-racket 3)]))

(module+ test
(require rackunit
(require racket/contract
racket/list
racket/contract
racket/match)
racket/match
rackunit)

(define/contract find-completions/c
(-> string? (listof (list/c string? path?)) (-> path? (listof path?)) (-> path? boolean?)
Expand Down
Loading
Loading