Update packages

elpa/racket-mode-20181004.309/racket/channel.rkt

@@ -0,0 +1,72 @@
+#lang racket/base
+
+(require racket/contract
+         racket/match
+         racket/set
+         "mod.rkt")
+
+(provide message-to-main-thread-channel
+         (struct-out message-to-main-thread)
+         (struct-out load-gui)
+         (struct-out rerun)
+         rerun-default
+         context-level?
+         instrument-level?
+         profile/coverage-level?
+         debug-level?)
+
+
+;;; Definitions for the context-level member of rerun
+
+(define profile/coverage-levels
+  ;; "sibling" levels that need instrument plus...
+  '(profile    ;profiling-enabled
+    coverage)) ;execute-counts-enabled
+
+(define instrument-levels
+  `(high     ;compile-context-preservation-enabled #t + instrument
+    ,@profile/coverage-levels))
+
+(define context-levels
+  `(low      ;compile-context-preservation-enabled #f
+    medium   ;compile-context-preservation-enabled #t
+    ,@instrument-levels
+    debug))
+
+(define-syntax-rule (memq? x xs)
+  (and (memq x xs) #t))
+
+(define (context-level? v)          (memq? v context-levels))
+(define (instrument-level? v)       (memq? v instrument-levels))
+(define (profile/coverage-level? v) (memq? v profile/coverage-levels))
+(define (debug-level? v)            (eq? v 'debug))
+
+;;; Messages to the main thread via a channel
+
+(define message-to-main-thread-channel (make-channel))
+
+(define-struct/contract message-to-main-thread ())
+
+(define-struct/contract (load-gui message-to-main-thread)
+  ([in-repl? boolean?]))
+
+(define-struct/contract (rerun message-to-main-thread)
+  ([maybe-mod     (or/c #f mod?)]
+   [memory-limit  exact-nonnegative-integer?] ;0 = no limit
+   [pretty-print? boolean?]
+   [context-level context-level?]
+   ;; The following contract is the weaker `vector?` instead of
+   ;; `(vectorof string?)` because latter fails under Racket 6.0 and
+   ;; 6.1 when the value is accessed from the struct and passed to
+   ;; `current-command-line-arguments`. WAT.
+   [cmd-line-args vector?]
+   [debug-files   (set/c path?)]
+   [ready-thunk   (-> any/c)]))
+
+(define rerun-default (rerun #f
+                             0
+                             #f
+                             'low
+                             #()
+                             (set)
+                             void))

elpa/racket-mode-20181004.309/racket/command-server.rkt

@@ -0,0 +1,232 @@
+#lang racket/base
+
+(require racket/contract
+         racket/format
+         racket/function
+         racket/lazy-require
+         racket/match
+         racket/set
+         racket/tcp
+         "channel.rkt"
+         "debug.rkt"
+         "elisp.rkt"
+         "interactions.rkt"
+         "md5.rkt"
+         "mod.rkt"
+         "util.rkt")
+
+(lazy-require
+ ["commands/check-syntax.rkt" (check-syntax)]
+ ["commands/coverage.rkt"     (get-uncovered)]
+ ["commands/describe.rkt"     (describe type)]
+ ["commands/find-module.rkt"  (find-module)]
+ ["commands/help.rkt"         (doc)]
+ ["commands/macro.rkt"        (macro-stepper macro-stepper/next)]
+ ["commands/profile.rkt"      (get-profile)]
+ ["commands/requires.rkt"     (requires/tidy requires/trim requires/base)]
+ ["find.rkt"                 (find-definition)])
+
+(provide start-command-server
+         attach-command-server
+         make-prompt-read)
+
+(define drracket:submit-predicate/c (-> input-port? boolean? boolean?))
+
+(define-struct/contract context
+  ([ns          namespace?]
+   [maybe-mod   (or/c #f mod?)]
+   [md5         string?]
+   [submit-pred (or/c #f drracket:submit-predicate/c)]))
+
+(define command-server-context (context (make-base-namespace) #f "" #f))
+
+(define/contract (attach-command-server ns maybe-mod)
+  (-> namespace? (or/c #f mod?) any)
+  (set-debug-repl-namespace! ns)
+  (set! command-server-context
+        (context ns
+                 maybe-mod
+                 (maybe-mod->md5 maybe-mod)
+                 (get-repl-submit-predicate maybe-mod))))
+
+(define (maybe-mod->md5 m)
+  (define-values (dir file _) (maybe-mod->dir/file/rmp m))
+  (if (and dir file)
+      (file->md5 (build-path dir file))
+      ""))
+
+;; <https://docs.racket-lang.org/tools/lang-languages-customization.html#(part._.R.E.P.L_.Submit_.Predicate)>
+(define/contract (get-repl-submit-predicate m)
+  (-> (or/c #f mod?) (or/c #f drracket:submit-predicate/c))
+  (define-values (dir file rmp) (maybe-mod->dir/file/rmp m))
+  (define path (and dir file (build-path dir file)))
+  (and path rmp
+       (or (with-handlers ([exn:fail? (λ _ #f)])
+            (match (with-input-from-file (build-path dir file) read-language)
+              [(? procedure? get-info)
+               (match (get-info 'drracket:submit-predicate #f)
+                 [#f #f]
+                 [v  v])]
+              [_ #f]))
+           (with-handlers ([exn:fail? (λ _ #f)])
+             (match (module->language-info rmp #t)
+               [(vector mp name val)
+                (define get-info ((dynamic-require mp name) val))
+                (get-info 'drracket:submit-predicate #f)]
+               [_ #f])))))
+
+;; The command server accepts a single TCP connection at a time.
+;;
+;; Immediately after connecting, the client must send us exactly the
+;; same '(accept ,random-value) value that it gave us as a command
+;; line argument when it started us. Else we exit. See issue #327.
+;;
+;; Normally Emacs will make only one connection to us, ever. If the
+;; user exits the REPL, then our entire Racket process exits. (Just in
+;; case, we have an accept-a-connection loop below. It handles any
+;; exns -- like exn:network -- not handled during command processing.
+;; It uses a custodian to clean up.)
+;;
+;; Command requests and responses "on the wire" are a subset of valid
+;; Emacs Lisp s-expressions: See elisp-read and elisp-write.
+;;
+;; Command requests are (nonce command param ...).
+;;
+;; A thread is spun off to handle each request, so that a long-running
+;; command won't block others. The nonce supplied with the request is
+;; returned with the response, so that the client can match the
+;; response with the request. The nonce needn't be random, just
+;; unique; an increasing integer is fine.
+;;
+;; Command responses are either (nonce 'ok sexp ...+) or (nonce 'error
+;; "message"). The latter normally can and should be displayed to the
+;; user in Emacs via error or message. We handle exn:fail? up here;
+;; generally we're fine letting Racket exceptions percolate up and be
+;; shown to the user
+(define (start-command-server port launch-token)
+  (thread
+   (thunk
+    (define listener (tcp-listen port 4 #t "127.0.0.1"))
+    (let accept-a-connection ()
+      (define custodian (make-custodian))
+      (parameterize ([current-custodian custodian])
+        (with-handlers ([exn:fail? void]) ;just disconnect; see #327
+          (define-values (in out) (tcp-accept listener))
+          (unless (or (not launch-token)
+                      (equal? launch-token (elisp-read in)))
+            (display-commented "Authorization failed; exiting")
+            (exit 1)) ;see #327
+          (define response-channel (make-channel))
+          (define ((do-command/put-response nonce sexp))
+            (channel-put
+             response-channel
+             (cons
+              nonce
+              (with-handlers ([exn:fail? (λ (e) `(error ,(exn-message e)))])
+                (parameterize ([current-namespace
+                                (context-ns command-server-context)])
+                  `(ok ,(command sexp command-server-context)))))))
+          (define (get/write-response)
+            (elisp-writeln (sync response-channel
+                                 debug-notify-channel)
+                           out)
+            (flush-output out)
+            (get/write-response))
+          ;; With all the pieces defined, let's go:
+          (thread get/write-response)
+          (let read-a-command ()
+            (match (elisp-read in)
+              [(cons nonce sexp) (thread (do-command/put-response nonce sexp))
+                                 (read-a-command)]
+              [(? eof-object?)   (void)])))
+        (custodian-shutdown-all custodian))
+      (accept-a-connection))))
+  (void))
+
+(define/contract ((make-prompt-read m))
+  (-> (or/c #f mod?) (-> any))
+  (begin0 (get-interaction (maybe-mod->prompt-string m))
+    (next-break 'all))) ;let debug-instrumented code break again
+
+(define/contract (command sexpr the-context)
+  (-> pair? context? any/c)
+  (match-define (context _ns maybe-mod md5 submit-pred) the-context)
+  (define-values (dir file mod-path) (maybe-mod->dir/file/rmp maybe-mod))
+  (define path (and dir file (build-path dir file)))
+  ;; Note: Intentionally no "else" match clause -- let caller handle
+  ;; exn and supply a consistent exn response format.
+  (match sexpr
+    [`(run ,what ,mem ,pp? ,ctx ,args ,dbg) (run what mem pp? ctx args dbg)]
+    [`(path+md5)                            (cons (or path 'top) md5)]
+    [`(syms)                                (syms)]
+    [`(def ,str)                            (find-definition str)]
+    [`(mod ,sym)                            (find-module sym maybe-mod)]
+    [`(describe ,str)                       (describe str)]
+    [`(doc ,str)                            (doc str)]
+    [`(type ,v)                             (type v)]
+    [`(macro-stepper ,str ,into-base?)      (macro-stepper str into-base?)]
+    [`(macro-stepper/next)                  (macro-stepper/next)]
+    [`(requires/tidy ,reqs)                 (requires/tidy reqs)]
+    [`(requires/trim ,path-str ,reqs)       (requires/trim path-str reqs)]
+    [`(requires/base ,path-str ,reqs)       (requires/base path-str reqs)]
+    [`(find-collection ,str)                (find-collection str)]
+    [`(get-profile)                         (get-profile)]
+    [`(get-uncovered)                       (get-uncovered path)]
+    [`(check-syntax ,path-str)              (check-syntax path-str)]
+    [`(eval ,v)                             (eval-command v)]
+    [`(repl-submit? ,str ,eos?)             (repl-submit? submit-pred str eos?)]
+    [`(debug-eval ,src ,l ,c ,p ,code)      (debug-eval src l c p code)]
+    [`(debug-resume ,v)                     (debug-resume v)]
+    [`(debug-disable)                       (debug-disable)]
+    [`(exit)                                (exit)]))
+
+;;; A few commands defined here
+
+(define/contract (run what mem pp ctx args dbgs)
+  (-> list? number? elisp-bool/c context-level? list? (listof path-string?)
+      list?)
+  (define ready-channel (make-channel))
+  (channel-put message-to-main-thread-channel
+               (rerun (->mod/existing what)
+                      mem
+                      (as-racket-bool pp)
+                      ctx
+                      (list->vector args)
+                      (list->set (map string->path dbgs))
+                      (λ () (channel-put ready-channel what))))
+  ;; Waiting for this allows the command response to be used as the
+  ;; all-clear for additional commands that need the module load to be
+  ;; done and entering a REPL for that module. For example, to compose
+  ;; run with get-profile or get-uncovered.
+  (sync ready-channel))
+
+(define/contract (repl-submit? submit-pred text eos)
+  (-> (or/c #f drracket:submit-predicate/c) string? elisp-bool/c (or/c 'default #t #f))
+  (if submit-pred
+      (submit-pred (open-input-string text) (as-racket-bool eos))
+      'default))
+
+(define (syms)
+  (sort (map symbol->string (namespace-mapped-symbols))
+        string<?))
+
+;;; eval-commmand
+
+(define/contract (eval-command str)
+  (-> string? string?)
+  (define results
+    (call-with-values (λ ()
+                        ((current-eval) (string->namespace-syntax str)))
+                      list))
+  (~a (map ~v results) "\n"))
+
+;;; find-collection
+
+(define/contract (find-collection str)
+  (-> path-string? (or/c 'find-collection-not-installed #f (listof string?)))
+  (define fcd (with-handlers ([exn:fail:filesystem:missing-module?
+                               (λ _ (error 'find-collection
+                                           "For this to work, you need to `raco pkg install raco-find-collection`."))])
+                (dynamic-require 'find-collection/find-collection
+                                 'find-collection-dir)))
+  (map path->string (fcd str)))

elpa/racket-mode-20181004.309/racket/commands/check-syntax.rkt

@@ -0,0 +1,61 @@
+#lang racket/base
+
+(require racket/list
+         racket/match
+         racket/path
+         racket/set)
+
+(provide check-syntax)
+
+(define check-syntax
+  (let ([show-content
+         (with-handlers ([exn:fail? (λ _ 'not-supported)])
+           (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)))))])
+    ;; Note: Adjust all positions to 1-based Emacs `point' values.
+    (λ (path-str)
+      (define path (string->path path-str))
+      (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.
+        (append infos defs/uses)))))

elpa/racket-mode-20181004.309/racket/commands/coverage.rkt

@@ -0,0 +1,50 @@
+#lang racket/base
+
+(require racket/list
+         racket/match
+         (only-in "../instrument.rkt" get-test-coverage-info))
+
+(provide get-uncovered)
+
+(define (get-uncovered file)
+  (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
+  (require rackunit)
+  (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))))

elpa/racket-mode-20181004.309/racket/commands/describe.rkt

@@ -0,0 +1,73 @@
+#lang racket/base
+
+(require racket/contract
+         racket/format
+         racket/match
+         racket/port
+         (only-in xml xexpr->string)
+         (only-in "../find.rkt" find-signature)
+         "../scribble.rkt")
+
+(provide type
+         describe)
+
+(define (type v)
+  (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?)
+  (or
+   ;; 1. Try using Typed Racket's REPL simplified type.
+   (with-handlers ([exn:fail? (λ _ #f)])
+     (match (with-output-to-string
+              (λ ()
+                ((current-eval)
+                 (cons '#%top-interaction v))))
+       [(pregexp "^- : (.*) \\.\\.\\..*\n" (list _ t)) t]
+       [(pregexp "^- : (.*)\n$"            (list _ t)) t]))
+   ;; 2. Try to find a contract.
+   (with-handlers ([exn:fail? (λ _ #f)])
+     (parameterize ([error-display-handler (λ _ (void))])
+       ((current-eval)
+        (cons '#%top-interaction
+              `(if (has-contract? ,v)
+                (~a (contract-name (value-contract ,v)))
+                (error ""))))))))
+
+(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/contract (describe str)
+  (-> string? string?)
+  (define stx (namespace-symbol->identifier (string->symbol str)))
+  (or (scribble-doc/html stx)
+      (sig-and/or-type stx)))

elpa/racket-mode-20181004.309/racket/commands/find-module.rkt

@@ -0,0 +1,46 @@
+#lang racket/base
+
+(require racket/contract
+         racket/match
+         syntax/modresolve
+         "../mod.rkt")
+
+(provide find-module)
+
+(define/contract (find-module str maybe-mod)
+  (-> string? (or/c #f mod?)
+      (or/c #f (list/c path-string? number? number?)))
+  (define-values (dir _file maybe-rmp) (maybe-mod->dir/file/rmp maybe-mod))
+  (parameterize ([current-load-relative-directory dir])
+    (or (mod-loc str maybe-rmp)
+        (mod-loc (string->symbol str) maybe-rmp))))
+
+(define (mod-loc v maybe-rmp)
+  (match (with-handlers ([exn:fail? (λ _ #f)])
+           (resolve-module-path v maybe-rmp))
+    [(? path-string? path)
+     #:when (file-exists? path)
+     (list (path->string path) 1 0)]
+    [_ #f]))
+
+(module+ test
+  (require rackunit
+           racket/runtime-path)
+  (define-runtime-path here ".")
+  (let* ([here             (simplify-path here)] ;nuke trailing dot
+         ;; Examples of finding relative and absolute:
+         [requires.rkt     (path->string (build-path here "requires.rkt"))]
+         [pe-racket/string (pregexp "collects/racket/string.rkt$")])
+    ;; Examples of having no current module (i.e. plain racket/base
+    ;; REPL) and having one ("coverage.rkt").
+    (let ([mod #f])
+     (parameterize ([current-directory here])
+       (check-match (find-module "requires.rkt" mod)
+                    (list (== requires.rkt) 1 0))
+       (check-match (find-module "racket/string" mod)
+                    (list pe-racket/string 1 0))))
+    (let ([mod (->mod/existing (build-path here "coverage.rkt"))])
+      (check-match (find-module "requires.rkt" mod)
+                   (list (== requires.rkt) 1 0))
+      (check-match (find-module "racket/string" mod)
+                   (list pe-racket/string 1 0)))))

elpa/racket-mode-20181004.309/racket/commands/help.rkt

@@ -0,0 +1,120 @@
+#lang at-exp racket/base
+
+(require (only-in help/help-utils find-help)
+         (only-in help/search perform-search)
+         net/url
+         racket/contract
+         racket/match
+         racket/port
+         (only-in "../scribble.rkt" binding->path+anchor))
+
+(provide doc)
+
+(define/contract (doc str)
+  (-> string? any)
+  (or (identifier-help (namespace-symbol->identifier (string->symbol str)))
+      (perform-search str)))
+
+;; It is 2017 therefore it is hard to activate a web browser and show
+;; an anchor link within a local HTML file.
+;;
+;; 1. On macOS `find-help` suffers from the fact that `send-url/file`
+;;    doesn't supply a `browser` arg to `send-url/mac`. This causes it
+;;    to give an "open location" command to osascript. This causes
+;;    macOS to ignore #anchor fragments in the URL. Although the
+;;    correct page will open, it won't be scrolled to the item of
+;;    interest.
+;;
+;; 2. Furthermore, `send-url/mac` doesn't use an "activate" command to
+;;    show the browser window (it might be hidden behind Emacs).
+;;
+;; Let's pretend it's 2020. If we we're on mac and can determine the
+;; default browser (from plist files^1), do the equivalent of
+;; `send-url/mac` but with both desired behaviors.
+;;
+;; ^1: This is kludgy because the plist has "bundle IDs" like
+;; "com.google.chrome" but osascript wants strings like "chrome".
+
+(module mac-default-browser racket/base
+  (require json
+           racket/match
+           racket/file
+           racket/system)
+  (provide mac-default-browser)
+
+  (define launch-plists
+    '("Library/Preferences/com.apple.LaunchServices/com.apple.launchservices.secure.plist"
+      "Library/Preferences/com.apple.LaunchServices.plist"))
+
+  (define (mac-default-browser)
+    (and (equal? (system-type) 'macosx)
+         (for/or ([plist launch-plists])
+           (match (mac-http-handler (build-path (find-system-path 'home-dir) plist))
+             [#f #f]
+             [(pregexp "^.+\\.(.+?)$" ;after final dot
+                       (list _ s)) s]))))
+
+  (define (mac-http-handler plist-path) ;; path? -> (or/c string? #f)
+    (for/or ([h (in-list (hash-ref (read-bplist plist-path) 'LSHandlers '()))])
+      (and (equal? (hash-ref h 'LSHandlerURLScheme #f) "http")
+           (hash-ref h 'LSHandlerRoleAll #f))))
+
+  (define plutil (find-executable-path "plutil" #f))
+
+  (define (read-bplist plist-path) ;path? -> json?
+    (define out-path (make-temporary-file))
+    (begin0
+        (if (system* plutil
+                     "-convert" "json"
+                     "-o" out-path
+                     plist-path)
+            (with-input-from-file out-path read-json)
+            (make-hash))
+      (delete-file out-path))))
+
+(module browse-file-url/mac racket/base
+  (provide browse-file-url/mac)
+  (require racket/format
+           racket/system)
+
+  (define osascript (find-executable-path "osascript" #f))
+
+  (define (browse-file-url/mac file-url browser)
+    ;; Note: Unlike `send-url/mac`, we also do an "activate" to show
+    ;; the browser window.
+    (system*
+     osascript
+     "-e"
+     @~a{tell application "@browser" to open location "@file-url" activate})))
+
+(require 'mac-default-browser
+         'browse-file-url/mac)
+
+
+(define/contract (identifier-help stx)
+  (-> identifier? boolean?)
+  ((if (mac-default-browser)
+       identifier-help/mac
+       identifier-help/other)
+   stx))
+
+(define/contract (identifier-help/other stx)
+  (-> identifier? boolean?)
+  ;; Like `find-help` but returns whether help was found and shown.
+  ;; That way, if this returns #f caller knows it could next call
+  ;; `perform-search` as Plan B.
+  (with-handlers ([exn:fail? (λ _ #f)])
+    (match (with-output-to-string (λ () (find-help stx)))
+      [(pregexp "Sending to web browser") #t]
+      [_ #f])))
+
+(define/contract (identifier-help/mac stx)
+  (-> identifier? boolean?)
+  (define-values (path anchor) (binding->path+anchor stx))
+  (and path
+       anchor
+       (let ([path-url (path->url (path->complete-path path))])
+         (browse-file-url/mac
+          (url->string (struct-copy url path-url [fragment anchor]))
+          (mac-default-browser)))
+       #t))

elpa/racket-mode-20181004.309/racket/commands/macro.rkt

@@ -0,0 +1,125 @@
+#lang racket/base
+
+(require racket/contract
+         racket/file
+         racket/format
+         racket/match
+         racket/pretty
+         racket/system
+         "../elisp.rkt"
+         "../syntax.rkt"
+         "../util.rkt")
+
+(provide macro-stepper
+         macro-stepper/next)
+
+(define step-thunk/c (-> (cons/c (or/c 'original string? 'final) string?)))
+(define step-thunk #f)
+
+(define/contract (make-expr-stepper str)
+  (-> string? step-thunk/c)
+  (define step-num #f)
+  (define last-stx (string->namespace-syntax str))
+  (define (step)
+    (cond [(not step-num)
+           (set! step-num 0)
+           (cons 'original (pretty-format-syntax last-stx))]
+          [else
+           (define this-stx (expand-once last-stx))
+           (cond [(not (equal? (syntax->datum last-stx)
+                               (syntax->datum this-stx)))
+                  (begin0
+                      (cons (~a step-num ": expand-once")
+                            (diff-text (pretty-format-syntax last-stx)
+                                       (pretty-format-syntax this-stx)
+                                       #:unified 3))
+                    (set! last-stx this-stx))]
+                 [else
+                  (cons 'final (pretty-format-syntax this-stx))])]))
+  step)
+
+(define/contract (make-file-stepper path into-base?)
+  (-> (and/c path-string? absolute-path?) boolean? step-thunk/c)
+  ;; If the dynamic-require fails, just let it bubble up.
+  (define stepper-text (dynamic-require 'macro-debugger/stepper-text 'stepper-text))
+  (define stx (file->syntax path))
+  (define-values (dir _name _dir) (split-path path))
+  (define raw-step (parameterize ([current-load-relative-directory dir])
+                     (stepper-text stx
+                                   (if into-base? (λ _ #t) (not-in-base)))))
+  (define step-num #f)
+  (define step-last-after "")
+  (define/contract (step) step-thunk/c
+    (cond [(not step-num)
+           (set! step-num 0)
+           (cons 'original
+                 (pretty-format-syntax stx))]
+          [else
+           (define out (open-output-string))
+           (parameterize ([current-output-port out])
+             (cond [(raw-step 'next)
+                    (set! step-num (add1 step-num))
+                    (match-define (list title before after)
+                      (step-parts (get-output-string out)))
+                    (set! step-last-after after)
+                    (cons (~a step-num ": " title)
+                          (diff-text before after #:unified 3))]
+                   [else
+                    (cons 'final step-last-after)]))]))
+  step)
+
+(define/contract (macro-stepper what into-base?)
+  (-> (or/c (cons/c 'expr string?) (cons/c 'file path-string?)) elisp-bool/c
+      (cons/c 'original string?))
+  (set! step-thunk
+        (match what
+          [(cons 'expr str)  (make-expr-stepper str)]
+          [(cons 'file path) (make-file-stepper path (as-racket-bool into-base?))]))
+  (macro-stepper/next))
+
+(define/contract (macro-stepper/next)
+  (-> (cons/c (or/c 'original 'final string?) string?))
+  (unless step-thunk
+    (error 'macro-stepper "Nothing to expand"))
+  (define v (step-thunk))
+  (when (eq? 'final (car v))
+    (set! step-thunk #f))
+  v)
+
+;; Borrowed from xrepl.
+(define not-in-base
+  (λ () (let ([base-stxs #f])
+          (unless base-stxs
+            (set! base-stxs ; all ids that are bound to a syntax in racket/base
+                  (parameterize ([current-namespace (make-base-namespace)])
+                    (let-values ([(vals stxs) (module->exports 'racket/base)])
+                      (map (λ (s) (namespace-symbol->identifier (car s)))
+                           (cdr (assq 0 stxs)))))))
+          (λ (id) (not (ormap (λ (s) (free-identifier=? id s)) base-stxs))))))
+
+(define (step-parts str)
+  (match str
+    [(pregexp "^(.+?)\n(.+?)\n +==>\n(.+?)\n+$"
+              (list _ title before after))
+     (list title before after)]))
+
+(define (diff-text before-text after-text #:unified [-U 3])
+  (define template "racket-mode-syntax-diff-~a")
+  (define (make-temporary-file-with-text str)
+    (define file (make-temporary-file template))
+    (with-output-to-file file #:mode 'text #:exists 'replace
+      (λ () (displayln str)))
+    file)
+  (define before-file (make-temporary-file-with-text before-text))
+  (define after-file  (make-temporary-file-with-text after-text))
+  (define out (open-output-string))
+  (begin0 (parameterize ([current-output-port out])
+            (system (format "diff -U ~a ~a ~a" -U before-file after-file))
+            (match (get-output-string out)
+              ["" " <empty diff>\n"]
+              [(pregexp "\n(@@.+@@\n.+)$" (list _ v)) v]))
+    (delete-file before-file)
+    (delete-file after-file)))
+
+(define (pretty-format-syntax stx)
+  (pretty-format #:mode 'write (syntax->datum stx)))

elpa/racket-mode-20181004.309/racket/commands/profile.rkt

@@ -0,0 +1,19 @@
+#lang racket/base
+
+(require racket/match
+         (only-in "../instrument.rkt" get-profile-info))
+
+(provide get-profile)
+
+(define (get-profile)
+  ;; 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))))))

elpa/racket-mode-20181004.309/racket/commands/requires.rkt

@@ -0,0 +1,276 @@
+#lang at-exp racket/base
+
+(require (only-in macro-debugger/analysis/check-requires show-requires)
+         racket/format
+         racket/function
+         racket/list
+         racket/match
+         racket/set)
+
+(provide requires/tidy
+         requires/trim
+         requires/base)
+
+(module+ test
+  (require rackunit))
+
+;; requires/tidy : (listof require-sexpr) -> require-sexpr
+(define (requires/tidy reqs)
+  (let* ([reqs (combine-requires reqs)]
+         [reqs (group-requires reqs)])
+    (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)])
+    (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)])
+    (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
+  (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))

elpa/racket-mode-20181004.309/racket/debug-annotator.rkt

@@ -0,0 +1,381 @@
+#lang racket/base
+
+(require (for-syntax racket/base)
+         gui-debugger/marks
+         (only-in mzscheme [apply plain-apply])
+         (prefix-in kernel: syntax/kerncase))
+
+;; This is like gui-debugger/annotate except:
+;;
+;; 0. Our annotate-stx does NOT add breaks to syntax sources not
+;;    matching the syntax it is given. See
+;;    https://github.com/racket/drracket/issues/230 and below.
+;;
+;; 1. Our module-annotate disarms/rearms module level expressions. See
+;;    https://github.com/racket/drracket/issues/231 and below.
+;;
+;; 2. "Modernize": Use racket/base not racket/scheme. Don't need
+;;    opt-lambda.
+;;
+;; 3. We remove the record-bound-id and record-top-level-id callbacks
+;;    that we don't use, from annotate-for-single-stepping (but leave
+;;    them for now in annotate-stx).
+;;
+;; 4. We remove the source arg that is completely unused (I'm guessing
+;;    historical).
+
+(provide annotate-for-single-stepping)
+
+(define (annotate-for-single-stepping stx break? break-before break-after)
+  (define (break-wrap debug-info annotated raw is-tail?)
+    (let* ([start  (syntax-position raw)]
+           [end    (+ start (syntax-span raw) -1)]
+           [break? (break? (syntax-source raw))])
+      (if is-tail?
+          #`(let-values ([(value-list) #f])
+              (if (#%plain-app #,break? #,start)
+                  (set! value-list (#%plain-app
+                                    #,break-before
+                                    #,debug-info
+                                    (#%plain-app current-continuation-marks)))
+                  (#%plain-app void))
+              (if (#%plain-app not value-list)
+                  #,annotated
+                  (#%plain-app plain-apply values value-list)))
+          #`(let-values ([(value-list) #f])
+              (if (#%plain-app #,break? #,start)
+                  (set! value-list (#%plain-app
+                                    #,break-before
+                                    #,debug-info
+                                    (#%plain-app current-continuation-marks)))
+                  (#%plain-app void))
+              (if (#%plain-app not value-list)
+                  (#%plain-app
+                   call-with-values
+                   (#%plain-lambda () #,annotated)
+                   (case-lambda
+                     [(val) (if (#%plain-app #,break? #,end)
+                                (#%plain-app
+                                 #,break-after
+                                 #,debug-info
+                                 (#%plain-app current-continuation-marks)
+                                 val)
+                                val)]
+                     [vals (if (#%plain-app
+                                #,break? #,end)
+                               (#%plain-app
+                                plain-apply
+                                #,break-after
+                                #,debug-info
+                                (#%plain-app current-continuation-marks)
+                                vals)
+                               (#%plain-app plain-apply values vals))]))
+                  (if (#%plain-app #,break? #,end)
+                      (#%plain-app
+                       plain-apply #,break-after
+                       #,debug-info
+                       (#%plain-app current-continuation-marks)
+                       value-list)
+                      (#%plain-app plain-apply values value-list)))))))
+  (annotate-stx stx break-wrap))
+
+(define (annotate-stx stx break-wrap [record-bound-id void] [record-top-level-id void])
+  (define breakpoints (make-hasheq))
+
+  (define (previous-bindings bound-vars)
+    (if (null? bound-vars)
+        #'null
+        #'(#%plain-app debugger-local-bindings)))
+
+  (define (top-level-annotate stx)
+    (kernel:kernel-syntax-case/phase
+     stx (namespace-base-phase)
+     [(module identifier name mb)
+      (module-annotate stx)]
+     [else-stx
+      (general-top-level-expr-iterator stx  #f)]))
+
+  (define (module-annotate stx)
+    (syntax-case stx ()
+      [(_ identifier name mb)
+       (syntax-case (disarm #'mb) ()
+         [(plain-module-begin . module-level-exprs)
+          (with-syntax ([(module . _) stx])
+            (quasisyntax/loc stx
+              (module identifier name
+                #,(rearm
+                   #'mb
+                   #`(plain-module-begin
+                      #,@(map (lambda (e)
+                                ;; https://github.com/racket/drracket/issues/231
+                                (rearm
+                                 e
+                                 (module-level-expr-iterator
+                                  (disarm e)
+                                  (list (syntax-e #'identifier)
+                                        (syntax-source #'identifier)))))
+                              (syntax->list #'module-level-exprs)))))))])]))
+
+  (define (module-level-expr-iterator stx module-name)
+    (kernel:kernel-syntax-case
+     stx #f
+     [(#%provide . provide-specs)
+      stx]
+     [(#%declare . declare-specs)
+      stx]
+     [else-stx
+      (general-top-level-expr-iterator stx module-name)]))
+
+  (define (general-top-level-expr-iterator stx module-name)
+    (kernel:kernel-syntax-case
+     stx #f
+     [(define-values (var ...) expr)
+      (begin
+        (for-each (lambda (v) (record-bound-id 'bind v v))
+                  (syntax->list #'(var ...)))
+        (quasisyntax/loc stx
+          (begin
+            (define-values (var ...) #,(annotate #`expr '() #t module-name))
+            #,(if (syntax-source stx)
+                  #`(begin (#%plain-app
+                            #,record-top-level-id '#,module-name #'var
+                            (case-lambda
+                              [() var]
+                              [(v) (set! var v)])) ...)
+                  #'(#%plain-app void))
+            (#%plain-app void))))]
+     [(define-syntaxes (var ...) expr)
+      stx]
+     [(begin-for-syntax . exprs)
+      ;; compile time, so treat it like define-syntaxes
+      stx]
+     [(begin . top-level-exprs)
+      (quasisyntax/loc stx
+        (begin #,@(map (lambda (expr)
+                         (module-level-expr-iterator expr module-name))
+                       (syntax->list #'top-level-exprs))))]
+     [(#%require . require-specs)
+      stx]
+     [(module . _)
+      ;; a submodule:
+      (module-annotate stx)]
+     [(module* . _)
+      ;; a submodule:
+      (module-annotate stx)]
+     [else
+      (annotate stx '() #f module-name)]))
+
+  (define (annotate expr bound-vars is-tail? module-name)
+
+    (define annotate-break?
+      (let ([pos (syntax-position expr)]
+            [src (syntax-source expr)])
+        (and src pos
+             ;; https://github.com/racket/drracket/issues/230
+             (equal? src (syntax-source stx))
+             (hash-ref breakpoints pos (lambda () #t))
+             (kernel:kernel-syntax-case
+              expr #f
+              [(if test then else) #t]
+              [(begin . bodies) #t]
+              [(begin0 . bodies) #t]
+              [(let-values . clause) #t]
+              [(letrec-values . clause) #t]
+              [(set! var val) #t]
+              [(with-continuation-mark key mark body) #t]
+              [(#%plain-app . exprs) #t]
+              [_ #f])
+             (begin
+               (hash-set! breakpoints pos #f)
+               (when (not is-tail?)
+                 (hash-set! breakpoints (+ pos (syntax-span expr) -1) #f))
+               #t))))
+
+    (define (let/rec-values-annotator letrec?)
+      (kernel:kernel-syntax-case
+       (disarm expr) #f
+       [(label (((var ...) rhs) ...) . bodies)
+        (let* ([new-bindings (apply append
+                                    (map syntax->list
+                                         (syntax->list #`((var ...) ...))))]
+               [all-bindings (append new-bindings bound-vars)]
+               [new-rhs (map (lambda (expr)
+                               (annotate expr
+                                         (if letrec? all-bindings bound-vars)
+                                         #f module-name))
+                             (syntax->list #'(rhs ...)))]
+               [last-body (car (reverse (syntax->list #'bodies)))]
+               [all-but-last-body (reverse (cdr (reverse (syntax->list #'bodies))))]
+               [bodies (append (map (lambda (expr)
+                                      (annotate expr all-bindings #f module-name))
+                                    all-but-last-body)
+                               (list (annotate
+                                      last-body
+                                      all-bindings
+                                      is-tail? module-name)))]
+               [local-debug-info (assemble-debug-info new-bindings new-bindings 'normal #f)]
+               [previous-bindings (previous-bindings bound-vars)])
+          (for-each (lambda (id) (record-bound-id 'bind id id)) new-bindings)
+          (with-syntax ([(new-rhs/trans ...) new-rhs]
+                        [previous-bindings previous-bindings])
+            (if letrec?
+                (quasisyntax/loc expr
+                  (let ([old-bindings previous-bindings])
+                    (label (((debugger-local-bindings)
+                             (#%plain-lambda ()
+                                             (#%plain-app
+                                              list*
+                                              #,@local-debug-info
+                                              old-bindings)))
+                            ((var ...) new-rhs/trans) ...)
+                           #,@bodies)))
+                (quasisyntax/loc expr
+                  (label (((var ...) new-rhs/trans) ...)
+                         (let ([debugger-local-bindings
+                                (#%plain-lambda ()
+                                                (#%plain-app
+                                                 list*
+                                                 #,@local-debug-info
+                                                 previous-bindings))])
+                           #,@bodies))))))]))
+
+    (define (lambda-clause-annotator clause)
+      (kernel:kernel-syntax-case
+       clause #f
+       [(arg-list . bodies)
+        (let* ([new-bound-vars (arglist-bindings #'arg-list)]
+               [all-bound-vars (append new-bound-vars bound-vars)]
+               [new-bodies (let loop ([bodies (syntax->list #'bodies)])
+                             (if (equal? '() (cdr bodies))
+                                 (list (annotate (car bodies) all-bound-vars #t module-name))
+                                 (cons (annotate (car bodies) all-bound-vars #f module-name)
+                                       (loop (cdr bodies)))))])
+          (for-each (lambda (id) (record-bound-id 'bind id id)) new-bound-vars)
+          (quasisyntax/loc clause
+            (arg-list
+             (let ([debugger-local-bindings
+                    (#%plain-lambda ()
+                                    (#%plain-app
+                                     list*
+                                     #,@(assemble-debug-info new-bound-vars new-bound-vars 'normal #f)
+                                     #,(previous-bindings bound-vars)))])
+               #,@new-bodies))))]))
+
+    (define annotated
+      (rearm
+       expr
+       (kernel:kernel-syntax-case
+        (disarm expr) #f
+        [var-stx (identifier? (syntax var-stx))
+                 (let ([binder (and (syntax-original? expr)
+                                    (member expr bound-vars free-identifier=?))])
+                   (if binder
+                       (record-bound-id 'ref expr (car binder))
+                       (record-bound-id 'top-level expr expr))
+                   expr)]
+
+        [(#%plain-lambda . clause)
+         (quasisyntax/loc expr
+           (#%plain-lambda #,@(lambda-clause-annotator #'clause)))]
+
+        [(case-lambda . clauses)
+         (quasisyntax/loc expr
+           (case-lambda #,@(map lambda-clause-annotator (syntax->list #'clauses))))]
+
+        [(if test then else)
+         (quasisyntax/loc expr
+           (if #,(annotate #'test bound-vars #f module-name)
+               #,(annotate #'then bound-vars is-tail? module-name)
+               #,(annotate #'else bound-vars is-tail? module-name)))]
+
+        [(begin . bodies)
+         (letrec ([traverse
+                   (lambda (lst)
+                     (if (and (pair? lst) (equal? '() (cdr lst)))
+                         `(,(annotate (car lst) bound-vars is-tail? module-name))
+                         (cons (annotate (car lst) bound-vars #f module-name)
+                               (traverse (cdr lst)))))])
+           (quasisyntax/loc expr
+             (begin #,@(traverse (syntax->list #'bodies)))))]
+
+
+        [(begin0 body)
+         (quasisyntax/loc expr
+           (begin0 #,(annotate #'body bound-vars #t module-name)))]
+
+        [(begin0 . bodies)
+         (quasisyntax/loc expr
+           (begin0 #,@(map (lambda (expr)
+                             (annotate expr bound-vars #f module-name))
+                           (syntax->list #'bodies))))]
+
+        [(let-values . clause)
+         (let/rec-values-annotator #f)]
+
+        [(letrec-values . clause)
+         (let/rec-values-annotator #t)]
+
+        [(set! var val)
+         (let ([binder (and (syntax-original? #'var)
+                            (member #'var bound-vars free-identifier=?))])
+           (when binder
+             (record-bound-id 'set expr (car binder)))
+           (quasisyntax/loc expr
+             (set! var #,(annotate #`val bound-vars #f module-name))))]
+
+        [(quote _) expr]
+
+        [(quote-syntax _) expr]
+
+        [(quote-syntax _ #:local) expr]
+
+        [(with-continuation-mark key mark body)
+         (quasisyntax/loc expr
+           (with-continuation-mark key
+             #,(annotate #'mark bound-vars #f module-name)
+             #,(annotate #'body bound-vars is-tail? module-name)))]
+
+        [(#%plain-app . exprs)
+         (let ([subexprs (map (lambda (expr)
+                                (annotate expr bound-vars #f module-name))
+                              (syntax->list #'exprs))])
+           (if (or is-tail? (not (syntax-source expr)))
+               (quasisyntax/loc expr (#%plain-app . #,subexprs))
+               (wcm-wrap (make-debug-info module-name expr
+                                          bound-vars bound-vars
+                                          'normal #f (previous-bindings bound-vars))
+                         (quasisyntax/loc expr
+                           (#%plain-app . #,subexprs)))))]
+
+        [(#%top . var) expr]
+        [(#%variable-reference . _) expr]
+
+        [else (error 'expr-syntax-object-iterator "unknown expr: ~a"
+                     (syntax->datum expr))])))
+
+    (if annotate-break?
+        (break-wrap
+         (make-debug-info module-name expr bound-vars bound-vars
+                          'at-break #f (previous-bindings bound-vars))
+         annotated
+         expr
+         is-tail?)
+        annotated))
+
+  (values (top-level-annotate stx) (hash-map breakpoints (lambda (k v) k))))
+
+(define (arglist-bindings arglist-stx)
+  (syntax-case arglist-stx ()
+    [var
+     (identifier? arglist-stx)
+     (list arglist-stx)]
+    [(var ...)
+     (syntax->list arglist-stx)]
+    [(var . others)
+     (cons #'var (arglist-bindings #'others))]))
+
+(define (disarm stx) (syntax-disarm stx code-insp))
+(define (rearm old new) (syntax-rearm new old))
+
+(define code-insp (variable-reference->module-declaration-inspector
+                   (#%variable-reference)))

elpa/racket-mode-20181004.309/racket/debug.rkt

@@ -0,0 +1,309 @@
+#lang racket/base
+
+(require (for-syntax racket/base)
+         gui-debugger/marks
+         racket/contract
+         racket/format
+         racket/lazy-require
+         racket/list
+         racket/match
+         racket/set
+         racket/string
+         syntax/modread
+         "interactions.rkt"
+         "util.rkt")
+
+(lazy-require ["debug-annotator.rkt" (annotate-for-single-stepping)])
+
+(provide (rename-out [on-break-channel debug-notify-channel])
+         debug-eval
+         debug-resume
+         debug-disable
+         make-debug-eval-handler
+         next-break
+         set-debug-repl-namespace!)
+
+(define debug-repl-ns (make-base-namespace))
+(define (set-debug-repl-namespace! ns)
+  (set! debug-repl-ns ns))
+
+;; A gui-debugger/marks "mark" is a thunk that returns a
+;; full-mark-struct -- although gui-debugger/marks doesn't provide
+;; that struct. Instead the thunk can be passed to various accessor
+;; functions.
+(define mark/c (-> any/c))
+
+;; A "mark-binding" is a list whose first element is syntax of the
+;; identifier, and whose second element is a get/set! procedure.
+(define get/set!/c (case-> (-> any/c)
+                           (-> any/c void)))
+
+(define breakable-positions/c (hash/c path? (set/c #:cmp 'eq pos/c)))
+(define/contract breakable-positions breakable-positions/c (make-hash))
+(define/contract (breakable-position? src pos)
+  (-> path? pos/c boolean?)
+  (set-member? (hash-ref breakable-positions src (seteq)) pos))
+
+(define/contract (annotate stx)
+  (-> syntax? syntax?)
+  (define source (syntax-source stx))
+  (display-commented (format "Debug annotate ~v" source))
+  (define-values (annotated breakables)
+    (annotate-for-single-stepping stx break? break-before break-after))
+  (hash-update! breakable-positions
+                source
+                (λ (s) (set-union s (list->seteq breakables)))
+                (seteq))
+  annotated)
+
+(define break-when/c (or/c 'all 'none (cons/c path-string? pos/c)))
+(define/contract next-break
+  (case-> (-> break-when/c)
+          (-> break-when/c void))
+  (let ([v 'none])
+    (case-lambda [() v]
+                 [(v!) (set! v v!)])))
+
+;; If this returns #t, either break-before or break-after will be
+;; called next.
+(define ((break? src) pos)
+  (match (next-break)
+    ['none                    #f]
+    ['all                     #t]
+    [(cons (== src) (== pos)) #t]
+    [_                        #f]))
+
+(define/contract (break-before top-mark ccm)
+  (-> mark/c continuation-mark-set? (or/c #f (listof any/c)))
+  (break 'before top-mark ccm #f))
+
+(define/contract (break-after top-mark ccm . vals)
+  (->* (mark/c continuation-mark-set?) #:rest (listof any/c)
+       any)
+  (apply values (break 'after top-mark ccm vals)))
+
+(define/contract (break before/after top-mark ccm vals)
+  (-> (or/c 'before 'after) mark/c continuation-mark-set? (or/c #f (listof any/c))
+      (or/c #f (listof any/c)))
+  (define stx (mark-source top-mark))
+  (define src (syntax-source stx))
+  (define pos (case before/after
+                [(before)    (syntax-position stx)]
+                [(after)  (+ (syntax-position stx) (syntax-span stx) -1)]))
+  (define locals
+    (for*/list ([binding  (in-list (mark-bindings top-mark))]
+                [stx      (in-value (first binding))]
+                [get/set! (in-value (second binding))]
+                #:when (and (syntax-original? stx) (syntax-source stx)))
+      (list (syntax-source stx)
+            (syntax-position stx)
+            (syntax-span stx)
+            (syntax->datum stx)
+            (~v (get/set!)))))
+  ;; Start a debug repl on its own thread, because below we're going to
+  ;; block indefinitely with (channel-get on-resume-channel), waiting for
+  ;; the Emacs front end to issue a debug-resume command.
+  (define repl-thread (parameterize ([current-namespace debug-repl-ns])
+                        (thread (repl src pos top-mark))))
+  ;; The on-break-channel is how we notify the Emacs front-end. This
+  ;; is a synchronous channel-put but it should return fairly quickly,
+  ;; as soon as the TCP command server gets and writes it. In other
+  ;; words, this is sent as a notification, unlike a command response
+  ;; as a result of a request.
+  (define this-break-id (new-break-id))
+  (channel-put on-break-channel
+               (list 'debug-break
+                     (cons src pos)
+                     breakable-positions
+                     locals
+                     (cons this-break-id
+                           (case before/after
+                             [(before) (list 'before)]
+                             [(after)  (list 'after (~s vals))]))))
+  ;; Wait for debug-resume command to put to on-resume-channel. If
+  ;; wrong break ID, ignore and wait again. Note that some Racket
+  ;; values are non-serializable -- e.g. #<output-port> -- in which
+  ;; case just eat the exn:fail:read and use the original `vals`.
+  (let wait ()
+    (begin0
+        (match (channel-get on-resume-channel)
+          [(list break-when (list (== this-break-id) 'before))
+           (next-break (calc-next-break before/after break-when top-mark ccm))
+           #f]
+          [(list break-when (list (== this-break-id) (or 'before 'after) vals-str))
+           (next-break (calc-next-break before/after break-when top-mark ccm))
+           (with-handlers ([exn:fail:read? (λ _ vals)])
+             (read (open-input-string vals-str)))]
+          [_ (wait)])
+      (kill-thread repl-thread)
+      (newline))))
+
+(define/contract (calc-next-break before/after break-when top-mark ccm)
+  (-> (or/c 'before 'after) (or/c break-when/c 'over 'out) mark/c continuation-mark-set?
+      any)
+  (define (big-step frames)
+    (define num-marks (length (debug-marks (current-continuation-marks))))
+    (or (for/or ([frame  (in-list frames)]
+                  [depth (in-range (length frames) -1 -1)]
+                  #:when (<= num-marks depth))
+          (let* ([stx   (mark-source frame)]
+                 [src   (syntax-source stx)]
+                 [left  (syntax-position stx)]
+                 [right (and left (+ left (syntax-span stx) -1))])
+            (and right
+                 (breakable-position? src right)
+                 (cons src right))))
+        'all))
+  (match* [break-when before/after]
+    [['out  _]       (big-step                (debug-marks ccm))]
+    [['over 'before] (big-step (cons top-mark (debug-marks ccm)))]
+    [['over 'after]  'all]
+    [[v     _]       v]))
+
+(define break-id/c nat/c)
+(define/contract new-break-id
+  (-> break-id/c)
+  (let ([n 0]) (λ () (begin0 n (set! n (add1 n))))))
+
+(define/contract (debug-marks ccm)
+  (-> continuation-mark-set? (listof mark/c))
+  (continuation-mark-set->list ccm debug-key))
+
+
+;;; Debug REPL
+
+(define ((repl src pos top-mark))
+  (parameterize ([current-prompt-read (make-prompt-read src pos top-mark)])
+    (read-eval-print-loop)))
+
+(define ((make-prompt-read src pos top-mark))
+  (define-values (_base name _dir) (split-path src))
+  (define stx (get-interaction (format "[~a:~a]" name pos)))
+  (with-locals stx (mark-bindings top-mark)))
+
+(define (with-locals stx bindings)
+  ;; Note that mark-bindings is ordered from inner to outer scopes --
+  ;; and can include outer variables shadowed by inner ones. So use
+  ;; only the first occurence of each identifier symbol we encounter.
+  ;; e.g. in (let ([x _]) (let ([x _]) ___)) we want only the inner x.
+  (define ht (make-hasheq))
+  (for* ([binding  (in-list bindings)]
+         [sym      (in-value (syntax->datum (first binding)))]
+         #:unless (hash-has-key? ht sym)
+         [get/set! (in-value (second binding))])
+    (hash-set! ht sym get/set!))
+  (syntax-case stx ()
+    ;; I couldn't figure out how to get a set! transformer to work for
+    ;; Typed Racket -- how to annotate or cast a get/set! as (-> Any
+    ;; Void). So instead, just intercept (set! id e) as a datum and
+    ;; effectively (get/set! (eval e debug-repl-ns)) here. In other
+    ;; words treat the stx like a REPL "command". Of course this
+    ;; totally bypasses type-checking, but this is a debugger. YOLO!
+    [(set! id e)
+     (and (module-declared? 'typed/racket/base)
+          (eq? 'set! (syntax->datum #'set!))
+          (identifier? #'id)
+          (hash-has-key? ht (syntax->datum #'id)))
+     (let ([set (hash-ref ht (syntax->datum #'id))]
+           [v   (eval #'e debug-repl-ns)])
+       (set v)
+       #`(void))]
+    ;; Wrap stx in a let-syntax form with a make-set!-transformer for
+    ;; every local variable in the mark-bindings results.
+    [_
+     (let ([syntax-bindings
+            (for/list ([(sym get/set!) (in-hash ht)])
+              (define id (datum->syntax #f sym))
+              (define xform
+                (make-set!-transformer
+                 (λ (stx)
+                   (syntax-case stx (set!)
+                     [(set! id v) (identifier? #'id) #`(#%plain-app #,get/set! v)]
+                     [id          (identifier? #'id) #`'#,(get/set!)]))))
+              #`(#,id #,xform))])
+       #`(let-syntax #,syntax-bindings
+           #,stx))]))
+
+
+;;; Command interface
+
+;; Intended use is for `code` to be a function definition form. It
+;; will be re-defined annotated for single stepping: When executed it
+;; will call our break?, break-before, and break-after functions.
+(define/contract (debug-eval source-str line col pos code)
+  (-> path-string? pos/c nat/c pos/c string? #t)
+  (define source (string->path source-str))
+  (define in (open-input-string code))
+  (port-count-lines! in)
+  (set-port-next-location! in line col pos)
+  (eval (annotate (expand (read-syntax source in))))
+  (next-break 'all)
+  #t)
+
+(define locals/c (listof (list/c path-string? pos/c pos/c symbol? string?)))
+(define break-vals/c (cons/c break-id/c
+                             (or/c (list/c 'before)
+                                   (list/c 'after string?))))
+(define on-break/c (list/c 'debug-break
+                           break-when/c
+                           breakable-positions/c
+                           locals/c
+                           break-vals/c))
+(define/contract on-break-channel (channel/c on-break/c) (make-channel))
+
+(define resume-vals/c (cons/c break-id/c
+                              (or/c (list/c 'before)
+                                    (list/c 'before string?)
+                                    (list/c 'after string?))))
+(define on-resume/c (list/c (or/c break-when/c 'out 'over) resume-vals/c))
+(define/contract on-resume-channel (channel/c on-resume/c) (make-channel))
+
+(define/contract (debug-resume resume-info)
+  (-> on-resume/c #t)
+  (channel-put on-resume-channel resume-info)
+  #t)
+
+(define (debug-disable)
+  (next-break 'none)
+  (for ([k (in-hash-keys breakable-positions)])
+    (hash-remove! breakable-positions k)))
+
+
+;;; Make eval handler to instrument entire files
+
+(define eval-handler/c (-> any/c any))
+
+(define/contract ((make-debug-eval-handler files [orig-eval (current-eval)]) v)
+  (->* ((set/c path?)) (eval-handler/c) eval-handler/c)
+  (cond [(compiled-expression? (syntax-or-sexpr->sexpr v))
+         (orig-eval v)]
+        [else
+         (define stx (syntax-or-sexpr->syntax v))
+         (define top-stx (expand-syntax-to-top-form stx))
+         (cond [(set-member? files (syntax-source stx))
+                (next-break 'all)
+                (parameterize* ([current-eval orig-eval]
+                                [current-load/use-compiled
+                                 (let ([orig (current-load/use-compiled)])
+                                   (λ (file mod)
+                                     (cond [(set-member? files file)
+                                            (load-module/annotate file mod)]
+                                           [else
+                                            (orig file mod)])))])
+                  (eval-syntax (annotate (expand-syntax top-stx))))]
+               [else (orig-eval top-stx)])]))
+
+;; This never seems to be called ???
+(define (load-module/annotate file m)
+  (display-commented (format "~v" `(load-module/annotate ,file ,m)))
+  (define-values (base _ __) (split-path file))
+  (call-with-input-file* file
+    (λ (in)
+      (port-count-lines! in)
+      (parameterize ([read-accept-compiled #f]
+                     [current-load-relative-directory base])
+        (with-module-reading-parameterization
+          (λ ()
+            (define e (parameterize ([current-namespace (make-base-namespace)])
+                        (expand (read-syntax file in))))
+            (eval (annotate (check-module-form e m file)))))))))

elpa/racket-mode-20181004.309/racket/elisp.rkt

@@ -0,0 +1,57 @@
+#lang racket/base
+
+(require racket/contract
+         racket/match
+         racket/port
+         racket/set)
+
+(provide elisp-read
+         elisp-writeln
+         elisp-bool/c
+         as-racket-bool)
+
+;;; read/write Emacs Lisp values
+
+(define (elisp-read in)
+  (elisp->racket (read in)))
+
+(define (elisp-writeln v out)
+  (elisp-write v out)
+  (newline out))
+
+(define (elisp-write v out)
+  (write (racket->elisp v) out))
+
+(define elisp-bool/c (or/c #t '()))
+(define (as-racket-bool v)
+  ;; elisp->racket "de-puns" 'nil as '() -- not #f. Use this helper to
+  ;; treat as a boolean.
+  (and v (not (null? v))))
+
+(define (elisp->racket v)
+  (match v
+    ['nil             '()] ;not #f -- see as-racket-bool
+    ['t               #t]
+    [(? list? xs)     (map elisp->racket xs)]
+    [(cons x y)       (cons (elisp->racket x) (elisp->racket y))]
+    [(vector s _ ...) s] ;Emacs strings can be #("string" . properties)
+    [v                v]))
+
+(define (racket->elisp v)
+  (match v
+    [(or #f (list)) 'nil]
+    [#t             't]
+    [(? list? xs)   (map racket->elisp xs)]
+    [(cons x y)     (cons (racket->elisp x) (racket->elisp y))]
+    [(? path? v)    (path->string v)]
+    [(? hash? v)    (for/list ([(k v) (in-hash v)])
+                      (cons (racket->elisp k) (racket->elisp v)))]
+    [(? set? v)     (map racket->elisp (set->list v))]
+    [v              v]))
+
+(module+ test
+  (require rackunit)
+  (check-equal? (with-output-to-string
+                  (λ () (elisp-write '(1 #t nil () (a . b) #hash((1 . 2) (3 . 4)))
+                                     (current-output-port))))
+                "(1 t nil nil (a . b) ((1 . 2) (3 . 4)))"))

elpa/racket-mode-20181004.309/racket/error.rkt

@@ -0,0 +1,197 @@
+#lang at-exp racket/base
+
+(require racket/format
+         racket/match
+         (only-in racket/path path-only)
+         racket/runtime-path
+         racket/string
+         setup/collects
+         setup/dirs
+         "fresh-line.rkt"
+         "instrument.rkt"
+         "util.rkt")
+
+(provide display-exn
+         our-error-display-handler
+         show-full-path-in-errors)
+
+(module+ test
+  (require rackunit))
+
+(define (display-exn exn)
+  (our-error-display-handler (exn-message exn) exn))
+
+(define (our-error-display-handler str v)
+  (cond [(exn? v)
+         (unless (equal? "Check failure" (exn-message v)) ;rackunit check fails
+           (fresh-line)
+           (display-commented (fully-qualify-error-path str))
+           (display-srclocs v)
+           (unless (exn:fail:user? v)
+             (display-context v))
+           (maybe-suggest-packages v))]
+        [else
+         (fresh-line)
+         (display-commented str)]))
+
+(define (display-srclocs exn)
+  (when (exn:srclocs? exn)
+    (define srclocs
+      (match ((exn:srclocs-accessor exn) exn)
+        ;; Some exceptions like exn:fail:read? include the first
+        ;; srcloc in exn-message -- don't show it again.
+        [(cons _ xs)
+         #:when (or (exn:fail:read? exn)
+                    (exn:fail:contract:variable? exn))
+         xs]
+        ;; Some exceptions like exn:fail:syntax? with Typed Racket
+        ;; include _all_ in exn-message -- don't show _any_.
+        [_
+         #:when (exn:fail:syntax? exn)
+         '()]
+        [xs xs]))
+    (for ([s (in-list srclocs)])
+      (display-commented (source-location->string s)))))
+
+(define (display-context exn)
+  (cond [(instrumenting-enabled)
+         (define p (open-output-string))
+         (print-error-trace p exn)
+         (match (get-output-string p)
+           ["" (void)]
+           [s  (display-commented (string-append "Context (errortrace):"
+                                                 ;; et prepends a \n
+                                                 s))])]
+        [else
+         (match (context->string
+                 (continuation-mark-set->context (exn-continuation-marks exn)))
+           ["" (void)]
+           [s (display-commented (string-append "Context:\n"
+                                                s))])]))
+
+(define (context->string xs)
+  ;; Limit the context in two ways:
+  ;; 1. Don't go beyond error-print-context-length
+  ;; 2. Don't go into "system" context that's just noisy.
+  (string-join (for/list ([x xs]
+                          [_ (error-print-context-length)]
+                          #:unless (system-context? x))
+                 (context-item->string x))
+               "\n"))
+
+(define-runtime-path here "error.rkt")
+(define (system-context? ci)
+  (match-define (cons id src) ci)
+  (or (not src)
+      (let ([src (srcloc-source src)])
+        (and (path? src)
+             (or (equal? (path-only src) (path-only here))
+                 (under-system-path? src))))))
+
+(define (under-system-path? path)
+  (match (path->collects-relative path)
+    [`(collects #"mred" . ,_) #t]
+    [`(collects #"racket" #"contract" . ,_) #t]
+    [`(collects #"racket" #"private" . ,_) #t]
+    [`(collects #"typed-racket" . ,_) #t]
+    [_ #f]))
+
+(define (context-item->string ci)
+  (match-define (cons id src) ci)
+  (string-append (if (or src id) " " "")
+                 (if src (source-location->string src) "")
+                 (if (and src id) " " "")
+                 (if id (format "~a" id) "")))
+
+;; Don't use source-location->string from syntax/srcloc. Don't want
+;; the setup/path-to-relative behavior that replaces full pathnames
+;; with <collects>, <pkgs> etc. Instead want full pathnames for Emacs'
+;; compilation-mode. HOWEVER note that <collects> or <pkgs> might be
+;; baked into exn-message string already; we handle that in
+;; `fully-qualify-error-path`. Here we handle only strings we create
+;; ourselves, such as for the Context "stack trace".
+(define (source-location->string x)
+  (match-define (srcloc src line col pos span) x)
+  (format "~a:~a:~a" src (or line "1") (or col "1")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Fully qualified pathnames in error messages, so that Emacs
+;; compilation-mode can do its stuff.
+
+;; srcloc->string uses current-directory-for-user to shorten error
+;; messages. But we always want full pathnames. Setting it to
+;; 'pref-dir -- very unlikely user .rkt file will be there -- is
+;; least-worst way AFAIK.
+(define (show-full-path-in-errors)
+  (current-directory-for-user (find-system-path 'pref-dir)))
+
+;; If this looks like a Racket error message, but the filename is
+;; not fully-qualified, prepend curdir to the filename.
+;;
+;; This covers Racket 5.3.6 and earlier. In fact, this might be
+;; sufficient for _all_ versions of Racket and we don't need the
+;; `show-full-path-in-errors` thing above, at all. Not yet sure.
+(define (fully-qualify-error-path s)
+  (match s
+    [(pregexp "^([^/.]+)\\.([^.]+):(\\d+)[:.](\\d+):(.*)$"
+              (list _ base ext line col more))
+     (define curdir (path->string (current-directory)))
+     (string-append curdir base "." ext ":" line ":" col ":" more)]
+    [s (regexp-replace* #rx"<collects>"
+                        s
+                        (path->string (find-collects-dir)))]))
+
+(module+ test
+  (require rackunit)
+  (check-equal?
+   (parameterize ([current-directory "/tmp/"])
+     (fully-qualify-error-path "foo.rkt:3:0: f: unbound identifier\n   in: f"))
+   "/tmp/foo.rkt:3:0: f: unbound identifier\n   in: f")
+  (check-equal?
+   (fully-qualify-error-path "/tmp/foo.rkt:3:0: f: unbound identifier\n   in: f")
+   "/tmp/foo.rkt:3:0: f: unbound identifier\n   in: f")
+  (let ([o (open-output-string)])
+    (parameterize ([current-error-port o])
+      (display-srclocs (make-exn:fail:read "..."
+                                           (current-continuation-marks)
+                                           '())))
+    (check-equal? (get-output-string o) "")))
+
+(define maybe-suggest-packages
+  (with-handlers ([exn:fail? (λ _ void)])
+    (with-dynamic-requires ([racket/base exn:missing-module?]
+                            [racket/base exn:missing-module-accessor]
+                            [pkg/db      get-catalogs]
+                            [pkg/lib     pkg-catalog-suggestions-for-module])
+      (λ (exn)
+        (when (exn:missing-module? exn)
+          (match (get-catalogs)
+            [(list)
+             (display-commented
+              @~a{-----
+                  Can't suggest packages to install, because pkg/db get-catalogs is '().
+                  To configure:
+                  1. Start DrRacket.
+                  2. Choose "File | Package Mananger".
+                  3. Click "Available from Catalog".
+                  4. When prompted, click "Update".
+                  -----})]
+            [_
+             (define mod ((exn:missing-module-accessor exn) exn))
+             (match (pkg-catalog-suggestions-for-module mod)
+               [(list) void]
+               [(list p)
+                (display-commented
+                 @~a{Try "raco pkg install @|p|" ?})]
+               [(? list? ps)
+                (display-commented
+                 @~a{Try "raco pkg install" one of @(string-join ps ", ") ?})]
+               [_ void])]))))))
+
+(module+ test
+  ;; Point of this test is older Rackets where the with-handlers
+  ;; clause is exercised.
+  (check-not-exn
+   (λ ()
+     (maybe-suggest-packages (exn:fail "" (current-continuation-marks))))))

elpa/racket-mode-20181004.309/racket/example/example.rkt

@@ -0,0 +1,302 @@
+;; -*- racket-indent-sequence-depth: 100; racket-indent-curly-as-sequence: t; -*-
+
+;;; NOTE: After changing this file you will need to M-x faceup-write-file
+;;; to regenerate the .faceup test comparison file.
+;;;
+;;; NOTE: You may need to disable certain features -- for example
+;;; global-paren-face-mode -- during the M-x faceup-write-file.
+
+#lang racket
+
+(require xml)
+(provide valid-bucket-name?)
+
+;; Various def* forms are font-locked:
+
+(define (function foo)
+  #t)
+
+(define ((curried-function x) y)
+  (list x y))
+
+(define a-var 10)
+
+(define/contract (f2 x)
+  (any/c . -> . any)
+  #t)
+
+(define-values (1st-var 2nd-var) (values 1 2))
+
+(define-thing foo)  ;bug 276
+
+;; let: font-lock identifiers
+
+(let ([foo 10]
+      [bar 20])
+  foo)
+
+(let loop ([x 10])
+  (unless (zero? x)
+    (loop (sub1 x))))
+
+(let* ([foo 10]
+       [bar 20])
+  foo)
+
+(let-values ([(a b) (values 1 2)])
+  (values a b))
+
+(let*-values ([(a b) (values 1 2)])
+  (values a b))
+
+(letrec-values ([(a b) (values 1 2)])
+  (values a b))
+
+(let-syntax ([foo #'foo])
+  foo)
+
+(letrec-syntax ([foo #'foo])
+  foo)
+
+(let-syntaxes ([(foo) #'foo])
+  foo)
+
+(letrec-syntaxes ([(foo) #'foo])
+  foo)
+
+(letrec-syntaxes+values ([(foo) #'foo])
+                        ([(a b) (values 1 2)])
+  foo)
+
+;; for/fold is indented correctly:
+(for/fold ([str ""])
+          ([ss '("a" "b" "c")])
+  (string-append str ss))
+
+;; Auto-converts word `lambda` to `λ`:
+(lambda (x) #t)
+
+;; Or use M-C-y to insert to insert `λ` char.
+
+;; Smart indentation for quoted lists:
+'(1 2
+  3 4)
+
+;; Smart indentation for vector literals:
+#(1 2
+  3 4)
+
+;; Smart indentation for Rackjure dict literals:
+(module x rackjure
+  {'a 0
+   'b 2})
+
+;; Silly test submodule example.
+;; Try using C-c C-f to Fold (hide) it, and C-c C-u to Unfold it.
+(module+ test
+  (require rackunit)
+  (check-true #t))
+
+;; Single line comment
+
+#|
+
+Multi-line
+comment
+
+|#
+
+#;(sexpr comment)
+
+;; Nested sexpr comments
+
+(list 2
+      #;2)
+
+(list 1
+      #;4
+      #;(3))
+
+(let (#;[x #;1]
+      [y 2])
+  y)
+
+(define x #<<FOO
+asdfasdf
+asdfasdf
+asdfasdf
+FOO
+  )
+
+#;(define x #<<BAR
+asdfasdf
+asdfasdf
+asdfasdf
+BAR
+    )
+
+|identifier with spaces|
+
+|;no comment|
+
+| #|no comment|# |
+
+(define (a-function x #:keyword [y 0])
+  (and (append (car '(1 2 3))))
+  (regexp-match? #rx"foobar" "foobar")
+  (regexp-match? #px"foobar" "foobar")
+  (define a 1)
+  (let ([a "foo"]
+        [b "bar"])
+    (displayln b))
+  (let* ([a "foo"]
+         [b "bar"])
+    (displayln b))
+  (let-values ([(a b) (values 1 2)])
+    #t)
+  (for/list ([x (in-list (list 1 2 (list 3 4)))])
+    (cond [(pair? x) (car x)]
+          [else x])))
+
+;; Issue 261
+"@|widget-id|" @|foo|
+
+;; Issue 298
+(define x (begin "|" '\|))
+
+(define (foo)
+  (let ([x 10])
+    #t)
+
+  (let ([x 1]
+        [y 2])
+    #t)
+
+  (define 1/2-the-way 0)
+  (define less-than-1/2 0)
+
+  ;; Self-eval examples
+  (values
+   1/2-the-way                            ;should NOT be self-eval
+   less-than-1/2                          ;should NOT be self-eval
+   +inf.0
+   -inf.0
+   +nan.0
+   #t
+   #f
+   1
+   1.0
+   1/2
+   -1/2
+   #b100
+   #o123
+   #d123
+   #x7f7f
+   'symbol
+   '|symbol with spaces|
+   '|;no comment|
+   '| #|no comment|# |
+   'symbol-with-no-alpha/numeric-chars
+   #\c
+   #\space
+   #\newline
+
+   ;; Literal number examples
+
+   ;; #b
+   #b1.1
+   #b-1.1
+   #b1e1
+   #b0/1
+   #b1/1
+   #b1e-1
+   #b101
+
+   ;; #d
+   #d-1.23
+   #d1.123
+   #d1e3
+   #d1e-22
+   #d1/2
+   #d-1/2
+   #d1
+   #d-1
+
+   ;; No # reader prefix -- same as #d
+   -1.23
+   1.123
+   1e3
+   1e-22
+   1/2
+   -1/2
+   1
+   -1
+
+   ;; #e
+   #e-1.23
+   #e1.123
+   #e1e3
+   #e1e-22
+   #e1
+   #e-1
+   #e1/2
+   #e-1/2
+
+   ;; #i always float
+   #i-1.23
+   #i1.123
+   #i1e3
+   #i1e-22
+   #i1/2
+   #i-1/2
+   #i1
+   #i-1
+
+   ;; #o
+   #o777.777
+   #o-777.777
+   #o777e777
+   #o777e-777
+   #o3/7
+   #o-3/7
+   #o777
+   #o-777
+
+   ;; #x
+   #x-f.f
+   #xf.f
+   #x-f
+   #xf
+   ))
+
+(define/contract (valid-bucket-name? s #:keyword [dns-compliant? #t])
+  ((string?) (#:keyword boolean?) . ->* . boolean?)
+  (cond
+    [dns-compliant?
+     (and (<= 3 (string-length s)) (<= (string-length s) 63)
+          (not (regexp-match #px"\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}" s))
+          (for/and ([s (regexp-split #rx"\\." s)])
+            (define (valid-first-or-last? c)
+              (or (char-lower-case? (string-ref s 0))
+                  (char-numeric? (string-ref s 0))))
+            (define (valid-mid? c)
+              (or (valid-first-or-last? c)
+                  (equal? c #\-)))
+            (define len (string-length s))
+            (and (< 0 len)
+                 (valid-first-or-last? (string-ref s 0))
+                 (valid-first-or-last? (string-ref s (sub1 len)))
+                 (or (<= len 2)
+                     (for/and ([c (substring s 1 (sub1 len))])
+                       (valid-mid? c))))))]
+    [else
+     (and (<= (string-length s) 255)
+          (for/and ([c s])
+            (or (char-numeric? c)
+                (char-lower-case? c)
+                (char-upper-case? c)
+                (equal? c #\.)
+                (equal? c #\-)
+                (equal? c #\_))))]))
+
+(displayln "I'm running!")

elpa/racket-mode-20181004.309/racket/example/example.rkt.faceup

@@ -0,0 +1,302 @@
+«m:;; »«x:-*- racket-indent-sequence-depth: 100; racket-indent-curly-as-sequence: t; -*-
+»
+«m:;;; »«x:NOTE: After changing this file you will need to M-x faceup-write-file
+»«m:;;; »«x:to regenerate the .faceup test comparison file.
+»«m:;;;»«x:
+»«m:;;; »«x:NOTE: You may need to disable certain features -- for example
+»«m:;;; »«x:global-paren-face-mode -- during the M-x faceup-write-file.
+»
+«k:#lang» «v:racket»
+
+(«k:require» xml)
+(«k:provide» valid-bucket-name?)
+
+«m:;; »«x:Various def* forms are font-locked:
+»
+(«k:define» («f:function» foo)
+  «:racket-selfeval-face:#t»)
+
+(«k:define» ((«f:curried-function» x) y)
+  («b:list» x y))
+
+(«k:define» «v:a-var» «:racket-selfeval-face:10»)
+
+(«b:define/contract» («f:f2» x)
+  («b:any/c» . «b:->» . «b:any»)
+  «:racket-selfeval-face:#t»)
+
+(«k:define-values» («v:1st-var 2nd-var») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»))
+
+(define-thing «v:foo»)  «m:;»«x:bug 276
+»
+«m:;; »«x:let: font-lock identifiers
+»
+(«k:let» ([«v:foo» «:racket-selfeval-face:10»]
+      [«v:bar» «:racket-selfeval-face:20»])
+  foo)
+
+(«k:let» «f:loop» ([«v:x» «:racket-selfeval-face:10»])
+  («k:unless» («b:zero?» x)
+    (loop («b:sub1» x))))
+
+(«k:let*» ([«v:foo» «:racket-selfeval-face:10»]
+       [«v:bar» «:racket-selfeval-face:20»])
+  foo)
+
+(«k:let-values» ([(«v:a» «v:b») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
+  («b:values» a b))
+
+(«k:let*-values» ([(«v:a» «v:b») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
+  («b:values» a b))
+
+(«k:letrec-values» ([(«v:a» «v:b») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
+  («b:values» a b))
+
+(«k:let-syntax» ([«v:foo» #«:racket-selfeval-face:'foo»])
+  foo)
+
+(«k:letrec-syntax» ([«v:foo» #«:racket-selfeval-face:'foo»])
+  foo)
+
+(«k:let-syntaxes» ([(«v:foo») #«:racket-selfeval-face:'foo»])
+  foo)
+
+(«k:letrec-syntaxes» ([(«v:foo») #«:racket-selfeval-face:'foo»])
+  foo)
+
+(«k:letrec-syntaxes+values» ([(«v:foo») #«:racket-selfeval-face:'foo»])
+                        ([(a b) («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
+  foo)
+
+«m:;; »«x:for/fold is indented correctly:
+»(«k:for/fold» ([str «s:""»])
+          ([ss '(«s:"a"» «s:"b"» «s:"c"»)])
+  («b:string-append» str ss))
+
+«m:;; »«x:Auto-converts word `lambda` to `λ`:
+»(«k:lambda» (x) «:racket-selfeval-face:#t»)
+
+«m:;; »«x:Or use M-C-y to insert to insert `λ` char.
+»
+«m:;; »«x:Smart indentation for quoted lists:
+»'(«:racket-selfeval-face:1» «:racket-selfeval-face:2»
+  «:racket-selfeval-face:3» «:racket-selfeval-face:4»)
+
+«m:;; »«x:Smart indentation for vector literals:
+»#(«:racket-selfeval-face:1» «:racket-selfeval-face:2»
+  «:racket-selfeval-face:3» «:racket-selfeval-face:4»)
+
+«m:;; »«x:Smart indentation for Rackjure dict literals:
+»(«k:module» «f:x» «v:rackjure»
+  {«:racket-selfeval-face:'a» «:racket-selfeval-face:0»
+   «:racket-selfeval-face:'b» «:racket-selfeval-face:2»})
+
+«m:;; »«x:Silly test submodule example.
+»«m:;; »«x:Try using C-c C-f to Fold (hide) it, and C-c C-u to Unfold it.
+»(«k:module+» «f:test»
+  («k:require» rackunit)
+  (check-true «:racket-selfeval-face:#t»))
+
+«m:;; »«x:Single line comment
+»
+«x:#|
+
+Multi-line
+comment
+
+|#»
+
+«m:#;»«x:(sexpr comment)»
+
+«m:;; »«x:Nested sexpr comments
+»
+(«b:list» «:racket-selfeval-face:2»
+      «m:#;»«x:2»)
+
+(«b:list» «:racket-selfeval-face:1»
+      «m:#;»«x:4»
+      «m:#;»«x:(3)»)
+
+(«k:let» («m:#;»«x:[x #;1]»
+      [«v:y» «:racket-selfeval-face:2»])
+  y)
+
+(«k:define» «v:x» «:racket-here-string-face:#<<FOO
+asdfasdf
+asdfasdf
+asdfasdf
+FOO
+»  )
+
+«m:#;»«x:(define x #<<BAR
+asdfasdf
+asdfasdf
+asdfasdf
+BAR
+    )»
+
+|identifier with spaces|
+
+|;no comment|
+
+| #|no comment|# |
+
+(«k:define» («f:a-function» x «:racket-keyword-argument-face:#:keyword» [y «:racket-selfeval-face:0»])
+  («k:and» («b:append» («b:car» '(«:racket-selfeval-face:1» «:racket-selfeval-face:2» «:racket-selfeval-face:3»))))
+  («b:regexp-match?» «:racket-selfeval-face:#rx»«s:"foobar"» «s:"foobar"»)
+  («b:regexp-match?» «:racket-selfeval-face:#px»«s:"foobar"» «s:"foobar"»)
+  («k:define» «v:a» «:racket-selfeval-face:1»)
+  («k:let» ([«v:a» «s:"foo"»]
+        [«v:b» «s:"bar"»])
+    («b:displayln» b))
+  («k:let*» ([«v:a» «s:"foo"»]
+         [«v:b» «s:"bar"»])
+    («b:displayln» b))
+  («k:let-values» ([(«v:a» «v:b») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
+    «:racket-selfeval-face:#t»)
+  («k:for/list» ([x («k:in-list» («b:list» «:racket-selfeval-face:1» «:racket-selfeval-face:2» («b:list» «:racket-selfeval-face:3» «:racket-selfeval-face:4»)))])
+    («k:cond» [(«b:pair?» x) («b:car» x)]
+          [«k:else» x])))
+
+«m:;; »«x:Issue 261
+»«s:"@|widget-id|"» @|foo|
+
+«m:;; »«x:Issue 298
+»(«k:define» «v:x» («k:begin» «s:"|"» '\|))
+
+(«k:define» («f:foo»)
+  («k:let» ([«v:x» «:racket-selfeval-face:10»])
+    «:racket-selfeval-face:#t»)
+
+  («k:let» ([«v:x» «:racket-selfeval-face:1»]
+        [«v:y» «:racket-selfeval-face:2»])
+    «:racket-selfeval-face:#t»)
+
+  («k:define» «v:1/2-the-way» «:racket-selfeval-face:0»)
+  («k:define» «v:less-than-1/2» «:racket-selfeval-face:0»)
+
+  «m:;; »«x:Self-eval examples
+»  («b:values»
+   1/2-the-way                            «m:;»«x:should NOT be self-eval
+»   less-than-1/2                          «m:;»«x:should NOT be self-eval
+»   «:racket-selfeval-face:+inf.0»
+   «:racket-selfeval-face:-inf.0»
+   «:racket-selfeval-face:+nan.0»
+   «:racket-selfeval-face:#t»
+   «:racket-selfeval-face:#f»
+   «:racket-selfeval-face:1»
+   «:racket-selfeval-face:1.0»
+   «:racket-selfeval-face:1/2»
+   «:racket-selfeval-face:-1/2»
+   «:racket-selfeval-face:#b100»
+   «:racket-selfeval-face:#o123»
+   «:racket-selfeval-face:#d123»
+   «:racket-selfeval-face:#x7f7f»
+   «:racket-selfeval-face:'symbol»
+   «:racket-selfeval-face:'|symbol with spaces|»
+   «:racket-selfeval-face:'|;no comment|»
+   «:racket-selfeval-face:'| #|no comment|# |»
+   «:racket-selfeval-face:'symbol-with-no-alpha/numeric-chars»
+   «:racket-selfeval-face:#\c»
+   «:racket-selfeval-face:#\space»
+   «:racket-selfeval-face:#\newline»
+
+   «m:;; »«x:Literal number examples
+»
+   «m:;; »«x:#b
+»   «:racket-selfeval-face:#b1.1»
+   «:racket-selfeval-face:#b-1.1»
+   «:racket-selfeval-face:#b1e1»
+   «:racket-selfeval-face:#b0/1»
+   «:racket-selfeval-face:#b1/1»
+   «:racket-selfeval-face:#b1e-1»
+   «:racket-selfeval-face:#b101»
+
+   «m:;; »«x:#d
+»   «:racket-selfeval-face:#d-1.23»
+   «:racket-selfeval-face:#d1.123»
+   «:racket-selfeval-face:#d1e3»
+   «:racket-selfeval-face:#d1e-22»
+   «:racket-selfeval-face:#d1/2»
+   «:racket-selfeval-face:#d-1/2»
+   «:racket-selfeval-face:#d1»
+   «:racket-selfeval-face:#d-1»
+
+   «m:;; »«x:No # reader prefix -- same as #d
+»   «:racket-selfeval-face:-1.23»
+   «:racket-selfeval-face:1.123»
+   «:racket-selfeval-face:1e3»
+   «:racket-selfeval-face:1e-22»
+   «:racket-selfeval-face:1/2»
+   «:racket-selfeval-face:-1/2»
+   «:racket-selfeval-face:1»
+   «:racket-selfeval-face:-1»
+
+   «m:;; »«x:#e
+»   «:racket-selfeval-face:#e-1.23»
+   «:racket-selfeval-face:#e1.123»
+   «:racket-selfeval-face:#e1e3»
+   «:racket-selfeval-face:#e1e-22»
+   «:racket-selfeval-face:#e1»
+   «:racket-selfeval-face:#e-1»
+   «:racket-selfeval-face:#e1/2»
+   «:racket-selfeval-face:#e-1/2»
+
+   «m:;; »«x:#i always float
+»   «:racket-selfeval-face:#i-1.23»
+   «:racket-selfeval-face:#i1.123»
+   «:racket-selfeval-face:#i1e3»
+   «:racket-selfeval-face:#i1e-22»
+   «:racket-selfeval-face:#i1/2»
+   «:racket-selfeval-face:#i-1/2»
+   «:racket-selfeval-face:#i1»
+   «:racket-selfeval-face:#i-1»
+
+   «m:;; »«x:#o
+»   «:racket-selfeval-face:#o777.777»
+   «:racket-selfeval-face:#o-777.777»
+   «:racket-selfeval-face:#o777e777»
+   «:racket-selfeval-face:#o777e-777»
+   «:racket-selfeval-face:#o3/7»
+   «:racket-selfeval-face:#o-3/7»
+   «:racket-selfeval-face:#o777»
+   «:racket-selfeval-face:#o-777»
+
+   «m:;; »«x:#x
+»   «:racket-selfeval-face:#x-f.f»
+   «:racket-selfeval-face:#xf.f»
+   «:racket-selfeval-face:#x-f»
+   «:racket-selfeval-face:#xf»
+   ))
+
+(«b:define/contract» («f:valid-bucket-name?» s «:racket-keyword-argument-face:#:keyword» [dns-compliant? «:racket-selfeval-face:#t»])
+  ((«b:string?») («:racket-keyword-argument-face:#:keyword» «b:boolean?») . «b:->*» . «b:boolean?»)
+  («k:cond»
+    [dns-compliant?
+     («k:and» («b:<=» «:racket-selfeval-face:3» («b:string-length» s)) («b:<=» («b:string-length» s) «:racket-selfeval-face:63»)
+          («b:not» («b:regexp-match» «:racket-selfeval-face:#px»«s:"\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}"» s))
+          («k:for/and» ([s («b:regexp-split» «:racket-selfeval-face:#rx»«s:"\\."» s)])
+            («k:define» («f:valid-first-or-last?» c)
+              («k:or» («b:char-lower-case?» («b:string-ref» s «:racket-selfeval-face:0»))
+                  («b:char-numeric?» («b:string-ref» s «:racket-selfeval-face:0»))))
+            («k:define» («f:valid-mid?» c)
+              («k:or» (valid-first-or-last? c)
+                  («b:equal?» c «:racket-selfeval-face:#\-»)))
+            («k:define» «v:len» («b:string-length» s))
+            («k:and» («b:<» «:racket-selfeval-face:0» len)
+                 (valid-first-or-last? («b:string-ref» s «:racket-selfeval-face:0»))
+                 (valid-first-or-last? («b:string-ref» s («b:sub1» len)))
+                 («k:or» («b:<=» len «:racket-selfeval-face:2»)
+                     («k:for/and» ([c («b:substring» s «:racket-selfeval-face:1» («b:sub1» len))])
+                       (valid-mid? c))))))]
+    [«k:else»
+     («k:and» («b:<=» («b:string-length» s) «:racket-selfeval-face:255»)
+          («k:for/and» ([c s])
+            («k:or» («b:char-numeric?» c)
+                («b:char-lower-case?» c)
+                («b:char-upper-case?» c)
+                («b:equal?» c «:racket-selfeval-face:#\.»)
+                («b:equal?» c «:racket-selfeval-face:#\-»)
+                («b:equal?» c «:racket-selfeval-face:#\_»))))]))
+
+(«b:displayln» «s:"I'm running!"»)

elpa/racket-mode-20181004.309/racket/example/indent.rkt

@@ -0,0 +1,325 @@
+;; -*- racket-indent-sequence-depth: 100; racket-indent-curly-as-sequence: t; -*-
+
+;;; NOTE: After changing this file you will need to M-x faceup-write-file
+;;; to regenerate the .faceup test comparison file.
+;;;
+;;; NOTE: You may need to disable certain features -- for example
+;;; global-paren-face-mode -- during the M-x faceup-write-file.
+
+;;; Quoted list
+
+'(a b
+  (a b
+   c))
+
+'((1) 2 3
+  (3)
+  4 5)
+
+;;; Quasiquoted list (align with head) and unquote or unquote-splicing
+;;; (use normal indent rules for the form).
+
+`(Part ()
+  (PartNumber ()
+   ,part)
+  (ETag ()
+   ,etag))
+
+`((,(x)
+   ,y))
+
+`(Delete
+  ,@(for/list ([p (in-list paths)])
+      `(Object ()
+        (Key () ,p))))
+
+;;; Syntax
+
+#'(for/list ([x xs])
+    x)
+
+#`(for/list ([x xs])
+    x)
+
+#'(#%app (#%app hasheq (quote a) (quote 42))
+         (quote a))
+
+(#%app (#%app hasheq (quote a) (quote 42))
+       (quote a))
+
+#'(foo (#%app hasheq (quote a) (quote 42))
+       (quote a))
+
+;;; Rackjure style dictionary (when racket-indent-curly-as-sequence is t).
+
+{a b
+ c d}
+
+{a b
+ c d
+ b '(a x
+     s (x y
+        x v))}
+
+;;; Vector
+
+#(a b
+  c d)
+
+;;; List with a keyword as first member (e.g. in many contracts)
+
+(#:x y
+ #:y x)
+
+;;; Normal function application.
+
+(foobar x
+        y
+        z)
+
+(foobar
+ x
+ y
+ z)
+
+(dict-set a
+          b
+          c)
+
+(dict-set
+ a
+ b
+ c)
+
+(call-with-values (lambda () (values 1 2))
+                  +)
+
+(call-with-values
+ (lambda () (values 1 2))
+ +)
+
+;;; Forms with special indentation
+
+(let ([x 0])
+  x)
+
+;; indent 2
+
+(syntax-case stx ()
+  [(_ x) #'#f]
+  [(_ x y) #'#t])
+
+;; indent 3
+
+(syntax-case* stx () x
+  [(_ x) #'#f]
+  [(_ x y) #'#t])
+
+(syntax-case*
+    stx
+    (#%module-begin
+     module
+     define-values
+     define-syntaxes
+     define
+     define/contract
+     define-syntax
+     struct
+     define-struct)
+    x
+  [(_ x) #'#f]
+  [(_ x y) #'#t])
+
+;; begin and cond have 0 style
+(begin
+  0
+  0)
+
+(begin 0
+       0)
+
+(cond [1 2]
+      [3 4])
+
+(cond
+  [1 2]
+  [3 4])
+
+(if a
+    x
+    x)
+
+;; begin*
+
+(begin-for-foo 0
+               0)
+
+(begin-for-foo
+  0
+  0)
+
+(with-handlers ([x y])
+  a b c)
+
+;; def, with-, call-with- and other 'defun style
+
+(define (x) x x
+  x)
+
+(struct x x
+  ())
+
+(match-define (list x y)
+  (list 1 2))
+
+(with-output-to-file path #:mode 'text #:exists 'replace
+  (λ () (display "Hello, world.")))
+
+(call-with-output-file path #:mode 'text #:exists 'replace
+  (λ (out) (display "Hello, world." out)))
+
+
+;;; Special forms: When the first non-distinguished form is on the
+;;; same line as distinguished forms, disregard it for indent.
+
+;; module has indent 2
+
+(module 1
+    2
+  3
+  4
+  5)
+
+;; Normal case
+(module 1 2
+  3
+  4
+  5)
+
+;; Weird case -- but this is how scheme-mode indents it.
+(module 1 2 3
+        4
+        5)
+
+;; Weird case -- but this is how scheme-mode indents it.
+(module 1 2 3 4
+        5)
+
+;;; for/fold
+
+;; for/fold untyped, accum on same line
+(for/fold ([a 0]
+           [b 0])
+          ([x 0]
+           [y 0])
+  #t)
+
+;; for/fold untyped, accum on different line
+(for/fold
+    ([a 0]
+     [b 0])
+    ([x 0]
+     [y 0])
+  #t)
+
+;; for/fold typed, type on same line
+(for/fold : T
+    ([a 0]
+     [b 0])
+    ([x 0]
+     [y 0])
+  #t)
+
+;; for/fold typed, type on different line
+(for/fold
+    : T
+    ([a 0]
+     [b 0])
+    ([x 0]
+     [y 0])
+  #t)
+
+;;; Bug #50
+
+'((x
+   y) A
+  z
+  (x
+   y) A
+  z)
+
+(match args
+  [(list x) (x
+             y)] ...
+  [(list x) (x y)] ...
+  [(list x) (x y)] ...)
+
+(define-syntax (fstruct stx)
+  (syntax-parse stx
+    [(_ id:id (field:id ...))
+     (with-syntax ([(accessor ...)
+                    (for/list ([fld (in-list (syntax->list #'(field ...)))])
+                      (format-id stx "~a-~a" (syntax->datum #'id) fld))])
+       #'(serializable-struct
+          id (field ...) #:transparent
+          #:property prop:procedure
+          (lambda (self . args)
+            (match args
+              [(list 'field) (accessor self)] ...
+              [(list (list 'field)) (accessor self)] ...
+              [(list (list-rest 'field fields)) ((accessor self) fields)] ...
+              [(list-rest 'field f args)
+               (struct-copy id self
+                            [field (apply f (accessor self) args)])] ...
+              [(list-rest (list 'field) f args)  ;<-- THIS SEXPR IS INDENTED TOO FAR
+               (struct-copy id self
+                            [field (apply f (accessor self) args)])] ...
+              [(list-rest (list-rest 'field fields) args)
+               (struct-copy id self
+                            [field (apply (accessor self) fields args)])] ...))))]))
+
+;; Bug #123
+
+#hash([a . (#hash()
+            0)]
+      [b . (#hasheq()
+            0)]
+      [c . (#fx(0 1 2)
+            0)]
+      [d . (#fx3(0 1 2)
+            0)]
+      [e . (#fl(0.0 1.0 2.0)
+            0)]
+      [f . (#fl3(0.0 1.0 2.0)
+            0)]
+      [g . (#s(foo x)
+            0)]
+      [h . (#3(0 1 2)
+            0)])
+
+;; Bug #136
+
+#;(list 1
+        #;2
+        3)
+
+(list 1
+      #;(list 1
+              (let ([x 2]
+                    #;[y 3])
+                x)
+              3)
+      2
+      3)
+
+;; Bug #243
+(cond [x y
+         z]
+      [(= a x) y
+               z])
+
+;; Bug #262
+(define-metafunction λL
+  ∪ : (x ...) ... -> (x ...)
+  [(∪ any_ls ...)
+   ,(apply append (term (any_ls ...)))])

elpa/racket-mode-20181004.309/racket/example/indent.rkt.faceup

@@ -0,0 +1,325 @@
+«m:;; »«x:-*- racket-indent-sequence-depth: 100; racket-indent-curly-as-sequence: t; -*-
+»
+«m:;;; »«x:NOTE: After changing this file you will need to M-x faceup-write-file
+»«m:;;; »«x:to regenerate the .faceup test comparison file.
+»«m:;;;»«x:
+»«m:;;; »«x:NOTE: You may need to disable certain features -- for example
+»«m:;;; »«x:global-paren-face-mode -- during the M-x faceup-write-file.
+»
+«m:;;; »«x:Quoted list
+»
+'(a b
+  (a b
+   c))
+
+'((«:racket-selfeval-face:1») «:racket-selfeval-face:2» «:racket-selfeval-face:3»
+  («:racket-selfeval-face:3»)
+  «:racket-selfeval-face:4» «:racket-selfeval-face:5»)
+
+«m:;;; »«x:Quasiquoted list (align with head) and unquote or unquote-splicing
+»«m:;;; »«x:(use normal indent rules for the form).
+»
+`(Part ()
+  (PartNumber ()
+   ,part)
+  (ETag ()
+   ,etag))
+
+`((,(x)
+   ,y))
+
+`(Delete
+  ,@(«k:for/list» ([p («k:in-list» paths)])
+      `(«t:Object» ()
+        (Key () ,p))))
+
+«m:;;; »«x:Syntax
+»
+#'(«k:for/list» ([x xs])
+    x)
+
+#`(«k:for/list» ([x xs])
+    x)
+
+#'(«k:#%app» («k:#%app» «b:hasheq» («k:quote» a) («k:quote» «:racket-selfeval-face:42»))
+         («k:quote» a))
+
+(«k:#%app» («k:#%app» «b:hasheq» («k:quote» a) («k:quote» «:racket-selfeval-face:42»))
+       («k:quote» a))
+
+#'(foo («k:#%app» «b:hasheq» («k:quote» a) («k:quote» «:racket-selfeval-face:42»))
+       («k:quote» a))
+
+«m:;;; »«x:Rackjure style dictionary (when racket-indent-curly-as-sequence is t).
+»
+{a b
+ c d}
+
+{a b
+ c d
+ b '(a x
+     s (x y
+        x v))}
+
+«m:;;; »«x:Vector
+»
+#(a b
+  c d)
+
+«m:;;; »«x:List with a keyword as first member (e.g. in many contracts)
+»
+(«:racket-keyword-argument-face:#:x» y
+ «:racket-keyword-argument-face:#:y» x)
+
+«m:;;; »«x:Normal function application.
+»
+(foobar x
+        y
+        z)
+
+(foobar
+ x
+ y
+ z)
+
+(«b:dict-set» a
+          b
+          c)
+
+(«b:dict-set»
+ a
+ b
+ c)
+
+(«b:call-with-values» («k:lambda» () («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»))
+                  «b:+»)
+
+(«b:call-with-values»
+ («k:lambda» () («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»))
+ «b:+»)
+
+«m:;;; »«x:Forms with special indentation
+»
+(«k:let» ([«v:x» «:racket-selfeval-face:0»])
+  x)
+
+«m:;; »«x:indent 2
+»
+(«k:syntax-case» stx ()
+  [(«k:_» x) #«:racket-selfeval-face:'#f»]
+  [(«k:_» x y) #«:racket-selfeval-face:'#t»])
+
+«m:;; »«x:indent 3
+»
+(«k:syntax-case*» stx () x
+  [(«k:_» x) #«:racket-selfeval-face:'#f»]
+  [(«k:_» x y) #«:racket-selfeval-face:'#t»])
+
+(«k:syntax-case*»
+    stx
+    («k:#%module-begin»
+     «k:module»
+     «k:define-values»
+     «k:define-syntaxes»
+     «k:define»
+     «b:define/contract»
+     «k:define-syntax»
+     «k:struct»
+     «k:define-struct»)
+    x
+  [(«k:_» x) #«:racket-selfeval-face:'#f»]
+  [(«k:_» x y) #«:racket-selfeval-face:'#t»])
+
+«m:;; »«x:begin and cond have 0 style
+»(«k:begin»
+  «:racket-selfeval-face:0»
+  «:racket-selfeval-face:0»)
+
+(«k:begin» «:racket-selfeval-face:0»
+       «:racket-selfeval-face:0»)
+
+(«k:cond» [«:racket-selfeval-face:1» «:racket-selfeval-face:2»]
+      [«:racket-selfeval-face:3» «:racket-selfeval-face:4»])
+
+(«k:cond»
+  [«:racket-selfeval-face:1» «:racket-selfeval-face:2»]
+  [«:racket-selfeval-face:3» «:racket-selfeval-face:4»])
+
+(«k:if» a
+    x
+    x)
+
+«m:;; »«x:begin*
+»
+(begin-for-foo «:racket-selfeval-face:0»
+               «:racket-selfeval-face:0»)
+
+(begin-for-foo
+  «:racket-selfeval-face:0»
+  «:racket-selfeval-face:0»)
+
+(«k:with-handlers» ([x y])
+  a b c)
+
+«m:;; »«x:def, with-, call-with- and other 'defun style
+»
+(«k:define» («f:x») x x
+  x)
+
+(«k:struct» x x
+  ())
+
+(«b:match-define» («b:list» x y)
+  («b:list» «:racket-selfeval-face:1» «:racket-selfeval-face:2»))
+
+(«k:with-output-to-file» path «:racket-keyword-argument-face:#:mode» «:racket-selfeval-face:'text» «:racket-keyword-argument-face:#:exists» «:racket-selfeval-face:'replace»
+  («k:λ» () («b:display» «s:"Hello, world."»)))
+
+(«k:call-with-output-file» path «:racket-keyword-argument-face:#:mode» «:racket-selfeval-face:'text» «:racket-keyword-argument-face:#:exists» «:racket-selfeval-face:'replace»
+  («k:λ» (out) («b:display» «s:"Hello, world."» out)))
+
+
+«m:;;; »«x:Special forms: When the first non-distinguished form is on the
+»«m:;;; »«x:same line as distinguished forms, disregard it for indent.
+»
+«m:;; »«x:module has indent 2
+»
+(«k:module» «:racket-selfeval-face:1»
+    «:racket-selfeval-face:2»
+  «:racket-selfeval-face:3»
+  «:racket-selfeval-face:4»
+  «:racket-selfeval-face:5»)
+
+«m:;; »«x:Normal case
+»(«k:module» «:racket-selfeval-face:1» «:racket-selfeval-face:2»
+  «:racket-selfeval-face:3»
+  «:racket-selfeval-face:4»
+  «:racket-selfeval-face:5»)
+
+«m:;; »«x:Weird case -- but this is how scheme-mode indents it.
+»(«k:module» «:racket-selfeval-face:1» «:racket-selfeval-face:2» «:racket-selfeval-face:3»
+        «:racket-selfeval-face:4»
+        «:racket-selfeval-face:5»)
+
+«m:;; »«x:Weird case -- but this is how scheme-mode indents it.
+»(«k:module» «:racket-selfeval-face:1» «:racket-selfeval-face:2» «:racket-selfeval-face:3» «:racket-selfeval-face:4»
+        «:racket-selfeval-face:5»)
+
+«m:;;; »«x:for/fold
+»
+«m:;; »«x:for/fold untyped, accum on same line
+»(«k:for/fold» ([a «:racket-selfeval-face:0»]
+           [b «:racket-selfeval-face:0»])
+          ([x «:racket-selfeval-face:0»]
+           [y «:racket-selfeval-face:0»])
+  «:racket-selfeval-face:#t»)
+
+«m:;; »«x:for/fold untyped, accum on different line
+»(«k:for/fold»
+    ([a «:racket-selfeval-face:0»]
+     [b «:racket-selfeval-face:0»])
+    ([x «:racket-selfeval-face:0»]
+     [y «:racket-selfeval-face:0»])
+  «:racket-selfeval-face:#t»)
+
+«m:;; »«x:for/fold typed, type on same line
+»(«k:for/fold» «b::» T
+    ([a «:racket-selfeval-face:0»]
+     [b «:racket-selfeval-face:0»])
+    ([x «:racket-selfeval-face:0»]
+     [y «:racket-selfeval-face:0»])
+  «:racket-selfeval-face:#t»)
+
+«m:;; »«x:for/fold typed, type on different line
+»(«k:for/fold»
+    «b::» T
+    ([a «:racket-selfeval-face:0»]
+     [b «:racket-selfeval-face:0»])
+    ([x «:racket-selfeval-face:0»]
+     [y «:racket-selfeval-face:0»])
+  «:racket-selfeval-face:#t»)
+
+«m:;;; »«x:Bug #50
+»
+'((x
+   y) A
+  z
+  (x
+   y) A
+  z)
+
+(«b:match» args
+  [(«b:list» x) (x
+             y)] «k:...»
+  [(«b:list» x) (x y)] «k:...»
+  [(«b:list» x) (x y)] «k:...»)
+
+(«k:define-syntax» («f:fstruct» stx)
+  («b:syntax-parse» stx
+    [(«k:_» id:id (field:id «k:...»))
+     («k:with-syntax» ([(accessor «k:...»)
+                    («k:for/list» ([fld («k:in-list» («b:syntax->list» #'(«b:field» «k:...»)))])
+                      («b:format-id» stx «s:"~a-~a"» («b:syntax->datum» #«:racket-selfeval-face:'id») fld))])
+       #'(serializable-struct
+          id («b:field» «k:...») «:racket-keyword-argument-face:#:transparent»
+          «:racket-keyword-argument-face:#:property» «b:prop:procedure»
+          («k:lambda» (self . args)
+            («b:match» args
+              [(«b:list» «:racket-selfeval-face:'field») (accessor self)] «k:...»
+              [(«b:list» («b:list» «:racket-selfeval-face:'field»)) (accessor self)] «k:...»
+              [(«b:list» (list-rest «:racket-selfeval-face:'field» fields)) ((accessor self) fields)] «k:...»
+              [(list-rest «:racket-selfeval-face:'field» f args)
+               («k:struct-copy» id self
+                            [«b:field» («k:apply» f (accessor self) args)])] «k:...»
+              [(list-rest («b:list» «:racket-selfeval-face:'field») f args)  «m:;»«x:<-- THIS SEXPR IS INDENTED TOO FAR
+»               («k:struct-copy» id self
+                            [«b:field» («k:apply» f (accessor self) args)])] «k:...»
+              [(list-rest (list-rest «:racket-selfeval-face:'field» fields) args)
+               («k:struct-copy» id self
+                            [«b:field» («k:apply» (accessor self) fields args)])] «k:...»))))]))
+
+«m:;; »«x:Bug #123
+»
+#hash([a . (#hash()
+            «:racket-selfeval-face:0»)]
+      [b . (#hasheq()
+            «:racket-selfeval-face:0»)]
+      [c . (#fx(«:racket-selfeval-face:0» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)
+            «:racket-selfeval-face:0»)]
+      [d . (#fx3(«:racket-selfeval-face:0» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)
+            «:racket-selfeval-face:0»)]
+      [e . (#fl(«:racket-selfeval-face:0.0» «:racket-selfeval-face:1.0» «:racket-selfeval-face:2.0»)
+            «:racket-selfeval-face:0»)]
+      [f . (#fl3(«:racket-selfeval-face:0.0» «:racket-selfeval-face:1.0» «:racket-selfeval-face:2.0»)
+            «:racket-selfeval-face:0»)]
+      [g . (#s(foo x)
+            «:racket-selfeval-face:0»)]
+      [h . (#3(«:racket-selfeval-face:0» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)
+            «:racket-selfeval-face:0»)])
+
+«m:;; »«x:Bug #136
+»
+«m:#;»«x:(list 1
+        #;2
+        3)»
+
+(«b:list» «:racket-selfeval-face:1»
+      «m:#;»«x:(list 1
+              (let ([x 2]
+                    #;[y 3])
+                x)
+              3)»
+      «:racket-selfeval-face:2»
+      «:racket-selfeval-face:3»)
+
+«m:;; »«x:Bug #243
+»(«k:cond» [x y
+         z]
+      [(«b:=» a x) y
+               z])
+
+«m:;; »«x:Bug #262
+»(define-metafunction «v:λL»
+  ∪ «b::» (x «k:...») «k:...» «b:->» (x «k:...»)
+  [(∪ any_ls «k:...»)
+   ,(«k:apply» «b:append» (term (any_ls «k:...»)))])

elpa/racket-mode-20181004.309/racket/find-module-path-completions.rkt

@@ -0,0 +1,45 @@
+#lang racket/base
+
+;;; `racket-open-require-path' uses `tq' to run us. We repeatedly
+;;; read-line a query and display the answer as lines terminated by a
+;;; blank line.
+;;;
+;;; This was created because the original attempt, using
+;;; `racket--eval/sexpr', couldn't keep up with fast typing. This new
+;;; approach is more direct (e.g. no converting to/from sexprs) and
+;;; fast enough. Using `tq' provides a "type-ahead buffer" (in lieu of
+;;; the old approach's use of `run-with-timer') even though in my
+;;; testing so far it's rarely needed.
+;;;
+;;; The case where `find-module-path-completions' isn't available: We
+;;; don't error, we simply always return empty matches. (This might
+;;; not be ideal but I initially had trouble making `tq' recognize
+;;; e.g. an (exit 1) here and handle it smoothly. Maybe it would work
+;;; to change our "protocol" to have an initial question and answer
+;;; devoted to this. For example "HELLO?\n" => "OK\n\n" / "ERROR\n\n".
+;;; Thereafter the status quo loop.)
+
+(require racket/match)
+
+(module+ main
+  (define dir (current-directory)) ;FIXME: Get from command-line
+  (define display-choices (init dir))
+  (let loop ()
+    (define str (read-line))
+    (unless (string=? "" str)
+      (display-choices str)
+      (displayln "") ;; terminating blank line
+      (flush-output)
+      (loop)))
+  (exit 0))
+
+
+(define (init dir)
+  (with-handlers ([exn:fail? (λ _ (λ _ (void)))])
+    ;; (error 'test-error) ;<- un-comment this to exercise failure path
+    (define fmpc (dynamic-require 'drracket/find-module-path-completions
+                                  'find-module-path-completions))
+    (define get (fmpc dir))
+    (λ (str)
+      (for ([x (in-list (get str))])
+        (displayln (path->string (cadr x)))))))

elpa/racket-mode-20181004.309/racket/find.rkt

@@ -0,0 +1,235 @@
+#lang racket/base
+
+(require racket/contract
+         (only-in racket/format ~a)
+         racket/list
+         racket/match
+         "syntax.rkt")
+
+(provide find-definition
+         find-signature)
+
+(define location/c (list/c path-string? natural-number/c natural-number/c))
+
+;; Try to find the definition of `str`, returning a list with the file
+;; name, line and column, 'kernel, or #f if not found.
+(define/contract (find-definition str)
+  (-> string? (or/c #f 'kernel location/c))
+  (match (find-definition/stx str)
+    [(list* stx file submods)
+     (list (path->string (or (syntax-source stx) file))
+           (or (syntax-line stx) 1)
+           (or (syntax-column stx) 0))]
+    [v v]))
+
+;; Try to find the definition of `str`, returning its signature or #f.
+;; When defined in 'kernel, returns a form saying so, not #f.
+(define/contract (find-signature str)
+  (-> string? (or/c #f pair?))
+  (match (find-definition/stx str)
+    ['kernel '("defined in #%kernel, signature unavailable")]
+    [(list* id-stx file submods)
+     (define file-stx (file->syntax file))
+     (define sub-stx (submodule file submods file-stx))
+     (match ($signature (syntax-e id-stx) sub-stx)
+       [(? syntax? stx) (syntax->datum stx)]
+       [_ #f])]
+    [v v]))
+
+(define/contract (find-definition/stx str)
+  (-> string?
+      (or/c #f 'kernel (cons/c syntax? (cons/c path? (listof symbol?)))))
+  (match (identifier-binding* str)
+    [(? list? xs)
+     (define ht (make-hash)) ;cache in case source repeated
+     (for/or ([x (in-list (remove-duplicates xs))])
+       (match x
+         [(cons id 'kernel) 'kernel]
+         [(list* id file submods)
+          (define (sub-stx file->stx)
+            (hash-ref! ht (cons file file->stx)
+                       (λ () (submodule file submods (file->stx file)))))
+          (match (or ($definition id (sub-stx file->expanded-syntax))
+                     (match ($renaming-provide id (sub-stx file->syntax))
+                       [(? syntax? s)
+                        ($definition (syntax-e s) (sub-stx file->expanded-syntax))]
+                       [_ #f]))
+            [#f  #f]
+            [stx (list* stx file submods)])]))]
+    [_ #f]))
+
+;; Distill identifier-binding to what we need. Unfortunately it can't
+;; report the definition id in the case of a contract-out and a
+;; rename-out, both. For `(provide (contract-out [rename orig new
+;; contract]))` it reports (1) the contract-wrapper as the id, and (2)
+;; `new` as the nominal-id -- but NOT (3) `orig`. Instead the caller
+;; will need try using `renaming-provide`.
+(define/contract (identifier-binding* v)
+  (-> (or/c string? symbol? identifier?)
+      (or/c #f
+            (listof (cons/c symbol?
+                            (or/c 'kernel
+                                  (cons/c path-string? (listof symbol?)))))))
+  (define sym->id namespace-symbol->identifier)
+  (define id (cond [(string? v)     (sym->id (string->symbol v))]
+                   [(symbol? v)     (sym->id v)]
+                   [(identifier? v) v]))
+  (match (identifier-binding id)
+    [(list source-mpi         source-id
+           nominal-source-mpi nominal-source-id
+           source-phase import-phase nominal-export-phase)
+     (list (cons source-id         (mpi->path source-mpi))
+           (cons nominal-source-id (mpi->path nominal-source-mpi)))]
+    [_ #f]))
+
+(define/contract (mpi->path mpi)
+  (-> module-path-index?
+      (or/c 'kernel
+            (cons/c path-string? (listof symbol?))))
+  (define (hash-bang-symbol? v)
+    (and (symbol? v)
+         (regexp-match? #px"^#%" (symbol->string v))))
+  (match (resolved-module-path-name (module-path-index-resolve mpi))
+    [(? hash-bang-symbol?) 'kernel]
+    [(? path-string? path) (list path)]
+    [(? symbol? sym) (list (build-path (current-load-relative-directory)
+                                       (~a sym ".rkt")))]
+    [(list (? path-string? path) (? symbol? subs) ...)
+     (list* path subs)]))
+
+;; For use with syntax-case*. When we use syntax-case for syntax-e equality.
+(define (syntax-e-eq? a b)
+  (eq? (syntax-e a) (syntax-e b)))
+
+(define ((make-eq-sym? sym) stx)
+  (and (eq? sym (syntax-e stx)) stx))
+
+(define (file-module file)
+  (match (path->string (last (explode-path file)))
+    [(pregexp "(.+?)\\.rkt$" (list _ v)) (string->symbol v)]))
+
+;; Return bodies (wrapped in begin) of the module indicated by
+;; file and sub-mod-syms.
+(define (submodule file sub-mod-syms stx)
+  (submodule* (cons (file-module file) sub-mod-syms) stx))
+
+(define (submodule* mods stx)
+  (match-define (cons this more) mods)
+  (define (subs stxs)
+    (if (empty? more)
+        #`(begin . #,stxs)
+         (ormap (λ (stx) (submodule* more stx))
+                (syntax->list stxs))))
+  (syntax-case* stx (module #%module-begin) syntax-e-eq?
+    [(module name _ (#%module-begin . stxs))
+     (eq? this (syntax-e #'name))
+     (subs #'stxs)]
+    [(module name _ . stxs)
+     (eq? this (syntax-e #'name))
+     (subs #'stxs)]
+    [_ #f]))
+
+(module+ test
+  (require rackunit)
+  (check-equal? (syntax->datum
+                 (submodule "/path/to/file.rkt" '(a b c)
+                            #'(module file racket
+                                (module a racket
+                                  (module not-b racket #f)
+                                  (module b racket
+                                    (module not-c racket #f)
+                                    (module c racket "bingo")
+                                    (module not-c racket #f))
+                                  (module not-b racket #f)))))
+                '(begin "bingo")))
+
+;; Given a symbol and syntax, return syntax corresponding to the
+;; definition. Intentionally does NOT walk into module forms, so, give
+;; us the module bodies wrapped in begin.
+;;
+;; If `stx` is expanded we can find things defined via definer
+;; macros.
+;;
+;; If `stx` is not expanded, we will miss some things, however the
+;; syntax will be closer to what a human expects -- e.g. `(define (f
+;; x) x)` instead of `(define-values (f) (lambda (x) x))`.
+(define ($definition sym stx) ;;symbol? syntax? -> syntax?
+  (define eq-sym? (make-eq-sym? sym))
+  ;; This is a hack to handle definer macros that neglect to set
+  ;; srcloc properly using syntax/loc or (format-id ___ #:source __):
+  ;; If the stx lacks srcloc and its parent stx has srcloc, return the
+  ;; parent stx instead. Caveats: 1. Assumes caller only cares about
+  ;; the srcloc. 2. We only check immediate parent. 3. We only use
+  ;; this for define-values and define-syntaxes, below, on the
+  ;; assumption that this only matters for fully-expanded syntax.
+  (define (loc s)
+    (if (and (not (syntax-line s))
+             (syntax-line stx))
+        stx
+        s))
+  (syntax-case* stx
+      (begin define-values define-syntaxes
+             define define/contract
+             define-syntax struct define-struct)
+      syntax-e-eq?
+    [(begin . stxs)                 (ormap (λ (stx) ($definition sym stx))
+                                           (syntax->list #'stxs))]
+    [(define          (s . _) . _)  (eq-sym? #'s) stx]
+    [(define/contract (s . _) . _)  (eq-sym? #'s) stx]
+    [(define s . _)                 (eq-sym? #'s) stx]
+    [(define-values (ss ...) . _)   (ormap eq-sym? (syntax->list #'(ss ...)))
+                                    (loc (ormap eq-sym? (syntax->list #'(ss ...))))]
+    [(define-syntax (s .  _) . _)   (eq-sym? #'s) stx]
+    [(define-syntax s . _)          (eq-sym? #'s) stx]
+    [(define-syntaxes (ss ...) . _) (ormap eq-sym? (syntax->list #'(ss ...)))
+                                    (loc (ormap eq-sym? (syntax->list #'(ss ...))))]
+    [(define-struct s . _)          (eq-sym? #'s) stx]
+    [(define-struct (s _) . _)      (eq-sym? #'s) stx]
+    [(struct s . _)                 (eq-sym? #'s) stx]
+    [(struct (s _) . _)             (eq-sym? #'s) stx]
+    [_                              #f]))
+
+;; Given a symbol and syntax, return syntax corresponding to the
+;; function definition signature. The input syntax should NOT be
+;; `expand`ed. This intentionally does NOT walk into module forms, so,
+;; give us the module bodies wrapped in begin.
+(define ($signature sym stx) ;;symbol? syntax? -> (or/c #f list?)
+  (define eq-sym? (make-eq-sym? sym))
+  (syntax-case* stx (begin define define/contract case-lambda) syntax-e-eq?
+    [(begin . stxs)                               (ormap (λ (stx) ($signature sym stx))
+                                                         (syntax->list #'stxs))]
+    [(define          (s . as) . _)               (eq-sym? #'s) #'(s . as)]
+    [(define/contract (s . as) . _)               (eq-sym? #'s) #'(s . as)]
+    [(define s (case-lambda [(ass ...) . _] ...)) (eq-sym? #'s) #'((s ass ...) ...)]
+    [_                                            #f]))
+
+;; Find sym in a contracting and/or renaming provide, and return the
+;; syntax for the ORIGINAL identifier (before being contracted and/or
+;; renamed). The input syntax should NOT be expanded.
+(define ($renaming-provide sym stx) ;;symbol? syntax? -> syntax?
+  (define eq-sym? (make-eq-sym? sym))
+  (syntax-case* stx (begin provide provide/contract) syntax-e-eq?
+    [(begin . stxs)
+     (ormap (λ (stx) ($renaming-provide sym stx))
+            (syntax->list #'stxs))]
+    [(provide/contract . stxs)
+     (for/or ([stx (syntax->list #'stxs)])
+       (syntax-case stx ()
+         [(s _) (eq-sym? #'s)]
+         [_     #f]))]
+    [(provide . stxs)
+     (for/or ([stx (syntax->list #'stxs)])
+       (syntax-case* stx (contract-out rename-out) syntax-e-eq?
+         [(contract-out . stxs)
+          (for/or ([stx (syntax->list #'stxs)])
+            (syntax-case* stx (rename) syntax-e-eq?
+              [(rename orig s _) (eq-sym? #'s) #'orig]
+              [(s _)             (eq-sym? #'s) #'s]
+              [_                 #f]))]
+         [(rename-out . stxs)
+          (for/or ([stx (syntax->list #'stxs)])
+            (syntax-case* stx () syntax-e-eq?
+              [(orig s) (eq-sym? #'s) #'orig]
+              [_        #f]))]
+         [_ #f]))]
+    [_              #f]))

elpa/racket-mode-20181004.309/racket/fresh-line.rkt

@@ -0,0 +1,37 @@
+#lang racket/base
+
+(provide fresh-line
+         zero-column!)
+
+;; Borrowed from xrepl
+
+(define last-output-port #f)
+(define last-error-port  #f)
+
+(define (maybe-new-output-ports)
+  (define-syntax-rule (maybe last cur)
+    (unless (eq? last cur)
+      (when (and last
+                 (not (port-closed? last)))
+        (flush-output last)) ;just in case
+      (set! last cur)
+      (flush-output last)
+      (port-count-lines! last)))
+  (maybe last-output-port (current-output-port))
+  (maybe last-error-port (current-error-port)))
+
+(define (fresh-line [stderr? #f])
+  (maybe-new-output-ports)
+  (define port (if stderr? last-error-port last-output-port))
+  (flush-output port)
+  (define-values [line col pos] (port-next-location port))
+  (unless (eq? col 0) (newline)))
+
+(define (zero-column!)
+  ;; there's a problem whenever there's some printout followed by a
+  ;; read: the cursor will be at column zero, but the port counting
+  ;; will think that it's still right after the printout; call this
+  ;; function in such cases to adjust the column to 0.
+  (maybe-new-output-ports)
+  (define-values [line col pos] (port-next-location last-output-port))
+  (set-port-next-location! last-output-port line 0 pos))

elpa/racket-mode-20181004.309/racket/gui.rkt

@@ -0,0 +1,42 @@
+#lang at-exp racket/base
+
+(require (only-in racket/format ~a)
+         "util.rkt")
+
+(provide gui-required?
+         require-gui
+         txt/gui)
+
+(define root-eventspace #f) ;#f until racket/gui/base required first time
+
+(define (gui-required?)
+  (and root-eventspace #t))
+
+;; Extra explanation for situations like issue 93, entering `(require
+;; redex)` in the REPL, as opposed to having it in a .rkt file.
+(define more-explanation
+  @~a{The namespace was reset. Any `require`s you entered in the REPL were "undone".
+      This includes the `require` you just entered. You may want to enter it again.})
+
+;; This must be called from the main thread, under the main custodian!
+(define (require-gui in-repl?)
+  (when (gui-required?)
+    (error 'require-gui "Already required"))
+  (display-commented "On-demand, one-time instantiation of racket/gui/base.")
+  (when in-repl?
+    (display-commented more-explanation))
+  (define current-eventspace (gui-dyn-req 'current-eventspace))
+  (define make-eventspace    (gui-dyn-req 'make-eventspace))
+  (set! root-eventspace (make-eventspace))
+  (current-eventspace root-eventspace))
+
+;; Like mz/mr from racket/sandbox.
+(define-syntax txt/gui
+  (syntax-rules ()
+    [(_ txtval guisym)
+     (if (gui-required?)
+         (gui-dyn-req 'guisym)
+         txtval)]))
+
+(define (gui-dyn-req sym)
+  (dynamic-require 'racket/gui/base sym))

elpa/racket-mode-20181004.309/racket/image.rkt

@@ -0,0 +1,26 @@
+#lang racket/base
+
+;;; Portions Copyright (C) 2012 Jose Antonio Ortega Ruiz.
+
+(require file/convertible
+         racket/file
+         racket/vector)
+
+(provide convert-image?
+         convert-image)
+
+;; save-temporary-image : bytes? -> string?
+;;
+;; Write bytes to a temporary file and return "#<Image: filename>".
+(define (save-temporary-image png-bytes)
+  (define filename (make-temporary-file "racket-image-~a.png"))
+  (with-output-to-file filename #:exists 'truncate
+    (λ () (display png-bytes)))
+  (format "#<Image: ~a>" filename))
+
+(define (convert-image? v)
+  (convertible? v))
+
+(define (convert-image v)
+  (cond [(and (convertible? v) (convert v 'png-bytes)) => save-temporary-image]
+        [else v]))

elpa/racket-mode-20181004.309/racket/instrument.rkt

@@ -0,0 +1,225 @@
+#lang at-exp racket/base
+
+(require (only-in errortrace/errortrace-key
+                  errortrace-key)
+         (only-in errortrace/errortrace-lib
+                  print-error-trace
+                  error-context-display-depth)
+         (only-in errortrace/stacktrace
+                  stacktrace^
+                  stacktrace@
+                  stacktrace-imports^)
+         racket/format
+         racket/match
+         racket/unit
+         syntax/parse
+         "util.rkt")
+
+(provide make-instrumented-eval-handler
+         error-context-display-depth
+         print-error-trace
+         instrumenting-enabled
+         test-coverage-enabled
+         clear-test-coverage-info!
+         get-test-coverage-info
+         profiling-enabled
+         clear-profile-info!
+         get-profile-info)
+
+;;; Core instrumenting
+
+(define instrumenting-enabled (make-parameter #f))
+
+;; These two parameters added to errortrace/stacktrace circa 6.0. They
+;; help make-st-mark capture the original, unexpanded syntax, which is
+;; nicer to report in a stack trace. Lacking that in older Rackets,
+;; the srcloc is still correct and Emacs next-error will work.
+(define original-stx (with-handlers ([exn:fail? (λ _ (make-parameter #f))])
+                       (dynamic-require 'errortrace/stacktrace 'original-stx)))
+(define expanded-stx (with-handlers ([exn:fail? (λ _ (make-parameter #f))])
+                       (dynamic-require 'errortrace/stacktrace 'expanded-stx)))
+
+(define ((make-instrumented-eval-handler [orig-eval (current-eval)]) orig-exp)
+  ;; This is modeled after the one in DrRacket.
+  (cond
+    [(or (not (instrumenting-enabled))
+         (compiled-expression? (syntax-or-sexpr->sexpr orig-exp)))
+     (orig-eval orig-exp)]
+    [else
+     (let loop ([exp (syntax-or-sexpr->syntax orig-exp)])
+       (let ([top-e (expand-syntax-to-top-form exp)])
+         (syntax-case top-e (begin)
+           [(begin expr ...)
+            ;; Found a `begin', so expand/eval each contained
+            ;; expression one at a time
+            (let i-loop ([exprs (syntax->list #'(expr ...))]
+                         [last-one (list (void))])
+              (cond
+                [(null? exprs)
+                 (apply values last-one)]
+                [else
+                 (i-loop (cdr exprs)
+                         (call-with-values
+                          (λ ()
+                            (call-with-continuation-prompt
+                             (λ () (loop (car exprs)))
+                             (default-continuation-prompt-tag)
+                             (λ args
+                               (apply
+                                abort-current-continuation
+                                (default-continuation-prompt-tag)
+                                args))))
+                          list))]))]
+           [_else
+            ;; Not `begin', so proceed with normal expand and eval
+            (let* ([expanded-e (expand-syntax top-e)]
+                   ;; For make-st-mark to work correctly we need to
+                   ;; parameterize original-stx and expanded-stx.
+                   [annotated (parameterize ([original-stx top-e]
+                                             [expanded-stx expanded-e])
+                                (annotate-top expanded-e
+                                              (namespace-base-phase)))])
+              (warn-about-time-apply expanded-e)
+              (orig-eval annotated))])))]))
+
+(define (warn-about-time-apply stx)
+  (syntax-parse stx
+    #:datum-literals (#%app time-apply)
+    [(#%app time-apply . _)
+     (display-commented
+      @~a{Warning: time or time-apply used in errortrace annotated code.
+                   For meaningful timings, use command-line racket instead!})
+       #t]
+    [(ss ...) (for/or ([stx (in-list (syntax->list #'(ss ...)))])
+                  (warn-about-time-apply stx))]
+    [_ #f]))
+
+
+;;; Better stack traces ("basic errortrace")
+
+(define base-phase
+  (variable-reference->module-base-phase (#%variable-reference)))
+
+(define (with-mark mark expr phase)
+  ;; This is modeled after the one in errortrace-lib. Specifically,
+  ;; use `make-st-mark' for its capture of the original syntax to show
+  ;; in the stack trace error message.
+  (match (make-st-mark mark phase)
+    [#f  expr]
+    [loc (define phase-shift (- phase base-phase))
+         (with-syntax ([expr expr]
+                       [loc loc]
+                       [errortrace-key errortrace-key]
+                       [qte (syntax-shift-phase-level #'quote phase-shift)]
+                       [wcm (syntax-shift-phase-level #'with-continuation-mark
+                                                      phase-shift)])
+           (syntax (wcm (qte errortrace-key)
+                        loc
+                        expr)))]))
+
+;; print-error-trace
+;;
+;; Just re-provide the one from errortrace-lib because (a) it works
+;; and (b) the `make-st-mark' representation is intentionally not
+;; documented.
+
+
+;;; Test coverage
+
+(define test-coverage-enabled (make-parameter #f)) ;stacktrace-imports^
+
+(define test-coverage-info (make-hasheq)) ;(hash/c syntax? mpair?).
+;; This approach taken from DrR. Presumably set-mcar! is faster than a
+;; box, which in turn is faster than hash-set!. The cdr cell is
+;; ignored.
+
+(define (clear-test-coverage-info!)
+  (hash-clear! test-coverage-info))
+
+(define (initialize-test-coverage-point expr) ;stacktrace-imports^
+  (hash-set! test-coverage-info expr (mcons #f #f)))
+
+(define (test-covered expr) ;stacktrace-imports^
+  (define v (hash-ref test-coverage-info expr #f))
+  (and v (with-syntax ([v v])
+           #'(#%plain-app set-mcar! v #t))))
+
+(define (get-test-coverage-info)
+  ;; Due to macro expansion (e.g. to an `if` form), there may be
+  ;; multiple data points for the exact same source location. We want
+  ;; to logically OR them: If any are true, the source location is
+  ;; covered.
+  (define ht (make-hash)) ;; (list src pos span) => cover?
+  (for* ([(stx v) (in-hash  test-coverage-info)]
+         [cover?  (in-value (mcar v))]
+         [loc     (in-value (list (syntax-source stx)
+                                  (syntax-position stx)
+                                  (syntax-span stx)))])
+    (match (hash-ref ht loc 'none)
+      ['none (hash-set! ht loc cover?)]
+      [#f    (when cover? (hash-set! ht loc #t))]
+      [#t    (void)]))
+  (for/list ([(loc cover?) (in-hash ht)])
+    (cons cover? loc)))
+
+;;; Profiling
+
+(define profile-key (gensym)) ;stacktrace-imports^
+
+(define profiling-enabled (make-parameter #f)) ;stacktrace-imports^
+
+(define profile-info (make-hasheq)) ;(hash/c any/c prof?)
+
+
+(define (clear-profile-info!)
+  (hash-clear! profile-info))
+
+(struct prof
+  (nest? ;guard nested calls
+   num   ;exact-nonnegative-integer?
+   time  ;exact-nonnegative-integer?
+   name  ;(or/c #f symbol?)
+   expr) ;syntax?
+  #:mutable
+  #:transparent)
+
+(define (initialize-profile-point key name expr) ;stacktrace-imports^
+  (hash-set! profile-info
+             key
+             (prof #f 0 0 (and (syntax? name) (syntax-e name)) expr)))
+
+(define (register-profile-start key) ;stacktrace-imports^
+  (define p (hash-ref profile-info key))
+  (set-prof-num! p (add1 (prof-num p)))
+  (cond [(prof-nest? p) #f]
+        [else (set-prof-nest?! p #t)
+              (current-process-milliseconds)]))
+
+(define (register-profile-done key start) ;stacktrace-imports^
+  (void
+   (when start
+     (define p (hash-ref profile-info key))
+     (set-prof-nest?! p #f)
+     (set-prof-time! p (+ (- (current-process-milliseconds) start)
+                          (prof-time p))))))
+
+(define (get-profile-info)
+  (for/list ([x (in-list (hash-values profile-info))])
+    (match-define (prof nest? count msec name stx) x)
+    (list count msec name stx)))
+
+
+;;; Finally, invoke the unit
+(define-values/invoke-unit/infer stacktrace@)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; example
+
+;; (parameterize ([instrumenting-enabled #t]
+;;                [test-coverage-enabled #t]
+;;                [profiling-enabled #f]
+;;                [current-eval (make-instrumented-eval-handler (current-eval))])
+;;   (namespace-require (string->path "/tmp/simple.rkt")))
+;; (get-test-coverage-info)
+;; (get-profile-info)

elpa/racket-mode-20181004.309/racket/interactions.rkt

@@ -0,0 +1,84 @@
+#lang racket/base
+
+(require racket/match
+         "fresh-line.rkt")
+
+(provide current-sync/yield
+         get-interaction)
+
+;; A channel to which a thread puts interactions that it reads using
+;; the current-read-interaction handler (which can be set by a lang
+;; from its configure-runtime, so, this should be compatible with
+;; any lang, even non-sexpr langs).
+;;
+;; This is its own thread and channel for a couple reasons:
+;;
+;; - Issue #311. A consumer can use sync/timeout to avoid displaying a
+;;   prompt when multiple interactions are waiting.
+;;
+;; - Debugging. We can switch from the normal REPL to a debugger REPL,
+;;   without input being stuck inside a read call for the former.
+;;
+;; One wrinkle is we need to be careful about calling yield instead of
+;; sync when the gui is active. See issue #326.
+
+;; FIXME??: This used to be under the REPL custodian. Is it OK for it
+;; _not_ to be, now? For instance what if user runs another file, but
+;; this is still using the previous current-read-interaction value?
+(define chan (make-channel))
+
+(define (read-interaction/put-channel)
+  (define in ((current-get-interaction-input-port)))
+  (define (read-interaction)
+    (with-handlers ([exn:fail? values])
+      ((current-read-interaction) (object-name in) in))) ;[^1]
+  (match (read-interaction)
+    [(? eof-object?) (sync in)] ;[^2]
+    [(? exn:fail? e) (channel-put chan e)] ;raise in other thread
+    [v (channel-put chan v)])
+  (read-interaction/put-channel))
+
+(void (thread read-interaction/put-channel))
+
+(define current-sync/yield (make-parameter sync)) ;see issue #326
+
+(define (get-interaction prompt)
+  (match (or (sync/timeout 0.01 chan) ;see issue #311
+             (begin (display-prompt prompt)
+                    ((current-sync/yield) chan)))
+    [(? exn:fail? exn) (raise exn)]
+    [v v]))
+
+(define (display-prompt str)
+  (flush-output (current-error-port))
+  (fresh-line)
+  (display str)
+  (display "> ")
+  (flush-output)
+  (zero-column!))
+
+;; "Footnote" comments about make-prompt-read and many attempts to fix
+;; issue #305.
+;;
+;; [^1]: datalog/lang expects each interaction to be EOF terminated.
+;;       This seems to be a DrRacket convention (?). We could make
+;;       that work here if we composed open-input-string with
+;;       read-line. But that would fail for valid multi-line
+;;       expressions in langs like racket/base e.g. "(+ 1\n2)". We
+;;       could have Emacs racket-repl-submit append some marker that
+;;       lets us know to combine multiple lines here -- but we'd have
+;;       to be careful to eat the marker and avoid combining lines
+;;       when the user is entering input for their own program that
+;;       uses `read-line` etc. Trying to be clever here is maybe not
+;;       smart. I _think_ the safest thing is for each lang like
+;;       datalog to implement current-read-interaction like it says on
+;;       the tin -- it can parse just one expression/statement from a
+;;       normal, "infinite" input port; if that means the lang parser
+;;       has to be tweaked for a single-expression/statement mode of
+;;       usage, so be it.
+;;
+;; [^2]: The eof-object? clause is here only for datalog/lang
+;;       configure-runtime.rkt. Its `the-read` returns eof if
+;;       char-ready? is false. WAT. Why doesn't it just block like a
+;;       normal read-interaction handler? Catch this and wait for more
+;;       input to be available before calling it again.

elpa/racket-mode-20181004.309/racket/keywords.rkt

@@ -0,0 +1,98 @@
+#lang typed/racket/no-check
+
+(require racket/syntax)
+
+;; Generate lists for Racket keywords, builtins, and types.
+;;
+;; The question of what is a "keyword" and a "builtin" is not so
+;; simple in Racket:
+;;
+;; 1. The distinction between the two is squishy, and from one point
+;; of view Racket has 1400+ "primitives" (!).
+;;
+;; 2. As for "builtins", there are many, many "batteries included"
+;; libraries in the main distribution. Where to draw the line?
+;;
+;; 3. More fundamentally, Racket is a language for making languages.
+;; Ultimately the only way to be 100% correct is to do something
+;; "live" with namespace-mapped-symbols. But I don't see that as
+;; performant for Emacs font-lock.
+;;
+;; Here I'm saying that:
+;;
+;; (a) "keywords" are syntax (only) from racket/base
+;;
+;; (b) "builtins" are everything else provided by #lang racket and
+;; #lang typed/racket (except the capitalized Types from typed/racket
+;; go into their own list). Plus for modern macros, racket/syntax and
+;; a few items from syntax/parse (but not its the syntax classes,
+;; because `id` and `str` are too "generic" and too likely to be user
+;; program identifiers).
+;;
+;; Is that somewhat arbitrary? Hell yes. It's my least-worst,
+;; practical idea for now. Also, IMHO it's an improvement over getting
+;; pull requests to add people's favorites, a few at a time. At least
+;; this way is consistent, and can be regenerated programatically as
+;; Racket evolves.
+
+(define (symbol<=? a b)
+  (string<=? (symbol->string a) (symbol->string b)))
+
+(define (exports mod #:only-stx? [only-stx? #f])
+  (define (ids phases)
+    (for*/list ([phase phases]
+                [item (cdr phase)])
+      (car item)))
+  (define-values (vars stxs) (module->exports mod))
+  (sort (remove-duplicates (append (ids stxs)
+                                   (if only-stx? '() (ids vars)))
+                           eq?)
+        symbol<=?))
+
+(define (subtract xs ys)
+  (for*/list ([x xs] #:when (not (memq x ys))) x))
+
+(define base-stx (exports 'racket/base #:only-stx? #t))
+
+(define rkt      (append (exports 'racket)
+                         (exports 'racket/syntax)
+                         '(syntax-parse syntax-parser define-simple-macro)))
+(define rkt+     (subtract rkt base-stx))
+
+(define tr       (exports 'typed/racket))
+(define tr+      (subtract tr rkt)) ;This includes Types, too
+
+(define Types    (for/list ([x tr+]
+                            #:when (char-upper-case? (string-ref (symbol->string x) 0)))
+                   x))
+
+;;; The final lists
+
+(define keywords base-stx)
+
+(define builtins
+  (sort (subtract (remove-duplicates (append rkt+
+                                             (subtract tr+ Types))
+                                     eq?)
+                  base-stx)
+        symbol<=?))
+;; So many builtins, Emacs gives "regexp too long" error, so split into two:
+(define-values (builtins1 builtins2)
+  (let ([mid (/ (length builtins) 2)])
+    (for/fold ([xs '()]
+               [ys '()])
+              ([x builtins]
+               [i (in-naturals)])
+      (cond [(< i mid) (values (cons x xs) ys)]
+            [else      (values xs (cons x ys))]))))
+
+(define types Types)
+
+(define (prn xs)
+  (pretty-print (map symbol->string (sort xs symbol<=?))))
+
+;; Run these to print, copy and paste into racket-keywords-and-builtins.el
+;; (prn types)
+;; (prn keywords)
+;; (prn builtins1)
+;; (prn builtins2)

elpa/racket-mode-20181004.309/racket/logger.rkt

@@ -0,0 +1,93 @@
+#lang at-exp racket/base
+
+(require racket/match
+         racket/format
+         racket/tcp
+         "elisp.rkt"
+         "util.rkt")
+
+(provide start-logger-server)
+
+;; "On start-up, Racket creates an initial logger that is used to
+;; record events from the core run-time system. For example, an 'debug
+;; event is reported for each garbage collection (see Garbage
+;; Collection)." Use that; don't create new one. See issue #325.
+(define global-logger (current-logger))
+
+(define (start-logger-server port launch-token)
+  (void (thread (logger-thread port launch-token))))
+
+(define ((logger-thread port launch-token))
+  (define listener (tcp-listen port 4 #t "127.0.0.1"))
+  (let accept ()
+    (define-values (in out) (tcp-accept listener))
+    (unless (or (not launch-token)
+                      (equal? launch-token (elisp-read in)))
+            (display-commented "Authorization failed; exiting")
+            (exit 1))
+    ;; Assumption: Any network fail means the client has disconnected,
+    ;; therefore we should go back to waiting to accept a connection.
+    (with-handlers ([exn:fail:network? void])
+      (let wait ([receiver never-evt])
+        ;; Assumption: Our Emacs code will write complete sexprs,
+        ;; therefore when `in` becomes ready `read` will return
+        ;; without blocking.
+        (match (sync in receiver)
+          [(? input-port? in) (match (read in)
+                                [(? eof-object?) (void)]
+                                [v               (wait (make-receiver v))])]
+          [(vector level message _v topic)
+           (parameterize ([current-output-port out])
+             (display-log level topic message)
+             (flush-output))
+           (wait receiver)])))
+    (close-input-port in)
+    (close-output-port out)
+    (accept)))
+
+(define (display-log level topic message)
+  (display (label level))
+  (display " ")
+  (display (ensure-topic-in-message topic message))
+  (newline))
+
+(define (ensure-topic-in-message topic message)
+  (match message
+    [(pregexp (format "^~a: " (regexp-quote (~a topic))))
+     message]
+    [message-without-topic
+     (format "~a: ~a" (or topic "*") message-without-topic)]))
+
+(module+ test
+  (require rackunit)
+  (check-equal? (ensure-topic-in-message 'topic "topic: message")
+                "topic: message")
+  (check-equal? (ensure-topic-in-message 'topic "message")
+                "topic: message")
+  (check-equal? (ensure-topic-in-message #f "message")
+                "*: message"))
+
+(define (label level)
+  ;; justify
+  (case level
+    [(debug)   "[  debug]"]
+    [(info)    "[   info]"]
+    [(warning) "[warning]"]
+    [(error)   "[  error]"]
+    [(fatal)   "[  fatal]"]
+    [else      @~a{[level]}]))
+
+(define (make-receiver alist)
+  (apply make-log-receiver (list* global-logger
+                                  (alist->spec alist))))
+
+;; Convert from ([logger . level] ...) alist to the format used by
+;; make-log-receiver: (level logger ... ... default-level). In the
+;; alist, treat the logger '* as the default level.
+(define (alist->spec xs) ;(Listof (Pairof Symbol Symbol)) -> (Listof Symbol)
+  (for/fold ([spec '()])
+            ([x (in-list xs)])
+    (append spec
+            (match x
+              [(cons '*     level) (list level)]
+              [(cons logger level) (list level logger)]))))

elpa/racket-mode-20181004.309/racket/md5.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+
+(require file/md5)
+
+(provide file->md5)
+
+(define (file->md5 file)
+  (call-with-input-file* file (compose bytes->string/utf-8 md5)))

elpa/racket-mode-20181004.309/racket/mod.rkt

@@ -0,0 +1,151 @@
+#lang at-exp racket/base
+
+(require (for-syntax racket/base
+                     syntax/parse)
+         racket/contract/base
+         racket/contract/region
+         racket/format
+         racket/match
+         racket/string
+         syntax/location
+         "util.rkt")
+
+(provide relative-module-path?
+         (struct-out mod)
+         ->mod/existing
+         maybe-mod->dir/file/rmp
+         maybe-mod->prompt-string
+         maybe-warn-about-submodules)
+
+(module+ test
+  (require rackunit))
+
+;; The subset of module-path? with a relative filename
+(define (relative-module-path? v)
+  (define (rel-path? v) ;real predicate taking any/c, unlike relative-path?
+    (and (path-string? v) (relative-path? v)))
+  (and (module-path? v)
+       (match v
+         [(? rel-path?) #t]
+         [(list 'submod (? rel-path?) (? symbol?) ..1) #t]
+         [_ #f])))
+
+(module+ test
+  (check-true (relative-module-path? "f.rkt"))
+  (check-true (relative-module-path? '(submod "f.rkt" a b)))
+  (check-false (relative-module-path? "/path/to/f.rkt"))
+  (check-false (relative-module-path? '(submod "/path/to/f.rkt" a b)))
+  (check-false (relative-module-path? 'racket/base))
+  (check-false (relative-module-path? '(submod 'racket/base a b))))
+
+(define-struct/contract mod
+  ([dir  absolute-path?]         ;#<path:/path/to/>
+   [file relative-path?]         ;#<path:foo.rkt>
+   [rmp  relative-module-path?]) ;#<path:f.rkt> or '(submod <path:f.rkt> bar)
+  #:transparent)
+
+(define/contract (->mod/simple v)
+  (-> any/c (or/c #f mod?))
+  (match v
+    [(? symbol? s) (->mod/simple (~a s))] ;treat 'file.rkt as "file.rkt"
+    [(or (? path? ap) (? path-string? ap))
+     (let*-values ([(dir file _) (split-path (simplify-path ap))]
+                   [(dir) (match dir ['relative (current-directory)][dir dir])])
+       (mod dir file file))]
+    [_ #f]))
+
+(define/contract (->mod v)
+  (-> any/c (or/c #f mod?))
+  (define-match-expander mm
+    (syntax-parser
+      [(_ dir:id file:id rmp:id)
+       #'(app ->mod/simple (mod dir file rmp))]))
+  (match v
+    [(list 'submod
+           (mm d f _) (? symbol? ss) ..1) (mod d f (list* 'submod f ss))]
+    [(list (mm d f _) (? symbol? ss) ..1) (mod d f (list* 'submod f ss))]
+    [(list (mm d f mp))                   (mod d f mp)]
+    [(mm d f mp)                          (mod d f mp)]
+    [_                                    #f]))
+
+(module+ test
+  (define-syntax-rule (= x y) (check-equal? x y))
+  (define f.rkt (string->path "f.rkt"))
+  ;; rel path
+  (let ([dir (current-directory)])
+    (= (->mod "f.rkt") (mod dir f.rkt f.rkt))
+    (= (->mod 'f.rkt)  (mod dir f.rkt f.rkt))
+    (= (->mod '(submod "f.rkt" a b)) (mod dir f.rkt `(submod ,f.rkt a b)))
+    (= (->mod '(submod f.rkt a b))   (mod dir f.rkt `(submod ,f.rkt a b)))
+    (= (->mod '("f.rkt" a b)) (mod dir f.rkt `(submod ,f.rkt a b)))
+    (= (->mod '(f.rkt a b))   (mod dir f.rkt `(submod ,f.rkt a b)))
+    (= (->mod '("f.rkt")) (mod dir f.rkt f.rkt))
+    (= (->mod '(f.rkt))   (mod dir f.rkt f.rkt)))
+  ;; abs path
+  (let ([dir (string->path "/p/t/")])
+    (= (->mod "/p/t/f.rkt") (mod dir f.rkt f.rkt))
+    (= (->mod '/p/t/f.rkt)  (mod dir f.rkt f.rkt))
+    (= (->mod '(submod "/p/t/f.rkt" a b)) (mod dir f.rkt `(submod ,f.rkt a b)))
+    (= (->mod '(submod /p/t/f.rkt a b))   (mod dir f.rkt `(submod ,f.rkt a b)))
+    (= (->mod '("/p/t/f.rkt" a b)) (mod dir f.rkt `(submod ,f.rkt a b)))
+    (= (->mod '(/p/t/f.rkt a b))   (mod dir f.rkt `(submod ,f.rkt a b)))
+    (= (->mod '("/p/t/f.rkt")) (mod dir f.rkt f.rkt))
+    (= (->mod '(/p/t/f.rkt))   (mod dir f.rkt f.rkt)))
+  ;; nonsense input => #f
+  (= (->mod 42)                #f)
+  (= (->mod '(42 'bar))        #f)
+  (= (->mod '(submod 42 'bar)) #f)
+  (= (->mod '(submod (submod "f.rkt" foo) bar)) #f))
+
+(define/contract (->mod/existing v)
+  (-> any/c (or/c #f mod?))
+  (match (->mod v)
+    [(and v (mod dir file mp))
+     (define path (build-path dir file))
+     (cond [(file-exists? path) v]
+           [else (display-commented (format "~a does not exist" path))
+                 #f])]
+    [_ #f]))
+
+(define/contract (maybe-mod->dir/file/rmp maybe-mod)
+  (-> (or/c #f mod?) (values absolute-path?
+                             (or/c #f relative-path?)
+                             (or/c #f relative-module-path?)))
+  (match maybe-mod
+    [(mod d f mp) (values d f mp)]
+    [#f           (values (current-directory) #f #f)]))
+
+(define/contract (maybe-mod->prompt-string m)
+  (-> (or/c #f mod?) string?)
+  (match m
+    [(mod _ _ (? path? file))     (~a file)]
+    [(mod _ _ (list* 'submod xs)) (string-join (map ~a xs) "/")]
+    [#f                           ""]))
+
+;; Check whether Racket is new enough (newer than 6.2.1) that
+;; module->namespace works with module+ and (module* _ #f __)
+;; forms when errortrace is enabled.
+(module+ check
+  (define x 42))
+(define (can-enter-module+-namespace?)
+  (define mp (quote-module-path check))
+  (dynamic-require mp #f)
+  (with-handlers ([exn:fail? (λ _ #f)])
+    (eval 'x (module->namespace mp))
+    #t))
+
+(define warned? #f)
+(define/contract (maybe-warn-about-submodules mp context)
+  (-> (or/c #f module-path?) symbol? any)
+  (unless (or warned?
+              (not (pair? mp)) ;not submodule
+              (memq context '(low medium))
+              (can-enter-module+-namespace?))
+    (set! warned? #t)
+    (display-commented
+     @~a{Note: @~v[@mp] will be evaluated.
+               However your Racket version is old. You will be unable to
+               use the REPL to examine definitions in the body of a module+
+               or (module* _ #f ___) form when errortrace is enabled. Either
+               upgrade Racket, or, set the Emacs variable racket-error-context
+               to 'low or 'medium.})))

elpa/racket-mode-20181004.309/racket/namespace.rkt

@@ -0,0 +1,269 @@
+#lang at-exp racket/base
+
+(require racket/contract
+         racket/file
+         racket/format
+         racket/function
+         racket/list
+         racket/match
+         syntax/modread
+         racket/path
+         syntax/parse
+         syntax/strip-context
+         syntax/stx
+         (only-in "error.rkt" display-exn)
+         "mod.rkt"
+         (only-in "util.rkt" display-commented))
+
+(provide dynamic-require/some-namespace)
+
+;; A composition of dynamic-require and module->namespace that tries
+;; to tolerate syntax errors. It tries to return a namespace with at
+;; least some identifiers from the file -- such as from module
+;; languages, requires, and definitions.
+;;
+;; Motivation:
+;;
+;;   https://github.com/greghendershott/racket-mode/issues/272
+;;
+;; You're working in #lang racket/base. You're partway through writing
+;; a some expression, and realize you need to add (say)
+;; with-module-reading-parameterization. You add syntax/modread to
+;; your require.
+;;
+;; Now, you want to type with-m and hit TAB to complete. Plus after
+;; that, you might want to C-. a.k.a. M-x racket-describe to read
+;; docs.
+;;
+;; But you need to re-run, first, for the new require to take effect
+;; and make the syntax/modread exports available.
+;;
+;; But if you re-run, your half-written expression results in a syntax
+;; or runtime error. Now your REPL is just an empty racket/base.
+;;
+;; Annoying!
+;;
+;; Strategy: When dynamic-require fails, try again using a custom load
+;; handler that rewrites the file -- "distill" it to a skeleton of
+;; module forms, requires, and define-values. Try again using that.
+;;
+;; Note that it's important for the skeleton to include submodules,
+;; because racket-mode lets you "enter" a submodule and work with
+;; identifiers inside it (and only inside it).
+
+(define is-skeleton
+  "[Due to errors, REPL is just module language, requires, and stub definitions]")
+(define is-base
+  "[Due to errors, REPL is just racket/base]")
+
+;; A composition of dynamic-require and module->namespace, but which
+;; tries to tolerate errors in the source file and return _some_
+;; namespace more useful than racket/base (if possible).
+(define/contract (dynamic-require/some-namespace mod)
+  (-> mod? namespace?)
+  (parameterize ([current-load-relative-directory (mod-dir mod)]
+                 [current-directory               (mod-dir mod)])
+    (cond [(normal   mod) => values]
+          [(skeletal mod) => (λ (ns)
+                               (display-commented is-skeleton)
+                               ns)]
+          [else           (display-commented is-base)
+                          (make-base-namespace)])))
+
+(define/contract (normal mod)
+  (-> mod? (or/c #f namespace?))
+  (with-handlers ([exn:fail? (λ (e) (display-exn e) #f)])
+    (dynamic-require (mod-rmp mod) #f)
+    (module->namespace (mod-rmp mod))))
+
+(define/contract (skeletal mod)
+  (-> mod? (or/c #f namespace?))
+  (with-handlers ([exn:fail? (const #f)]) ;don't show errors again
+    (parameterize ([current-load      (make-load mod)]
+                   ;; Module is cached in old namespace, so for `load`
+                   ;; to be called, we need a fresh namespace.
+                   [current-namespace (make-base-namespace)])
+      (dynamic-require (mod-rmp mod) #f)
+      (module->namespace (mod-rmp mod)))))
+
+(define/contract (make-load mod)
+  (-> mod? any)
+  (define original-load (current-load))
+  (define special-path (build-path (mod-dir mod) (mod-file mod)))
+  (λ (path module-name)
+    (if (equal? path special-path)
+        (eval (skeleton (read-module-file path)))
+        (original-load path module-name))))
+
+(define (read-module-file file) ;Path-String -> Syntax
+  (with-module-reading-parameterization
+    (λ ()
+      (parameterize ([read-accept-compiled #f])
+        (with-input-from-file file read-syntax)))))
+
+(define no-op-expr    #'(void))
+(define no-op-def-val #''|Due to errors in source file, this value is from a "stub" define-values|)
+
+(define (skeleton stx) ;Syntax -> Syntax
+  ;; We got here because `stx` has either a syntax error or a runtime
+  ;; error. If it has a syntax error, we can't `expand` it as whole.
+  ;; Let's try to distill it to a skeleton of things that create
+  ;; runtime, module-level bidings: requires and defines.
+  ;;
+  ;; To get #%require and define-values, we want to work with
+  ;; fully-expanded syntax as much as possible. But we have to catch
+  ;; syntax errors and replace each with #'(void). Also we want to
+  ;; walk submodule forms for their bindings, but we can't expand a
+  ;; submodule forms in isolation (that's a syntax error).
+  ;;
+  ;; So, the idea is to preserve the nested modules skeleton, and only
+  ;; try to expand each of their module-level expressions to discover
+  ;; bindings.
+  ;;
+  ;; Our final result should, as a whole, work with (eval (expand)).
+  (strip-context
+   ;; Unlike expand-syntax-to-top-form, expand-to-top-form does
+   ;; namespace-syntax-introduce before expanding to top form.
+   (let recur ([stx (expand-to-top-form stx)])
+     (syntax-parse stx
+       #:literal-sets   (kernel-literals)
+       #:datum-literals (#%module-begin module+)
+       ;; Note: A #lang file has #%module-begin even on initial read
+       ;; and without calling `expand`. However, a (module) expression
+       ;; file -- even when using with-module-reading-parameterization
+       ;; -- doesn't. That only gets added by `expand`. But we can't
+       ;; use `expand`. Anyway, it hardly matters as we're going to
+       ;; remove everything interesting that a #%module-begin might
+       ;; transform (IIUC). Just treat #%module-begin as begin.
+       [((~and mod (~or module module*)) name:id lang:expr . es)
+        #`(mod name lang . #,(stx-map recur #'es))]
+       [(#%module-begin . es)
+        #`(begin . #,(stx-map recur #'es))]
+       [(module+ name:id . es)
+        #`(module+ name . #,(stx-map recur #'es))]
+       [_
+        (let ([stx (with-handlers ([exn:fail:syntax? (const no-op-expr)])
+                     (expand stx))])
+          (syntax-parse stx
+            #:literal-sets (kernel-literals)
+            [(begin . es)                 #`(begin . #,(stx-map recur #'es))]
+            [(#%require . _)              stx]
+            [(define-values (id ...) . _) #`(define-values (id ...)
+                                              (values
+                                               #,@(stx-map (const no-op-def-val)
+                                                           #'(id ...))))]
+            [_                            no-op-expr]))]))))
+
+(module+ test
+  (require rackunit
+           racket/set
+           version/utils)
+
+  ;; A example of the transformation we do.
+  ;;
+  ;; Note: Prior to Racket 6.3, expansion of `require` with
+  ;; non-existent modules seems to be a syntax error. So in this test,
+  ;; use modules that actually exist in minimal Racket.
+  (check-equal? (syntax->datum
+                 (skeleton
+                  #'(module m racket/base
+                      (#%module-begin
+                       (require racket/pretty
+                                racket/list)
+                       (if)      ;stx err
+                       (/ 1 0)   ;runtime err
+                       (define foo 42)
+                       (define-values (bar baz) (values 43 44))
+                       (define (f x) (+ x 1))
+                       (module* m #f
+                         (require net/url)
+                         (if) ;stx err
+                         (/ 1 0)) ;runtime err
+                       (module+ test
+                         (require rackunit)
+                         (if)) ;stx err
+                       (module m typed/racket/base
+                         (#%module-begin
+                          (require racket/function)
+                          (define id 42)
+                          (if))))))) ;stx err
+                (let ([no-op-expr    (syntax->datum no-op-expr)]
+                      [no-op-def-val (syntax->datum no-op-def-val)])
+                  `(module m racket/base
+                    (begin
+                     (begin (#%require racket/pretty) (#%require racket/list))
+                     ,no-op-expr
+                     ,no-op-expr
+                     (define-values (foo) (values ,no-op-def-val))
+                     (define-values (bar baz) (values ,no-op-def-val ,no-op-def-val))
+                     (define-values (f) (values ,no-op-def-val))
+                     (module* m #f
+                      (#%require net/url)
+                      (void)
+                      (void))
+                     (module+ test
+                      (#%require rackunit)
+                      ,no-op-expr)
+                     (module m typed/racket/base
+                      (begin
+                        (#%require racket/function)
+                        (define-values (id) (values ,no-op-def-val))
+                        ,no-op-expr))))))
+
+  ;; Helpers to write text or sexpr to a tempory .rkt file, then run
+  ;; through dynamic-require/some-namespace and get the
+  ;; namespace-mapped-symbols.
+
+  (define/contract (call-with-temporary-file v proc)
+    (-> any/c (-> mod? any/c) any/c)
+    (define file #f)
+    (dynamic-wind
+      (λ ()
+        (set! file (make-temporary-file "call-with-temporary-file-~a.rkt"))
+        (call-with-output-file file #:exists 'replace
+          (λ (out)
+            (cond [(string? v) (display v out)]
+                  [else        (write v out)]))))
+      (λ () (proc (->mod/existing file)))
+      (λ () (delete-file file))))
+
+  (define/contract (syms mod)
+    (-> mod? (listof symbol?))
+    (namespace-mapped-symbols
+     (parameterize ([current-namespace (make-base-empty-namespace)])
+       (dynamic-require/some-namespace mod))))
+
+  (define (do v)
+    (define op (open-output-string))
+    (define result (parameterize ([current-error-port op])
+                     (call-with-temporary-file v syms)))
+    (check-match (get-output-string op)
+                 (regexp (string-append (regexp-quote is-skeleton) "\n$")))
+    result)
+
+  ;; Despite a syntax error and a runtime error, a binding provided by
+  ;; a require is available in the namespace in both:
+
+  ;; (a) A #lang file:
+  (check-not-false
+   (memq 'pretty-print (do @~a{#lang racket/base
+                               (if)
+                               (require racket/pretty)})))
+
+  ;; (b) A module expression file:
+  (check-not-false
+   (memq 'pretty-print (do `(module m racket/base
+                             (if)
+                             (require racket/pretty)))))
+
+  ;; Requiring exactly 1 binding adds exactly that symbol to the
+  ;; namespace:
+  (check-equal? (set-subtract
+                 (list->set
+                  (do `(module m racket/base
+                        (/ 1 0)
+                        (require (only-in racket/pretty pretty-print)))))
+                 (list->set
+                  (do `(module n racket/base
+                        (/ 1 0)))))
+                (set 'pretty-print)))

elpa/racket-mode-20181004.309/racket/run.rkt

@@ -0,0 +1,273 @@
+#lang racket/base
+
+(require racket/cmdline
+         racket/contract/base
+         racket/contract/region
+         racket/format
+         racket/match
+         racket/pretty
+         racket/runtime-path
+         racket/set
+         racket/string
+         "channel.rkt"
+         "command-server.rkt"
+         (only-in "debug.rkt" make-debug-eval-handler)
+         "elisp.rkt"
+         "error.rkt"
+         "gui.rkt"
+         "instrument.rkt"
+         "interactions.rkt"
+         "logger.rkt"
+         "mod.rkt"
+         "namespace.rkt"
+         (prefix-in stx-cache: "syntax.rkt")
+         "util.rkt")
+
+;; Main moving parts:
+;;
+;; 1. This main thread, which receives a couple messages on a channel
+;;    (see channel.rkt). One message is a `rerun` struct with info
+;;    about a new file/module to run. The main thread loops forever
+;;    (the `rerun` function tail calls itself forever). The special
+;;    case of racket/gui/base is handled with a custom module names
+;;    resolver and another message.
+;;
+;; 2. A thread created for each run; loads a module and goes into
+;;    a read-eval-print-loop.
+;;
+;; 3. A thread for a command server that listens on a TCP port (see
+;;    command-server.rkt). One of the commands is a `run` command.
+
+(module+ main
+  (define-values (command-port launch-token run-info)
+    (match (current-command-line-arguments)
+      [(vector port)
+       (values (string->number port)
+               #f
+               rerun-default)]
+      [(vector port launch-token run-command)
+       (values (string->number port)
+               (elisp-read (open-input-string launch-token))
+               (match (elisp-read (open-input-string run-command))
+                 [(list 'run what mem pp ctx args dbgs)
+                  (rerun (->mod/existing what)
+                         mem
+                         (as-racket-bool pp)
+                         ctx
+                         (list->vector args)
+                         (list->set (map string->path dbgs))
+                         void)]
+                 [v (eprintf "Bad arguments: ~v => ~v\n" run-command v)
+                    (exit)]))]
+      [v
+       (eprintf "Bad arguments: ~v\n" v)
+       (exit)]))
+  (start-command-server command-port launch-token)
+  (start-logger-server (add1 command-port) launch-token)
+  ;; Emacs on Windows comint-mode needs buffering disabled.
+  (when (eq? (system-type 'os) 'windows)
+    (file-stream-buffer-mode (current-output-port) 'none))
+  (display (banner))
+  (flush-output)
+  (parameterize ([error-display-handler our-error-display-handler])
+    (run run-info)))
+
+(define (run rr) ;rerun? -> void?
+  (match-define (rerun maybe-mod
+                       mem-limit
+                       pretty-print?
+                       context-level
+                       cmd-line-args
+                       debug-files
+                       ready-thunk) rr)
+  (define-values (dir file mod-path) (maybe-mod->dir/file/rmp maybe-mod))
+  ;; Always set current-directory and current-load-relative-directory
+  ;; to match the source file.
+  (current-directory dir)
+  (current-load-relative-directory dir)
+  ;; Make src-loc->string provide full pathnames
+  (show-full-path-in-errors)
+  ;; Custodian for the REPL.
+  (define repl-cust (make-custodian))
+  (when (< 0 mem-limit)
+    (custodian-limit-memory repl-cust
+                            (inexact->exact (round (* 1024 1024 mem-limit)))
+                            repl-cust))
+  ;; If racket/gui/base isn't loaded, the current-eventspace parameter
+  ;; doesn't exist, so make a "dummy" parameter of that name.
+  (define current-eventspace (txt/gui (make-parameter #f) current-eventspace))
+
+  ;; Create REPL thread
+  (define repl-thread
+    (parameterize* ;; Use `parameterize*` because the order matters.
+        (;; FIRST: current-custodian and current-namespace, so in
+         ;; effect for later parameterizations.
+         [current-custodian repl-cust]
+         [current-namespace (if mod-path
+                                ((txt/gui make-base-empty-namespace
+                                          make-gui-empty-namespace))
+                                ((txt/gui make-base-namespace
+                                          make-gui-namespace)))]
+         ;; OTHERS:
+         [compile-enforce-module-constants #f]
+         [compile-context-preservation-enabled (not (eq? context-level 'low))]
+         [current-eval
+          (cond [(debug-level? context-level) (make-debug-eval-handler debug-files)]
+                [(instrument-level? context-level)(make-instrumented-eval-handler)]
+                [else (current-eval)])]
+         [instrumenting-enabled (instrument-level? context-level)]
+         [profiling-enabled (eq? context-level 'profile)]
+         [test-coverage-enabled (eq? context-level 'coverage)]
+         [current-sync/yield (txt/gui sync yield)]
+         ;; LAST: `current-eventspace` because `make-eventspace`
+         ;; creates an event handler thread -- now. We want that
+         ;; thread to inherit the parameterizations above. (Otherwise
+         ;; in the non-gui case, we call `thread` below in the body of
+         ;; the parameterize* form, so that's fine.)
+         [current-eventspace ((txt/gui void make-eventspace))])
+      ;; repl-thunk will be called from another thread -- either a plain
+      ;; thread when racket/gui/base is not (yet) instantiated, or, from
+      ;; (eventspace-handler-thread (current-eventspace)).
+      (define (repl-thunk)
+        ;; 0. Command line arguments
+        (current-command-line-arguments cmd-line-args)
+        ;; 1. Set current-print and pretty-print hooks.
+        (current-print (make-print-handler pretty-print?))
+        (pretty-print-print-hook (make-pretty-print-print-hook))
+        (pretty-print-size-hook (make-pretty-print-size-hook))
+        (print-syntax-width +inf.0)
+        ;; 2. If module, require and enter its namespace, etc.
+        (stx-cache:before-run maybe-mod)
+        (when (and maybe-mod mod-path)
+          (parameterize ([current-module-name-resolver module-name-resolver-for-run]
+                         [current-eval (stx-cache:make-eval-handler maybe-mod)])
+            ;; When exn:fail? during module load, re-run with "empty"
+            ;; module. Note: Unlikely now that we're using
+            ;; dynamic-require/some-namespace.
+            (define (load-exn-handler exn)
+              (display-exn exn)
+              (channel-put message-to-main-thread-channel
+                           (struct-copy rerun rr [maybe-mod #f]))
+              (sync never-evt))
+            (with-handlers ([exn? load-exn-handler])
+              (maybe-configure-runtime mod-path) ;FIRST: see #281
+              (current-namespace (dynamic-require/some-namespace maybe-mod))
+              (maybe-warn-about-submodules mod-path context-level)
+              (check-top-interaction))))
+        (stx-cache:after-run maybe-mod)
+        ;; 3. Tell command server to use our namespace and module.
+        (attach-command-server (current-namespace) maybe-mod)
+        ;; 3b. And call the ready-thunk command-server gave us from a
+        ;; run command, so that it can send a response for the run
+        ;; command. Because the command server runs on a different
+        ;; thread, it is probably waiting with (sync some-channel) and
+        ;; the thunk will simply channel-put.
+        (ready-thunk)
+        ;; 4. read-eval-print-loop
+        (parameterize ([current-prompt-read (make-prompt-read maybe-mod)]
+                       [current-module-name-resolver module-name-resolver-for-repl])
+          ;; Note that read-eval-print-loop catches all non-break
+          ;; exceptions.
+          (read-eval-print-loop)))
+
+      ;; Main thread: Run repl-thunk on a plain thread, or, on the
+      ;; eventspace thread via queue-callback. Return the thread.
+      (define t/v ((txt/gui thread    queue-callback           ) repl-thunk))
+      (define thd ((txt/gui (λ _ t/v) eventspace-handler-thread) (current-eventspace)))
+      thd))
+
+  ;; Main thread: Wait for message from REPL thread on channel. Also
+  ;; catch breaks, in which case we (a) break the REPL thread so
+  ;; display-exn runs there, and (b) continue from the break instead
+  ;; of re-running so that the REPL environment is maintained.
+  (define message
+    (call-with-exception-handler
+     (match-lambda
+       [(and (or (? exn:break:terminate?) (? exn:break:hang-up?)) e) e]
+       [(exn:break msg marks continue) (break-thread repl-thread) (continue)]
+       [e e])
+     (λ () (sync message-to-main-thread-channel))))
+  (match context-level
+    ['profile  (clear-profile-info!)]
+    ['coverage (clear-test-coverage-info!)]
+    [_         (void)])
+  (custodian-shutdown-all repl-cust)
+  (newline) ;; FIXME: Move this to racket-mode.el instead?
+  (match message
+    [(? rerun? new-rr) (run new-rr)]
+    [(load-gui repl?)  (require-gui repl?) (run rr)]))
+
+(define (maybe-configure-runtime mod-path)
+  ;; Do configure-runtime when available.
+  ;; Important for langs like Typed Racket.
+  (with-handlers ([exn:fail? void])
+    (match (module->language-info mod-path #t)
+      [(vector mp name val)
+       (define get-info ((dynamic-require mp name) val))
+       (define configs (get-info 'configure-runtime '()))
+       (for ([config (in-list configs)])
+         (match-let ([(vector mp name val) config])
+           ((dynamic-require mp name) val)))]
+      [_ (void)])
+    (define cr-submod `(submod
+                        ,@(match mod-path
+                            [(list 'submod sub-paths ...) sub-paths]
+                            [_ (list mod-path)])
+                        configure-runtime))
+    (when (module-declared? cr-submod)
+      (dynamic-require cr-submod #f))))
+
+(define (check-top-interaction)
+  ;; Check that the lang defines #%top-interaction
+  (unless (memq '#%top-interaction (namespace-mapped-symbols))
+    (display-commented
+     "Because the language used by this module provides no #%top-interaction\n you will be unable to evaluate expressions here in the REPL.")))
+
+;; Catch attempt to load racket/gui/base for the first time.
+(define (make-module-name-resolver repl?)
+  (let ([orig-resolver (current-module-name-resolver)])
+    (define (resolve mp rmp stx load?)
+      (when (and load? (memq mp '(racket/gui/base
+                                  racket/gui/dynamic
+                                  scheme/gui/base)))
+        (unless (gui-required?)
+          (channel-put message-to-main-thread-channel
+                       (load-gui repl?))
+          (sync never-evt)))
+      (orig-resolver mp rmp stx load?))
+    (case-lambda
+      [(rmp ns)           (orig-resolver rmp ns)]
+      [(mp rmp stx)       (resolve mp rmp stx #t)]
+      [(mp rmp stx load?) (resolve mp rmp stx load?)])))
+(define module-name-resolver-for-run  (make-module-name-resolver #f))
+(define module-name-resolver-for-repl (make-module-name-resolver #t))
+
+(define (make-print-handler pretty-print?)
+  (cond [pretty-print? pretty-print-handler]
+        [else (make-plain-print-handler)]))
+
+;; Note: The `dynamic-require`s seem to be necessary otherwise
+;; file/convertible's convertible? always returns #f. Which seeems to
+;; be a namespace issue that I don't understand.
+(define-runtime-path image.rkt "image.rkt")
+
+(define (make-plain-print-handler)
+  (let ([convert (dynamic-require image.rkt 'convert-image)])
+    (λ (v)
+      (void (unless (void? v)
+              (print (convert v))
+              (newline))))))
+
+(define (make-pretty-print-size-hook [orig (pretty-print-size-hook)])
+  (let ([convert? (dynamic-require image.rkt 'convert-image?)]
+        [width (floor (/ (pretty-print-columns) 4))]) ;magic number? yep.
+    (λ (value display? port)
+      (cond [(convert? value) width]
+            [else (orig value display? port)]))))
+
+(define (make-pretty-print-print-hook [orig (pretty-print-print-hook)])
+  (let ([convert? (dynamic-require image.rkt 'convert-image?)]
+        [convert  (dynamic-require image.rkt 'convert-image)])
+    (λ (value display? port)
+      (cond [(convert? value) (print (convert value) port)]
+            [else (orig value display? port)]))))

elpa/racket-mode-20181004.309/racket/scribble.rkt

@@ -0,0 +1,176 @@
+#lang racket/base
+
+(require (only-in html
+                  read-html-as-xml)
+         racket/file
+         racket/function
+         racket/match
+         scribble/xref
+         setup/xref
+         (only-in xml
+                  xml->xexpr
+                  element
+                  xexpr->string))
+
+(provide scribble-doc/html
+         binding->path+anchor)
+
+;;; Extract Scribble documentation as modified HTML suitable for
+;;; Emacs' shr renderer.
+
+(define (scribble-doc/html stx)
+  (define xexpr (scribble-doc/xexpr stx))
+  (and xexpr (xexpr->string xexpr)))
+
+(define (scribble-doc/xexpr stx)
+  (define xexpr (scribble-doc/xexpr-raw stx))
+  (and xexpr (massage-xexpr xexpr)))
+
+(define (scribble-doc/xexpr-raw stx)
+  (define-values (path anchor) (binding->path+anchor stx))
+  (and path anchor (scribble-get-xexpr path anchor)))
+
+(define (binding->path+anchor stx)
+  (define xref (load-collections-xref))
+  (define tag (and (identifier? stx)
+                   (xref-binding->definition-tag xref stx 0)))
+  (cond [tag (xref-tag->path+anchor xref tag)]
+        [else (values #f #f)]))
+
+(define (scribble-get-xexpr path anchor)
+  (match (let loop ([es (main-elements (html-file->xexpr path))])
+           (match es
+             [(list) (list)]
+             [(cons (? (curryr anchored-element anchor) this) more)
+              ;; Accumulate until another intrapara with an anchor
+              (cons this
+                    (let get ([es more])
+                      (match es
+                        [(list) (list)]
+                        [(cons (? anchored-element) _) (list)] ;stop
+                        [(cons this more) (cons this (get more))])))]
+             [(cons _ more) (loop more)]))
+    [(list) #f]
+    [xs     `(div () ,@xs)]))
+
+(module+ test
+  (require rackunit)
+  (test-case "procedure"
+   (check-not-false (scribble-doc/xexpr #'print)))
+  (test-case "syntax"
+    (check-not-false (scribble-doc/xexpr #'match)))
+  (test-case "parameter"
+    (check-not-false (scribble-doc/xexpr #'current-eval)))
+  (test-case "indented sub-item"
+    (check-not-false (scribble-doc/xexpr #'struct-out)))
+  (test-case "deftogether"
+    (test-case "1 of 2"
+      (check-not-false (scribble-doc/xexpr #'lambda)))
+    (test-case "2 of 2"
+      (check-not-false (scribble-doc/xexpr #'λ))))
+  (check-not-false (scribble-doc/xexpr #'xref-binding->definition-tag)))
+
+(define (main-elements x)
+  (match x
+    [`(x () "\n"
+       (html ()
+             (head ,_ . ,_)
+             (body ,_
+                   (div ([class "tocset"]) . ,_)
+                   (div ([class "maincolumn"])
+                        (div ([class "main"]) . ,es))
+                   . ,_)))
+     es]
+    [_ '()]))
+
+;; anchored-element : xexpr? (or/c #f string?) -> (or/c #f string?)
+;; When `name` is #f, return the first anchor having any name.
+;; Otherwise, return the first anchor having `name`.
+(define (anchored-element x [name #f])
+  (define (anchor xs)
+    (for/or ([x (in-list xs)])
+      (match x
+        [`(a ((name ,a)) . ,_) (or (not name) (equal? name a))]
+        [`(,tag ,attrs . ,es)  (anchor es)]
+        [_                     #f])))
+  (match x
+    [`(div ((class "SIntrapara"))
+           (blockquote ((class "SVInsetFlow"))
+                       (table ,(list-no-order `(class "boxed RBoxed") _ ...)
+                              . ,es)))
+     ;; That's likely sufficient to say we're in HTML resulting from a
+     ;; Scribble defXXX form. From here on out, there can be some
+     ;; variation, so just look recursively for anchors within `es'.
+     (anchor es)]
+    [`(blockquote ((class "leftindent"))
+                  (p ())
+                  (div ((class "SIntrapara"))
+                       (blockquote ((class "SVInsetFlow"))
+                                   (table ,(list-no-order `(class "boxed RBoxed") _ ...)
+                                          . ,es)))
+                  ,_ ...)
+     (anchor es)]
+    [_ #f]))
+
+(define (html-file->xexpr pathstr)
+  (xml->xexpr
+   (element #f #f 'x '()
+           (read-html-as-xml (open-input-string (file->string pathstr))))))
+
+;; This is a big ole pile of poo, attempting to simplify and massage
+;; the HTML so that Emacs shr renders it in the least-worst way.
+;;
+;; Note: Emacs shr renderer removes leading spaces and nbsp from <td>
+;; elements -- which messes up the alignment of s-expressions
+;; including contracts. But actually, the best place to address that
+;; is up in Elisp, not here -- replace &nbsp; in the HTML with some
+;; temporary character, then replace that character in the shr output.
+(define (massage-xexpr x)
+  (define kind-xexprs '())
+  (define provide-xexprs '())
+  (define (walk x)
+    (match x
+      ;; The "Provided" title/tooltip. Set aside for later.
+      [`(span ([title ,(and s (pregexp "^Provided from:"))]) . ,xs)
+       (set! provide-xexprs (list s))
+       `(span () ,@(map walk xs))]
+      ;; The HTML for the "kind" (e.g. procedure or syntax or
+      ;; parameter) comes before the rest of the bluebox. Simple HTML
+      ;; renderers like shr don't handle this well. Set aside for
+      ;; later.
+      [`(div ([class "RBackgroundLabel SIEHidden"])
+         (div ([class "RBackgroundLabelInner"]) (p () . ,xs)))
+       (set! kind-xexprs xs)
+       ""]
+      ;; Bold RktValDef, which is the name of the thing.
+      [`(a ([class ,(pregexp "RktValDef|RktStxDef")] . ,_) . ,xs)
+       `(b () ,@(map walk xs))]
+      ;; Kill links. (Often these won't work anyway -- e.g. due to
+      ;; problems with "open" and file: links on macOS.)
+      [`(a ,_ . ,xs)
+       `(span () ,@(map walk xs))]
+      ;; Kill "see also" notes, since they're N/A w/o links.
+      [`(div ([class "SIntrapara"])
+         (blockquote ([class "refpara"]) . ,_))
+       `(span ())]
+      ;; Delete some things that produce unwanted blank lines and/or
+      ;; indents in simple rendering engines like Emacs' shr.
+      [`(blockquote ([class ,(or "SVInsetFlow" "SubFlow")]) . ,xs)
+       `(span () ,@(map walk xs))]
+      [`(p ([class "RForeground"]) . ,xs)
+       `(div () ,@(map walk xs))]
+      ;; Let's italicize all RktXXX classes except RktPn.
+      [`(span ([class ,(pregexp "^Rkt(?!Pn)")]) . ,xs)
+       `(i () ,@(map walk xs))]
+      ;; Misc element: Just walk kids.
+      [`(,tag ,attrs . ,xs)
+       `(,tag ,attrs ,@(map walk xs))]
+      [x x]))
+  (match (walk x)
+    [`(div () . ,xs)
+     `(div ()
+       (span ([style "color: #C0C0C0"])
+             (i () ,@kind-xexprs)
+             'nbsp
+             ,@provide-xexprs)
+       ,@xs)]))

elpa/racket-mode-20181004.309/racket/syntax.rkt

@@ -0,0 +1,100 @@
+#lang racket/base
+
+(require (only-in compiler/cm [get-file-sha1 file->digest])
+         racket/contract
+         racket/match
+         racket/promise
+         syntax/modread
+         "mod.rkt")
+
+(provide file->syntax
+         file->expanded-syntax
+         before-run
+         make-eval-handler
+         after-run)
+
+;; Return a syntax object or #f for the contents of `file`. The
+;; resulting syntax is applied to `k` while the parameters
+;; current-load-relative-directory and current-namespace are still set
+;; appropriately.
+(define/contract (file->syntax file [k values])
+  (->* (path-string?)
+       ((-> syntax? syntax?))
+       (or/c #f syntax?))
+  (define-values (base _ __) (split-path file))
+  (parameterize ([current-load-relative-directory base]
+                 [current-namespace (make-base-namespace)])
+    (with-handlers ([exn:fail? (λ _ #f)])
+      (k
+       (with-module-reading-parameterization
+         (λ ()
+           (with-input-from-file file read-syntax/count-lines)))))))
+
+(define (read-syntax/count-lines)
+  (port-count-lines! (current-input-port))
+  (read-syntax))
+
+;;; expanded syntax caching
+
+;; cache : (hash/c file (cons/c digest-string? (or/c promise? syntax?)))
+(define cache (make-hash))
+(define last-mod #f)
+
+;; Call this early in a file run, _before_ any evaluation. If it's not
+;; the same file as before, we empty the cache -- to free up memory.
+;; If it's the same file, we keep the cache.
+(define (before-run maybe-mod)
+  (unless (equal? last-mod maybe-mod)
+    (hash-clear! cache)
+    (set! last-mod maybe-mod)))
+
+(define ((make-eval-handler maybe-mod [orig-eval (current-eval)]) e)
+  (cond [(and (syntax? e)
+              (syntax-source e)
+              (path-string? (syntax-source e))
+              (not (compiled-expression? (syntax-e e))))
+         (define expanded-stx (expand e))
+         (cache-set! (syntax-source e) (λ () expanded-stx))
+         (orig-eval expanded-stx)]
+        [else (orig-eval e)]))
+
+(define (after-run maybe-mod)
+  ;; When the rkt file being run has a compiled zo that was used, then
+  ;; our eval-hander above won't expand and cache any syntax. That
+  ;; means when the user does a command that needs expanded syntax
+  ;; (e.g. find-completion), they will need to wait for expansion. But
+  ;; if you call this _after_ the file was run, it will cache-set! the
+  ;; expansion using `delay/thread` -- i.e. the work will happen "in
+  ;; the background". (Furthermore, when we already have a cache entry
+  ;; for the file and digest, from a previous run, we'll just use
+  ;; that.) As a result, it's likely to be mostly or entirely ready
+  ;; when the user does a command.
+  (define-values (dir base _) (maybe-mod->dir/file/rmp maybe-mod))
+  (when (and dir base)
+    (define path (build-path dir base))
+    (cache-set! path (λ () (delay/thread (file->syntax path expand))))))
+
+;; cache-set! takes a thunk so that, if the cache already has an entry
+;; for the file and digest, it can avoid doing any work. Furthermore,
+;; if you already have a digest for file, supply it to avoid redoing
+;; that work, too.
+(define/contract (cache-set! file thk [digest #f])
+  (->* (path-string? (-> (or/c promise? syntax?)))
+       ((or/c #f string?))
+       any)
+  (let ([digest (or digest (file->digest file))])
+    (match (hash-ref cache file #f)
+      [(cons (== digest) _)
+       (void)]
+      [_
+       (hash-set! cache file (cons digest (thk)))])))
+
+(define (file->expanded-syntax file)
+  (define digest (file->digest file))
+  (match (hash-ref cache file #f)
+    [(cons (== digest) promise)
+     (force promise)]
+    [_
+     (define stx (file->syntax file expand))
+     (cache-set! file (λ () stx) digest)
+     stx]))

elpa/racket-mode-20181004.309/racket/test/find-examples.rkt

@@ -0,0 +1,55 @@
+#lang racket/base
+
+(require racket/contract)
+
+;; Examples for test/defn.rkt.
+
+(define (plain x) x)
+(provide plain)
+(provide (rename-out [plain renamed]))
+
+(define (contracted1 x) x)
+(provide (contract-out [contracted1 (-> any/c any)]))
+(define (contracted2 x) x)
+(provide/contract [contracted2 (-> any/c any)])
+
+(define (c/r x) x)
+(provide (contract-out [rename c/r contracted/renamed (-> any/c any)]))
+
+(define-syntax-rule (plain-definer name)
+  (begin
+    (define (name x) x)
+    (provide name)))
+(plain-definer plain-by-macro)
+
+(define-syntax-rule (contracted-definer name)
+  (begin
+    (define (name x) x)
+    (provide (contract-out [name (-> any/c any)]))))
+(contracted-definer contracted-by-macro)
+
+;; This is here to try to trip naive matching, by having a definition
+;; of `sub` that is not actually provided, unlike the one in the `sub`
+;; module just below.
+(module red-herring racket/base
+  (define (sub) #f))
+
+(module sub racket/base
+  (define (sub x) x)
+  (provide sub
+           (rename-out [sub sub/renamed])))
+(require 'sub)
+(provide sub sub/renamed)
+
+;; Likewise, another case of naive matching:
+(module red-herring-2 racket/base
+  (define (foo) #f))
+
+(define (foo x) x)
+(provide foo)
+
+;; Issue 317
+(define a-number 42)
+(provide a-number)
+(define a-parameter (make-parameter #f))
+(provide a-parameter)

elpa/racket-mode-20181004.309/racket/test/find.rkt

@@ -0,0 +1,121 @@
+#lang at-exp racket/base
+
+(require racket/format
+         racket/match
+         racket/runtime-path
+         rackunit
+         syntax/modread
+         "../find.rkt"
+         "find-examples.rkt")
+
+(define-runtime-path dot-dot "..")
+
+(define-namespace-anchor nsa)
+(parameterize ([current-namespace (namespace-anchor->namespace nsa)])
+  (define (not-0 v) (not (= 0 v)))
+  (define (not-1 v) (not (= 1 v)))
+
+  (check-equal? (find-definition "display")
+                'kernel)
+  (check-equal? (find-signature "display")
+                '("defined in #%kernel, signature unavailable"))
+
+  (check-match (find-definition "displayln")
+               (list (pregexp "/racket/private/misc\\.rkt$")
+                     (? not-1)
+                     (? not-0)))
+  (check-equal? (find-signature "displayln")
+                '((displayln v) (displayln v p))) ;case-lambda defn
+
+  ;; Test a definer macro that (as of Racket 6.7) does not properly
+  ;; set srcloc: Can we at least return a specfic location for its
+  ;; parent syntax (as opposed to line 1 column 0)?
+  (check-match (find-definition "in-hash")
+               (list (pregexp "/racket/private/for.rkt$")
+                     (? not-1)
+                     (? not-0)))
+
+  ;; Tests for specific locations in find-examples.rkt
+
+  (check-match (find-definition "plain")
+               (list (pregexp "find-examples.rkt$") 7 9))
+  (check-equal? (find-signature "plain")
+                '(plain x))
+
+  (check-match (find-definition "renamed")
+               (list (pregexp "find-examples.rkt$") 7 9))
+  (check-equal? (find-signature "renamed")
+                '(plain x))
+
+  (check-match (find-definition "contracted1")
+               (list (pregexp "find-examples.rkt$") 11 9))
+  (check-equal? (find-signature "contracted1")
+                '(contracted1 x))
+
+  (check-match (find-definition "contracted2")
+               (list (pregexp "find-examples.rkt$") 13 9))
+  (check-equal? (find-signature "contracted2")
+                '(contracted2 x))
+
+  (check-match (find-definition "contracted/renamed")
+               (list (pregexp "find-examples.rkt$") 16 9))
+  (check-equal? (find-signature "contracted/renamed")
+                '(c/r x))
+
+  (check-match (find-definition "plain-by-macro")
+               (list (pregexp "find-examples.rkt$") 23 15))
+  (check-false (find-signature "plain-by-macro"))
+
+  (check-match (find-definition "contracted-by-macro")
+               (list (pregexp "find-examples.rkt$") 29 20))
+  (check-false (find-signature "contracted-by-macro"))
+
+  (check-match (find-definition "sub")
+               (list (pregexp "find-examples.rkt$") 38 11))
+  (check-equal? (find-signature "sub")
+                '(sub x))
+
+  (check-match (find-definition "sub/renamed")
+               (list (pregexp "find-examples.rkt$") 38 11))
+  (check-equal? (find-signature "sub/renamed")
+                '(sub x))
+
+  (check-match (find-definition "foo")
+               (list (pregexp "find-examples.rkt$") 48 9))
+  (check-equal? (find-signature "foo")
+                '(foo x))
+
+  (check-match (find-definition "a-number")
+               (list (pregexp "find-examples.rkt$") 52 8))
+
+  (check-match (find-definition "a-parameter")
+               (list (pregexp "find-examples.rkt$") 54 8))
+
+  ;; This is (roughly) a test of opening a Racket source file and
+  ;; doing M-. on every non-list sexpr: Call find-definition on each
+  ;; sexpr. Not-found (#f) is fine. But fail test for (list _ 1 0) --
+  ;; i.e. the source file was found, but not the location within.
+  (define (check-non-bof-location file)
+    (define ht (make-hash))
+    (define (find k) ;memoized find-definition
+      (hash-ref ht k
+                (λ ()
+                  (define v (find-definition (format "~a" k)))
+                  (hash-set! ht k v)
+                  v)))
+    (define (walk v)
+      (if (list? v)
+          (for-each walk v)
+          (match (find v)
+            [(list where 1 0)
+             (fail @~a{can't find definition of `@|v|` in @where})]
+            [_ (void)])))
+    (walk
+     (with-module-reading-parameterization
+       ;; Why read not read-syntax? Because we only care about the
+       ;; sexprs as text: `find-definition` takes a string, because
+       ;; `racket-visit-definition` takes text from an Emacs buffer.
+       (λ () (with-input-from-file file read)))))
+  (for ([file '("commands/requires.rkt"
+                "run.rkt")])
+    (check-non-bof-location (build-path dot-dot file))))

elpa/racket-mode-20181004.309/racket/util.rkt

@@ -0,0 +1,39 @@
+#lang racket/base
+
+(require (for-syntax racket/base
+                     syntax/parse))
+
+(provide display-commented
+         with-dynamic-requires
+         string->namespace-syntax
+         syntax-or-sexpr->syntax
+         syntax-or-sexpr->sexpr
+         nat/c
+         pos/c)
+
+(define (display-commented str)
+  (eprintf "; ~a\n"
+           (regexp-replace* "\n" str "\n; ")))
+
+(define-syntax (with-dynamic-requires stx)
+  (syntax-parse stx
+    [(_ ([lib:id id:id] ...+) body:expr ...+)
+     #'(let ([id (dynamic-require 'lib 'id)] ...)
+         body ...)]))
+
+(define (string->namespace-syntax str)
+  (namespace-syntax-introduce
+   (read-syntax #f (open-input-string str))))
+
+(define (syntax-or-sexpr->syntax v)
+  (if (syntax? v)
+      v
+      (namespace-syntax-introduce (datum->syntax #f v))))
+
+(define (syntax-or-sexpr->sexpr v)
+  (if (syntax? v)
+      (syntax-e v)
+      v))
+
+(define nat/c exact-nonnegative-integer?)
+(define pos/c exact-positive-integer?)