diff --git a/racket-edit.el b/racket-edit.el index 4844a299..520c0b2d 100644 --- a/racket-edit.el +++ b/racket-edit.el @@ -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 @@ -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 () diff --git a/racket/commands/requires.rkt b/racket/commands/requires.rkt index b58c90be..bc8951ee 100644 --- a/racket/commands/requires.rkt +++ b/racket/commands/requires.rkt @@ -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 @@ -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) @@ -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)) @@ -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) @@ -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) @@ -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")