Update all my elpa files

elpa/racket-mode-20180401.1803/cmds.rkt

@@ -0,0 +1,832 @@
+#lang at-exp racket/base
+
+(require macro-debugger/analysis/check-requires
+         racket/contract/base
+         racket/contract/region
+         racket/format
+         racket/function
+         racket/list
+         racket/match
+         racket/path
+         racket/port
+         racket/pretty
+         racket/set
+         racket/string
+         racket/tcp
+         syntax/modresolve
+         (only-in xml xexpr->string)
+         "channel.rkt"
+         "defn.rkt"
+         "fresh-line.rkt"
+         "help.rkt"
+         "instrument.rkt"
+         "mod.rkt"
+         "scribble.rkt"
+         "try-catch.rkt"
+         "util.rkt")
+
+(provide start-command-server
+         attach-command-server
+         make-prompt-read
+         display-prompt)
+
+(module+ test
+  (require rackunit))
+
+;; Emacs Lisp needs to send us commands and get responses.
+;;
+;; There are a few ways to do this.
+;;
+;; 0. Vanilla "inferior-mode" stdin/stdout. Commands are sent to stdin
+;;    -- "typed invisibly at the REPL prompt" -- and responses go to
+;;    stdout. Mixing command I/O with the user's Racket program I/O
+;;    works better than you might expect -- but worse than you want.
+;;
+;;    Unmixing output is the biggest challenge. Traditionally a comint
+;;    filter proc will try to extract everything up to a sentinel like
+;;    the next REPL prompt. But it can accidentally match user program
+;;    output that resembles the sentinel. (Real example: The ,describe
+;;    command returns HTML that happens to contain `\ntag>`.)
+;;
+;;    Input is also a problem. If the user's program reads from stdin,
+;;    it might eat a command. Or if it runs for awhile; commands are
+;;    blocked.
+;;
+;;    TL;DR: Command traffic should be out of band not mixed in stdin
+;;    and stdout.
+;;
+;; 1. Use files. Originally I addressed the mixed-output side by
+;;    having commands output responses to a file. (Stdout only
+;;    contains regular Racket output and appears directly in REPL
+;;    buffer as usual.) This didn't address mixed input. Although
+;;    using a command input file could have worked (and did work in
+;;    experiments), instead...
+;;
+;; 2. Use sockets. Now the status quo. Note that this is _not_ a
+;;    "network REPL". The socket server is solely for command input
+;;    and output. There is no redirection of user's Racket program
+;;    I/O, and it is still handled by Emacs' comint-mode in the usual
+;;    manner.
+
+(define command-server-ns (make-base-namespace))
+(define command-server-path #f)
+
+(define (attach-command-server ns path)
+  (set! command-server-ns ns)
+  (set! command-server-path path))
+
+(define (start-command-server port)
+  (void
+   (thread
+    (λ ()
+      (define listener (tcp-listen port 4 #t))
+      (let connect ()
+        (define-values (in out) (tcp-accept listener))
+        (parameterize ([current-input-port in]
+                       [current-output-port out])
+          (define fail (λ _ (elisp-println #f)))
+          (let loop ()
+            (match (read-syntax)
+              [(? eof-object?) (void)]
+              [stx (with-handlers ([exn:fail? fail])
+                     (parameterize ([current-namespace command-server-ns])
+                       (handle-command stx command-server-path fail)))
+                   (flush-output)
+                   (loop)])))
+        (close-input-port in)
+        (close-output-port out)
+        (connect))))))
+
+(define at-prompt (box 0))
+(define (at-prompt?) (positive? (unbox at-prompt)))
+
+(define/contract ((make-prompt-read m))
+  (-> (or/c #f mod?) (-> any))
+  (display-prompt (maybe-mod->prompt-string m))
+  (define in ((current-get-interaction-input-port)))
+  (define stx (dynamic-wind
+                (λ _ (box-swap! at-prompt add1))
+                (λ _ ((current-read-interaction) (object-name in) in))
+                (λ _ (box-swap! at-prompt sub1))))
+  (syntax-case stx ()
+    [(uq cmd)
+     (eq? 'unquote (syntax-e #'uq))
+     (begin (handle-command #'cmd m usage)
+            #'(void))] ;avoid Typed Racket printing a type
+    [_ stx]))
+
+(define (display-prompt str)
+  (flush-output (current-error-port))
+  (fresh-line)
+  (display str)
+  ;; Use a character unlikely to appear in normal output. Makes it
+  ;; easier for Emacs comint-regexp-prompt to avoid matching program
+  ;; output by mistake. (This used to be very important: We mixed
+  ;; command output with stdout and a comint filter proc had to un-mix
+  ;; it. Today it mainly just helps comint-{previous next}-prompt.)
+  (display #\uFEFF) ;ZERO WIDTH NON-BREAKING SPACE
+  (display "> ")
+  (flush-output)
+  (zero-column!))
+
+(define (elisp-read)
+  ;; Elisp prints '() as 'nil. Reverse that. (Assumption: Although
+  ;; some Elisp code puns nil/() also to mean "false" -- _our_ Elisp
+  ;; code _won't_ do that when sending us commands.)
+  (match (read)
+    ['nil '()]
+    [x x]))
+
+(define/contract (handle-command cmd-stx m unknown-command)
+  (-> syntax? (or/c #f mod?) (-> any) any)
+  (define-values (dir file mod-path) (maybe-mod->dir/file/rmp m))
+  (define path (and file (build-path dir file)))
+  (let ([read elisp-read])
+    (case (syntax-e cmd-stx)
+      ;; These commands are intended to be used by either the user or
+      ;; racket-mode.
+      [(run)             (run-or-top 'run)]
+      [(top)             (run-or-top 'top)]
+      [(doc)             (doc (read-syntax))]
+      [(exp)             (exp1 (read))]
+      [(exp+)            (exp+)]
+      [(exp!)            (exp! (read))]
+      [(pwd)             (display-commented (~v (current-directory)))]
+      [(cd)              (cd (~a (read)))]
+      [(exit)            (exit)]
+      [(info)            (info)]
+      ;; These remaining commands are intended to be used by
+      ;; racket-mode, only.
+      [(path)            (elisp-println path)]
+      [(prompt)          (elisp-println (and (at-prompt?) (or path 'top)))]
+      [(syms)            (syms)]
+      [(def)             (def-loc (read))]
+      [(describe)        (describe (read-syntax))]
+      [(mod)             (mod-loc (read) mod-path)]
+      [(type)            (type (read))]
+      [(requires/tidy)   (requires/tidy (read))]
+      [(requires/trim)   (requires/trim (read) (read))]
+      [(requires/base)   (requires/base (read) (read))]
+      [(find-collection) (find-collection (read))]
+      [(get-profile)     (get-profile)]
+      [(get-uncovered)   (get-uncovered path)]
+      [(check-syntax)    (check-syntax (string->path (read)))]
+      ;; Obsolete
+      [(log)             (display-commented "Use M-x racket-logger instead")]
+      [else              (unknown-command)])))
+
+(define (usage)
+  (display-commented
+   @~a{Commands:
+       ,run <module> [<mem-limit-MB> [<pretty-print?> [<error-context> [<cmd-line>]]]]
+       ,top          [<mem-limit-MB> [<pretty-print?> [<error-context> [<cmd-line>]]]]
+         <module> = <file>
+                  | (<file> <submodule-id> ...)
+         <file> = file.rkt
+                | /path/to/file.rkt
+                | "file.rkt" | "/path/to/file.rkt"
+         <error-context> = low
+                         | medium
+                         | high
+         <cmd-line> = (listof string?) e.g. '("-f" "foo" "--bar" "baz")
+       ,exit
+       ,doc <identifier>|<string>
+       ,exp <stx>
+       ,exp+
+       ,exp! <stx>
+       ,pwd
+       ,cd <path>}))
+
+;;; run, top, info
+
+;; Parameter-like interface, but we don't want thread-local. We do
+;; want to call collect-garbage IFF the new limit is less than the old
+;; one or less than the current actual usage.
+(define current-mem
+  (let ([old 0])
+    (case-lambda
+      [() old]
+      [(new)
+       (and old new
+            (or (< new old)
+                (< (* new 1024 1024) (current-memory-use)))
+            (collect-garbage))
+       (set! old new)])))
+
+;; Likewise: Want parameter signature but NOT thread-local.
+(define-syntax-rule (make-parameter-ish init)
+  (let ([old init])
+    (case-lambda
+      [() old]
+      [(new) (set! old new)])))
+
+(define current-pp? (make-parameter-ish #t))
+(define current-ctx-lvl (make-parameter-ish 'low)) ;context-level?
+(define current-args (make-parameter-ish (vector)))
+
+(define (run-or-top which)
+  ;; Support both the ,run and ,top commands. Latter has no first path
+  ;; arg, but otherwise they share subsequent optional args. (Note:
+  ;; The complexity here is from the desire to let user type simply
+  ;; e.g. ",top" or ",run file" and use the existing values for the
+  ;; omitted args. We're intended mainly to be used from Emacs, which
+  ;; can/does always supply all the args. But, may as well make it
+  ;; convenient for human users, too.)
+  (define (go what)
+    (define maybe-mod (->mod/existing what))
+    (when (or maybe-mod (eq? 'top which))
+      (put/stop (rerun maybe-mod
+                       (current-mem)
+                       (current-pp?)
+                       (current-ctx-lvl)
+                       (current-args)))))
+  (match (match which
+           ['run (read-line->reads)]
+           ['top (cons #f (read-line->reads))]) ;i.e. what = #f
+    [(list what (? number? mem) (? boolean? pp?) (? context-level? ctx)
+           (? (or/c #f (listof string?)) args))
+     (current-mem mem)
+     (current-pp? pp?)
+     (current-ctx-lvl ctx)
+     (current-args (list->vector (or args (list)))) ;Elisp () = nil => #f
+     (go what)]
+    [(list what (? number? mem) (? boolean? pp?) (? context-level? ctx))
+     (current-mem mem)
+     (current-pp? pp?)
+     (current-ctx-lvl ctx)
+     (go what)]
+    [(list what (? number? mem) (? boolean? pp?))
+     (current-mem mem)
+     (current-pp? pp?)
+     (go what)]
+    [(list what (? number? mem))
+     (current-mem mem)
+     (go what)]
+    [(list what)
+     (go what)]
+    [_ (usage)]))
+
+(define (read-line->reads)
+  (reads-from-string (read-line)))
+
+(define (reads-from-string s)
+  (with-input-from-string s reads))
+
+(define (reads)
+  (match (read)
+    [(? eof-object?) (list)]
+    ['t              (cons #t (reads))] ;in case from elisp
+    ['nil            (cons #f (reads))] ;in case from elisp
+    [x               (cons x (reads))]))
+
+;; This really just for my own use debugging. Not documented.
+(define (info)
+  (displayln @~a{Memory Limit:   @(current-mem)
+                 Pretty Print:   @(current-pp?)
+                 Error Context:  @(current-ctx-lvl)
+                 Command Line:   @(current-args)}))
+
+;;; misc other commands
+
+(define (syms)
+  (elisp-println (sort (map symbol->string (namespace-mapped-symbols))
+                       string<?)))
+
+(define (def-loc sym)
+  (elisp-println (find-definition (symbol->string sym))))
+
+(define (mod-loc v rel)
+  (define (mod-loc* mod rel)
+    (define path (with-handlers ([exn:fail? (λ _ #f)])
+                   (resolve-module-path mod rel)))
+    (and path
+         (file-exists? path)
+         (list (path->string path) 1 0)))
+  (elisp-println (cond [(module-path? v) (mod-loc* v rel)]
+                       [(symbol? v)      (mod-loc* (symbol->string v) rel)]
+                       [else             #f])))
+
+(define (type v) ;; the ,type command.  rename this??
+  (elisp-println (type-or-sig v)))
+
+(define (type-or-sig v)
+  (or (type-or-contract v)
+      (sig v)
+      ""))
+
+(define (sig v) ;any/c -> (or/c #f string?)
+  (and (symbol? v)
+       (match (find-signature (symbol->string v))
+         [#f #f]
+         [x (~a x)])))
+
+(define (type-or-contract v) ;any/c -> (or/c #f string?)
+  ;; 1. Try using Typed Racket's REPL simplified type.
+  (try (match (with-output-to-string
+                (λ ()
+                  ((current-eval)
+                   (cons '#%top-interaction v))))
+         [(pregexp "^- : (.*) \\.\\.\\..*\n" (list _ t)) t]
+         [(pregexp "^- : (.*)\n$"            (list _ t)) t])
+       #:catch exn:fail? _
+       ;; 2. Try to find a contract.
+       (try (parameterize ([error-display-handler (λ _ (void))])
+              ((current-eval)
+               (cons '#%top-interaction
+                     `(if (has-contract? ,v)
+                       (~a (contract-name (value-contract ,v)))
+                       (error "")))))
+            #:catch exn:fail? _
+            #f)))
+
+(define (sig-and/or-type stx)
+  (define dat (syntax->datum stx))
+  (define s (sig dat))
+  (define t (type-or-contract stx))
+  (xexpr->string
+   `(div ()
+     (h1 () ,(or s (~a dat)))
+     ,(cond [(not (or s t))
+             `(p ()
+               (em ()  "(Found no documentation, signature, type, or contract.)"))]
+            [t `(pre () ,t)]
+            [else ""])
+     (br ()))))
+
+;;; describe
+
+;; If a symbol has installed documentation, display it.
+;;
+;; Otherwise, walk the source to find the signature of its definition
+;; (because the argument names have explanatory value), and also look
+;; for Typed Racket type or a contract, if any.
+
+(define (describe stx)
+  (write (describe* stx))
+  (newline))
+
+(define (describe* _stx)
+  (define stx (namespace-syntax-introduce _stx))
+  (or (scribble-doc/html stx)
+      (sig-and/or-type stx)))
+
+;;; print elisp values
+
+(define (elisp-println v)
+  (elisp-print v)
+  (newline))
+
+(define (elisp-print v)
+  (print (->elisp v)))
+
+(define (->elisp v)
+  (match v
+    [(or #f (list)) 'nil]
+    [#t             't]
+    [(? list? xs)   (map ->elisp xs)]
+    [(cons x y)     (cons (->elisp x) (->elisp y))]
+    [(? path? v)    (path->string v)]
+    [v              v]))
+
+(module+ test
+  (check-equal? (with-output-to-string
+                  (λ () (elisp-print '(1 #t nil () (a . b)))))
+                "'(1 t nil nil (a . b))"))
+
+;;; doc / help
+
+(define (doc stx)
+  (or (find-help (namespace-syntax-introduce stx))
+      (perform-search (~a (syntax->datum stx))))
+  ;; Need some command response
+  (elisp-println "Sent to web browser"))
+
+;; cd
+
+(define (cd s)
+  (let ([old-wd (current-directory)])
+    (current-directory s)
+    (unless (directory-exists? (current-directory))
+      (display-commented (format "~v doesn't exist." (current-directory)))
+      (current-directory old-wd))
+    (display-commented (format "In ~v" (current-directory)))))
+
+;;; syntax expansion
+
+(define last-stx #f)
+
+(define (exp1 stx)
+  (set! last-stx (expand-once stx))
+  (pp-stx last-stx))
+
+(define (exp+)
+  (when last-stx
+    (define this-stx (expand-once last-stx))
+    (cond [(equal? (syntax->datum last-stx) (syntax->datum this-stx))
+           (display-commented "Already fully expanded.")
+           (set! last-stx #f)]
+          [else
+           (pp-stx this-stx)
+           (set! last-stx this-stx)])))
+
+(define (exp! stx)
+  (set! last-stx #f)
+  (pp-stx (expand stx)))
+
+(define (pp-stx stx)
+  (newline)
+  (pretty-print (syntax->datum stx)
+                (current-output-port)
+                1))
+
+;;; requires
+
+;; requires/tidy : (listof require-sexpr) -> require-sexpr
+(define (requires/tidy reqs)
+  (let* ([reqs (combine-requires reqs)]
+         [reqs (group-requires reqs)])
+    (elisp-println (require-pretty-format reqs))))
+
+;; requires/trim : path-string? (listof require-sexpr) -> require-sexpr
+;;
+;; Note: Why pass in a list of the existing require forms -- why not
+;; just use the "keep" list from show-requires? Because the keep list
+;; only states the module name, not the original form. Therefore if
+;; the original require has a subform like `(only-in mod f)` (or
+;; rename-in, except-in, &c), we won't know how to preserve that
+;; unless we're given it. That's why our strategy must be to look for
+;; things to drop, as opposed to things to keep.
+(define (requires/trim path-str reqs)
+  (let* ([reqs (combine-requires reqs)]
+         [sr (show-requires* path-str)]
+         [drops (filter-map (λ (x)
+                              (match x
+                                [(list 'drop mod lvl) (list mod lvl)]
+                                [_ #f]))
+                            sr)]
+         [reqs (filter-map (λ (req)
+                             (cond [(member req drops) #f]
+                                   [else req]))
+                           reqs)]
+         [reqs (group-requires reqs)])
+    (elisp-println (require-pretty-format reqs))))
+
+;; Use `bypass` to help convert from `#lang racket` to `#lang
+;; racket/base` plus explicit requires.
+;;
+;; Note: Currently this is hardcoded to `#lang racket`, only.
+(define (requires/base path-str reqs)
+  (let* ([reqs (combine-requires reqs)]
+         [sr (show-requires* path-str)]
+         [drops (filter-map (λ (x)
+                              (match x
+                                [(list 'drop mod lvl) (list mod lvl)]
+                                [_ #f]))
+                            sr)]
+         [adds (append*
+                (filter-map (λ (x)
+                              (match x
+                                [(list 'bypass 'racket 0
+                                       (list (list mod lvl _) ...))
+                                 (filter (λ (x)
+                                           (match x
+                                             [(list 'racket/base 0) #f]
+                                             [_ #t]))
+                                         (map list mod lvl))]
+                                [_ #f]))
+                            sr))]
+         [reqs (filter-map (λ (req)
+                             (cond [(member req drops) #f]
+                                   [else req]))
+                           reqs)]
+         [reqs (append reqs adds)]
+         [reqs (group-requires reqs)])
+    (elisp-println (require-pretty-format reqs))))
+
+;; show-requires* : Like show-requires but accepts a path-string? that
+;; need not already be a module path.
+(define (show-requires* path-str)
+  (define-values (base name _) (split-path (string->path path-str)))
+  (parameterize ([current-load-relative-directory base]
+                 [current-directory base])
+    (show-requires name)))
+
+(define (combine-requires reqs)
+  (remove-duplicates
+   (append* (for/list ([req reqs])
+              (match req
+                [(list* 'require vs)
+                 (append*
+                  (for/list ([v vs])
+                    ;; Use (list mod level), like `show-requires` uses.
+                    (match v
+                      [(list* 'for-meta level vs) (map (curryr list level) vs)]
+                      [(list* 'for-syntax vs)     (map (curryr list 1) vs)]
+                      [(list* 'for-template vs)   (map (curryr list -1) vs)]
+                      [(list* 'for-label vs)      (map (curryr list #f) vs)]
+                      [v                          (list (list v 0))])))])))))
+
+(module+ test
+  (require rackunit)
+  (check-equal?
+   (combine-requires '((require a b c)
+                       (require d e)
+                       (require a f)
+                       (require (for-syntax s t u) (for-label l0 l1 l2))
+                       (require (for-meta 1 m1a m1b)
+                                (for-meta 2 m2a m2b))))
+   '((a 0) (b 0) (c 0) (d 0) (e 0) (f 0)
+     (s 1) (t 1) (u 1)
+     (l0 #f) (l1 #f) (l2 #f)
+     (m1a 1) (m1b 1) (m2a 2) (m2b 2))))
+
+;; Given a list of requires -- each in the (list module level) form
+;; used by `show-requires` -- group them by level and convert them to
+;; a Racket `require` form. Also, sort the subforms by phase level:
+;; for-syntax, for-template, for-label, for-meta, and plain (0).
+;; Within each such group, sort them first by module paths then
+;; relative requires. Within each such group, sort alphabetically.
+(define (group-requires reqs)
+  ;; Put the requires into a hash of sets.
+  (define ht (make-hasheq)) ;(hash/c <level> (set <mod>))
+  (for ([req reqs]) (match req
+                      [(list mod lvl) (hash-update! ht lvl
+                                                    (lambda (s) (set-add s mod))
+                                                    (set mod))]))
+  (define (mod-set->mod-list mod-set)
+    (sort (set->list mod-set) mod<?))
+  (define (for-level level k)
+    (define mods (hash-ref ht level #f))
+    (cond [mods (k (mod-set->mod-list mods))]
+          [else '()]))
+  (define (preface . pres)
+    (λ (mods) `((,@pres ,@mods))))
+  (define (meta-levels)
+    (sort (for/list ([x (hash-keys ht)] #:when (not (member x '(-1 0 1 #f)))) x)
+          <))
+  `(require
+    ,@(for-level  1 (preface 'for-syntax))
+    ,@(for-level -1 (preface 'for-template))
+    ,@(for-level #f (preface 'for-label))
+    ,@(append* (for/list ([level (in-list (meta-levels))])
+                 (for-level level (preface 'for-meta level))))
+    ,@(for-level 0 values)))
+
+(module+ test
+  (check-equal? (group-requires
+                 (combine-requires
+                  '((require z c b a)
+                    (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
+                  (for-syntax s0 s1)
+                  (for-template t0 t1)
+                  (for-label l0 l1)
+                  (for-meta -4 m-40 m-41)
+                  (for-meta 4 m40 m41)
+                  a b c (only-in mod oi) z
+                  "a.rkt" "b.rkt" "c.rkt" (only-in "mod.rkt" oi) "z.rkt")))
+
+(define (mod<? a b)
+  (define (key x)
+    (match x
+      [(list 'only-in   m _ ...)     (key m)]
+      [(list 'except-in m _ ...)     (key m)]
+      [(list 'prefix-in _ m)         (key m)]
+      [(list 'relative-in _ m _ ...) (key m)]
+      [m                             m]))
+  (let ([a (key a)]
+        [b (key b)])
+    (or (and (symbol? a) (not (symbol? b)))
+        (and (list? a) (not (list? b)))
+        (and (not (string? a)) (string? a))
+        (and (string? a) (string? b)
+             (string<? a b))
+        (and (symbol? a) (symbol? b)
+             (string<? (symbol->string a) (symbol->string b))))))
+
+(module+ test
+  (check-true (mod<? 'a 'b))
+  (check-false (mod<? 'b 'a))
+  (check-true (mod<? 'a '(only-in b)))
+  (check-true (mod<? '(only-in a) 'b))
+  (check-true (mod<? 'a '(except-in b)))
+  (check-true (mod<? '(except-in a) 'b))
+  (check-true (mod<? 'a '(prefix-in p 'b)))
+  (check-true (mod<? '(prefix-in p 'a) 'b))
+  (check-true (mod<? 'a '(relative-in p 'b)))
+  (check-true (mod<? '(relative-in p 'a) 'b))
+  (check-true (mod<? 'a '(prefix-in p (only-in b))))
+  (check-true (mod<? '(prefix-in p (only-in a)) 'b)))
+
+;; require-pretty-format : list? -> string?
+(define (require-pretty-format x)
+  (define out (open-output-string))
+  (parameterize ([current-output-port out])
+    (require-pretty-print x))
+  (get-output-string out))
+
+(module+ test
+  (check-equal? (require-pretty-format
+                 '(require a))
+                @~a{(require a)
+
+                    })
+  (check-equal? (require-pretty-format
+                 '(require a b))
+                @~a{(require a
+                             b)
+
+                    })
+  (check-equal? (require-pretty-format
+                 '(require (for-syntax a b) (for-meta 2 c d) e f))
+                @~a{(require (for-syntax a
+                                         b)
+                             (for-meta 2 c
+                                         d)
+                             e
+                             f)
+
+                    })
+  (check-equal? (require-pretty-format
+                 `(require (only-in m a b) (except-in m a b)))
+                @~a{(require (only-in m
+                                      a
+                                      b)
+                             (except-in m
+                                        a
+                                        b))
+
+                    }))
+
+;; Pretty print a require form with one module per line and with
+;; indentation for the `for-X` subforms. Example:
+;;
+;; (require (for-syntax racket/base
+;;                      syntax/parse)
+;;          (for-meta 3 racket/a
+;;                      racket/b)
+;;          racket/format
+;;          racket/string
+;;          "a.rkt"
+;;          "b.rkt")
+(define (require-pretty-print x)
+  (define (prn x first? indent)
+    (define (indent-string)
+      (if first? "" (make-string indent #\space)))
+    (define (prn-form pre this more)
+      (define new-indent (+ indent (+ 2 (string-length pre))))
+      (printf "~a(~a " (indent-string) pre)
+      (prn this #t new-indent)
+      (for ([x more])
+        (newline)
+        (prn x #f new-indent))
+      (display ")"))
+    (match x
+      [(list 'require)
+       (void)]
+      [(list* (and pre (or 'require 'for-syntax 'for-template 'for-label
+                           'only-in 'except-in))
+              this more)
+       (prn-form (format "~s" pre) this more)
+       (when (eq? pre 'require)
+         (newline))]
+      [(list* 'for-meta level this more)
+       (prn-form (format "for-meta ~a" level) this more)]
+      [this
+       (printf "~a~s" (indent-string) this)]))
+  (prn x #t 0))
+
+;;; find-collection
+
+(define (do-find-collection str)
+  (match (with-handlers ([exn:fail? (λ _ #f)])
+           (and ;;#f ;<-- un-comment to exercise fallback path
+            (dynamic-require 'find-collection/find-collection
+                             'find-collection-dir)))
+    [#f 'find-collection-not-installed]
+    [f  (map path->string (f str))]))
+
+(define find-collection (compose elisp-println do-find-collection))
+
+;;; profile
+
+(define (get-profile)
+  (elisp-println
+   ;; TODO: Filter files from racket-mode itself, b/c just noise?
+   (for/list ([x (in-list (get-profile-info))])
+     (match-define (list count msec name stx _ ...) x)
+     (list count
+           msec
+           (and name (symbol->string name))
+           (and (syntax-source stx) (path? (syntax-source stx))
+                (path->string (syntax-source stx)))
+           (syntax-position stx)
+           (and (syntax-position stx) (syntax-span stx)
+                (+ (syntax-position stx) (syntax-span stx)))))))
+
+;;; coverage
+
+(define (get-uncovered file)
+  (elisp-println
+   (consolidate-coverage-ranges
+    (for*/list ([x (in-list (get-test-coverage-info))]
+                [covered? (in-value (first x))]
+                #:when (not covered?)
+                [src (in-value (second x))]
+                #:when (equal? file src)
+                [pos (in-value (third x))]
+                [span (in-value (fourth x))])
+      (cons pos (+ pos span))))))
+
+(define (consolidate-coverage-ranges xs)
+  (remove-duplicates (sort xs < #:key car)
+                     same?))
+
+(define (same? x y)
+  ;; Is x a subset of y or vice versa?
+  (match-define (cons x/beg x/end) x)
+  (match-define (cons y/beg y/end) y)
+  (or (and (<= x/beg y/beg) (<= y/end x/end))
+      (and (<= y/beg x/beg) (<= x/end y/end))))
+
+(module+ test
+  (check-true (same? '(0 . 9) '(0 . 9)))
+  (check-true (same? '(0 . 9) '(4 . 5)))
+  (check-true (same? '(4 . 5) '(0 . 9)))
+  (check-false (same? '(0 . 1) '(1 . 2)))
+  (check-equal? (consolidate-coverage-ranges
+                 '((10 . 20) (10 . 11) (19 . 20) (10 . 20)
+                   (20 . 30) (20 . 21) (29 . 30) (20 . 30)))
+                '((10 . 20)
+                  (20 . 30)))
+  ;; This is a test of actual coverage data I got from one example,
+  ;; where the maximal subsets were (164 . 197) and (214. 247).
+  (check-equal?
+   (consolidate-coverage-ranges
+    '((164 . 197) (164 . 197) (164 . 197)
+      (173 . 180) (173 . 180) (173 . 180) (173 . 180) (173 . 180) (187 . 196)
+      (214 . 247) (214 . 247) (214 . 247)
+      (223 . 230) (223 . 230) (223 . 230) (223 . 230) (223 . 230) (237 . 246)))
+   '((164 . 197) (214 . 247))))
+
+;;; check-syntax
+
+(define check-syntax
+  (let ([show-content (try (let ([f (dynamic-require 'drracket/check-syntax
+                                                     'show-content)])
+                             ;; Ensure correct position info for
+                             ;; Unicode like λ. show-content probably
+                             ;; ought to do this itself, but work
+                             ;; around that.
+                             (λ (path)
+                               (parameterize ([port-count-lines-enabled #t])
+                                 (f path))))
+                           #:catch exn:fail? _ (λ _ (elisp-println 'not-supported)))])
+    ;; Note: Adjust all positions to 1-based Emacs `point' values.
+    (λ (path)
+      (parameterize ([current-load-relative-directory (path-only path)])
+        ;; Get all the data.
+        (define xs (remove-duplicates (show-content path)))
+        ;; Extract the add-mouse-over-status items into a list.
+        (define infos
+          (remove-duplicates
+           (filter values
+                   (for/list ([x (in-list xs)])
+                     (match x
+                       [(vector 'syncheck:add-mouse-over-status beg end str)
+                        (list 'info (add1 beg) (add1 end) str)]
+                       [_ #f])))))
+        ;; Consolidate the add-arrow/name-dup items into a hash table
+        ;; with one item per definition. The key is the definition
+        ;; position. The value is the set of its uses.
+        (define ht-defs/uses (make-hash))
+        (for ([x (in-list xs)])
+          (match x
+            [(or (vector 'syncheck:add-arrow/name-dup
+                         def-beg def-end
+                         use-beg use-end
+                         _ _ _ _)
+                 (vector 'syncheck:add-arrow/name-dup/pxpy
+                         def-beg def-end _ _
+                         use-beg use-end _ _
+                         _ _ _ _))
+             (hash-update! ht-defs/uses
+                           (list (add1 def-beg) (add1 def-end))
+                           (λ (v) (set-add v (list (add1 use-beg) (add1 use-end))))
+                           (set))]
+            [_ #f]))
+        ;; Convert the hash table into a list, sorting the usage positions.
+        (define defs/uses
+          (for/list ([(def uses) (in-hash ht-defs/uses)])
+            (match-define (list def-beg def-end) def)
+            (define tweaked-uses (sort (set->list uses) < #:key car))
+            (list 'def/uses def-beg def-end tweaked-uses)))
+        ;; Append both lists and print as Elisp values.
+        (elisp-println (append infos defs/uses))))))