Skip to content

Commit

Permalink
Handle insertion of require when no old requires
Browse files Browse the repository at this point in the history 
This can arise with requires/base, when a file module using #lang
racket had no explicit requires, but now we add one when changing to
  • Loading branch information
@greghendershott
greghendershott committed Jan 7, 2025
1 parent 0bde2db commit 5ddb44d
Show file tree
Hide file tree
Showing 2 changed files with 76 additions and 52 deletions.
14 changes: 11 additions & 3 deletions racket-edit.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -156,15 +156,16 @@ typed/racket/base\"."
(defun racket--require-changes (changes)
"Process response from back end tidy/trim/base commands.
Each change is either a deletion or a replacement.
Each change is either a deletion, a replacement, or an insertion.
The changes are sorted from greater to smaller positions -- so
that by working backwards through the buffer, we need not worry
about shifting positions of later items.
The biggest wrinkle here is that, for esthetics, we want to
remove surrounding whitepsace when deleting. Otherwise, for
replacing, it suffices to make the change and re-indent."
remove surrounding whitepsace when deleting, or add when
inserting something brand-new. Otherwise, for replacing, it
suffices to make the change and re-indent."
(save-match-data
(dolist (change changes)
(pcase change
Expand All @@ -182,6 +183,13 @@ replacing, it suffices to make the change and re-indent."
(save-excursion
(goto-char pos)
(insert str)
(indent-region pos (point))))
(`(insert ,pos ,str)
(save-excursion
(goto-char pos)
(newline-and-indent)
(insert str)
(newline-and-indent)
(indent-region pos (point))))))))

(defun racket--submodule-y-or-n-p ()
Expand Down
114 changes: 65 additions & 49 deletions racket/commands/requires.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -432,7 +432,7 @@
#:attr phase 0
#:with specs #'(spec)))

(define (tidy reqs #:adds [adds null] #:drops [drops null])
(define (tidy-module reqs #:adds [adds null] #:drops [drops null])
(define ht (make-hash)) ;phase-level => "top-level" req specs
(define (add! v)
(hash-update! ht
Expand Down Expand Up @@ -491,27 +491,28 @@
,@(for-level 0 values)))

(module+ test
(check-equal? (tidy #:drops (list (cons 'racket/string 0)
(cons 'bar/b 0))
'((require z c b a)
(require racket/require)
(require (multi-in mi-z (mi-z0 mi-z1)))
(require (multi-in mi-a (mi-a1 mi-a0)))
(require (multi-in baz (a b)))
(require (multi-in racket (format string match)))
(require (multi-in racket string)) ;disappears
(require (multi-in racket list)) ;=> racket/list
(require (multi-in "dir" "file.rkt")) ;=> "dir/file.rkt"
(require (multi-in (foo bar) (a b c)))
(require (for-meta 4 m41 m40))
(require (for-meta -4 m-41 m-40))
(require (for-label l1 l0))
(require (for-template t1 t0))
(require (for-syntax s1 s0))
(require
"a.rkt" "b.rkt" "c.rkt" "z.rkt"
(only-in "mod.rkt" oi)
(only-in mod oi))))
(check-equal? (tidy-module
#:drops (list (cons 'racket/string 0)
(cons 'bar/b 0))
'((require z c b a)
(require racket/require)
(require (multi-in mi-z (mi-z0 mi-z1)))
(require (multi-in mi-a (mi-a1 mi-a0)))
(require (multi-in baz (a b)))
(require (multi-in racket (format string match)))
(require (multi-in racket string)) ;disappears
(require (multi-in racket list)) ;=> racket/list
(require (multi-in "dir" "file.rkt")) ;=> "dir/file.rkt"
(require (multi-in (foo bar) (a b c)))
(require (for-meta 4 m41 m40))
(require (for-meta -4 m-41 m-40))
(require (for-label l1 l0))
(require (for-template t1 t0))
(require (for-syntax s1 s0))
(require
"a.rkt" "b.rkt" "c.rkt" "z.rkt"
(only-in "mod.rkt" oi)
(only-in mod oi))))
'(require
racket/require
(for-syntax s0 s1)
Expand All @@ -537,6 +538,8 @@
(only-in "mod.rkt" oi)
"z.rkt")))

;;; tidy-file

;; Per each module (file root-module or submodule)
(define current-module-old-requires (make-parameter null))

Expand All @@ -545,17 +548,19 @@
(struct insert (pos str) #:transparent)
(define current-file-changes (make-parameter null))

;; cons a new value onto a list-valued parameter
(define (push-param p v)
(p (cons v (p))))

(define-syntax-class require-statement
#:datum-literals (require)
(pattern (require _:phased-require-spec ...)
#:do
[(current-module-old-requires
(cons this-syntax
(current-module-old-requires)))
(current-file-changes
(cons (delete (syntax-position this-syntax)
(syntax-span this-syntax))
(current-file-changes)))]))
[(push-param current-module-old-requires
this-syntax)
(push-param current-file-changes
(delete (syntax-position this-syntax)
(syntax-span this-syntax)))]))

(define-syntax-class module-level
(pattern _:require-statement)
Expand All @@ -572,14 +577,19 @@
(olds->new)]))]))

(define-syntax-class root-module
#:attributes (after-lang-position)
#:datum-literals (module #%module-begin)
(pattern (module _mod _lang (#%module-begin _:module-level ...))))
(pattern (module _mod lang (#%module-begin _:module-level ...))
#:attr after-lang-position (+ (syntax-position #'lang)
(syntax-span #'lang))))

(define (tidy-file path-str #:adds [adds null] #:drops [drops null])
(define stx (file->syntax path-str))
(syntax-parse stx
[_:root-module
(olds->new #:adds adds #:drops drops)
[rm:root-module
(olds->new #:adds adds
#:drops drops
#:after-lang-position (attribute rm.after-lang-position))
;; Sort in reverse position, with deletes sorting before inserts
;; at the same position.
(define changes (sort (current-file-changes)
Expand All @@ -588,29 +598,35 @@
[(delete pos _) (+ pos 0.5)])
>))
;; Return a list of changes, where delete/insert at same position
;; are consolidated into (list 'replace pos span str). There
;; should be no other inserts. The remaining deletes are
;; converted to (list 'delete pos span).
;; are consolidated into (list 'replace pos span str). The
;; remaining changes are converted to (list 'delete pos span) or
;; (list 'insert pos str).
(let loop ([changes changes])
(match changes
[(list) (list)]
[(list* (delete pos span) (insert pos str) more)
(cons (list 'replace pos span str) (loop more))]
[(cons (delete pos span) more)
(cons (list 'delete pos span) (loop more))]))]))

(define (olds->new #:adds [adds null] #:drops [drops null])
(unless (null? (current-module-old-requires))
(current-file-changes
(cons (insert (syntax-position (argmin syntax-position
(current-module-old-requires)))
(require-pretty-format
(tidy (sort (current-module-old-requires)
#:key syntax-position
<)
#:adds adds
#:drops drops)))
(current-file-changes)))))
(cons (list 'delete pos span) (loop more))]
[(cons (insert pos str) more)
(cons (list 'insert pos str) (loop more))]))]))

(define (olds->new #:adds [adds null]
#:drops [drops null]
#:after-lang-position [after-lang-position 1])
(define olds (current-module-old-requires))
(define new (tidy-module (sort olds
#:key syntax-position
<)
#:adds adds
#:drops drops))
(unless (equal? new '(require))
(define pos (if (null? olds)
(add1 after-lang-position)
(syntax-position (argmin syntax-position olds))))
(push-param current-file-changes
(insert pos
(require-pretty-format new)))))

(module+ tidy-file-example
(define path-str "/home/greg/src/racket/examples/module.rkt")
Expand Down

0 comments on commit 5ddb44d

Please sign in to comment.