mprodrigues/emacs.d
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Update packages/ Add org-ref

Browse Source
This commit is contained in:
Mateus Pinto Rodrigues
2018-06-11 13:50:46 -03:00
parent 47702fe74a
commit f6ec2ebf59
504 changed files with 86348 additions and 611 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
elpa/racket-mode-20180609.1253/.dir-locals.el Normal file
View File

@@ -0,0 +1,13 @@
((nil
(indent-tabs-mode . nil)
(require-final-newline . t)
(show-trailing-whitespace . t))
(makefile-mode
(indent-tabs-mode . t))
(prog-mode
(comment-column . 40)
(fill-column . 70))
(racket-mode
;; Better indentation for quoted xexprs and for at-exprs:
(racket-indent-sequence-depth . 3)
(racket-indent-curly-as-sequence . t)))

67
elpa/racket-mode-20180609.1253/channel.rkt Normal file
View File

@@ -0,0 +1,67 @@
#lang racket/base
(require racket/match
racket/contract
"mod.rkt")
(provide main-channel
(struct-out msg)
(struct-out load-gui)
(struct-out rerun)
rerun-default
context-level?
instrument-level?
profile/coverage-level?
put/stop)
;; 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))
(define-syntax-rule (memq? x xs)
(not (not (memq x xs))))
(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))
;; Messages to the main thread via a channel
(define main-channel (make-channel))
(define-struct/contract msg ())
(define-struct/contract [load-gui msg] ())
(define-struct/contract [rerun msg]
([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?]))
(define rerun-default (rerun #f 0 #f 'low #()))
;; To be called from REPL thread. Puts message for the main thread to
;; the channel, and blocks itself; main thread will kill the REPL
;; thread. Effectively "exit the thread with a return value".
(define (put/stop v) ;; msg? -> void?
(channel-put main-channel v)
(void (sync never-evt)))

832
elpa/racket-mode-20180609.1253/cmds.rkt Normal file
View File

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

247
elpa/racket-mode-20180609.1253/defn.rkt Normal file
View File

@@ -0,0 +1,247 @@
#lang racket/base
(require racket/contract
racket/function
racket/match
syntax/modread)
(provide
(contract-out
[find-definition
(-> string?
(or/c #f 'kernel (list/c path-string?
natural-number/c
natural-number/c)))]
[find-signature
(-> string?
(or/c #f pair?))]))
;; Try to find the definition of `str`, returning a list with the file
;; name, line and column, 'kernel, or #f if not found.
(define (find-definition str)
(match (find-definition/stx str)
[(cons stx where)
(list (path->string (or (syntax-source stx) where))
(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 (find-signature str)
(match (find-definition/stx str)
['kernel '("defined in #%kernel, signature unavailable")]
[(cons stx where)
(match (signature (syntax-e stx) (file->syntax where #:expand? #f))
[(? syntax? stx) (syntax->datum stx)]
[_ #f])]
[v v]))
(define (find-definition/stx str)
;; (-> string? (or/c #f 'kernel (cons/c syntax? path?)))
(match (identifier-binding* str)
[(? list? xs)
(for/or ([x (in-list xs)])
(match x
[(cons id 'kernel) 'kernel]
[(cons id (? path? where))
(define expanded (file->syntax where #:expand? #t))
(define stx
(or (definition id expanded)
;; Handle rename + contract
(match (renaming-provide id (file->syntax where #:expand? #f))
[(? syntax? stx) (definition (syntax-e stx) expanded)]
[_ #f])))
(and stx
(cons stx where))]))]
[_ #f]))
;; A wrapper for identifier-binding. Keep in mind that 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`.
(define/contract (identifier-binding* v)
(-> (or/c string? symbol? identifier?)
(or/c #f (listof (cons/c symbol? (or/c path? 'kernel #f)))))
(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 (mpi->path mpi)
(match (resolved-module-path-name (module-path-index-resolve mpi))
[(? path-string? path) path]
[(or v (cons v _))
(cond [(and (symbol? v)
(regexp-match? #px"^#%" (symbol->string v)))
'kernel]
[(symbol? v)
(build-path (current-load-relative-directory)
(format "~a.rkt" v))]
[else #f])]))
;; Return a syntax object (or #f) for the contents of `file`.
(define (file->syntax file #:expand? expand?)
(define-values (base _ __) (split-path file))
(parameterize ([current-load-relative-directory base]
[current-namespace (make-base-namespace)])
(define stx (with-handlers ([exn:fail? (const #f)])
(with-module-reading-parameterization
(thunk
(with-input-from-file file read-syntax/count-lines)))))
(if expand?
(expand stx) ;expand while current-load-relative-directory is set
stx)))
(define (read-syntax/count-lines)
(port-count-lines! (current-input-port))
(read-syntax))
;; Given a symbol? and syntax?, return syntax? corresponding to the
;; definition.
;;
;; 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 syntx/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
(module #%module-begin define-values define-syntaxes
define define/contract
define-syntax struct define-struct)
syntax-e-eq?
[(module _ _ (#%module-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. Note that we do NOT want stx to be
;; run through `expand`.
(define (signature sym stx) ;;symbol? syntax? -> (or/c #f list?)
(define eq-sym? (make-eq-sym? sym))
(syntax-case* stx
(module #%module-begin define define/contract case-lambda)
syntax-e-eq?
[(module _ _ (#%module-begin . stxs))
(ormap (λ (stx)
(signature sym stx))
(syntax->list #'stxs))]
[(module _ _ . 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]))
;; Given a symbol? and syntax?, return syntax? corresponding to the
;; contracted provide. Note that we do NOT want stx to be run through
;; `expand` because we want the original contract definitions (if
;; any). ** This is currently not used. If we ever add a
;; `find-provision` function, it would use this.
(define (contracting-provide sym stx) ;;symbol? syntax? -> syntax?
(define eq-sym? (make-eq-sym? sym))
(syntax-case* stx
(module #%module-begin provide provide/contract)
syntax-e-eq?
[(module _ _ (#%module-begin . ss))
(ormap (λ (stx) (contracting-provide sym stx))
(syntax->list #'ss))]
[(provide/contract . stxs)
(for/or ([stx (syntax->list #'stxs)])
(syntax-case stx ()
[(s _) (eq-sym? #'s) stx]
[_ #f]))]
[(provide . stxs)
(for/or ([stx (syntax->list #'stxs)])
(syntax-case* stx (contract-out) syntax-e-eq?
[(contract-out . stxs)
(for/or ([stx (syntax->list #'stxs)])
(syntax-case* stx (rename struct) syntax-e-eq?
[(struct s _ ...) (eq-sym? #'s) stx]
[(struct (s _) _ ...) (eq-sym? #'s) stx]
[(rename _ s _) (eq-sym? #'s) stx]
[(s _) (eq-sym? #'s) stx]
[_ #f]))]
;; Only care about contracting provides.
;; [s (eq-sym? #'s) stx]
[_ #f]))]
[_ #f]))
;; Find sym in a contracting and/or renaming provide, and return the
;; syntax for the ORIGINAL identifier (before being contracted and/or
;; renamed).
(define (renaming-provide sym stx) ;;symbol? syntax? -> syntax?
(define eq-sym? (make-eq-sym? sym))
(syntax-case* stx
(module #%module-begin provide provide/contract)
syntax-e-eq?
[(module _ _ (#%module-begin . ss))
(ormap (λ (stx) (renaming-provide sym stx))
(syntax->list #'ss))]
[(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]))
;; 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))

180
elpa/racket-mode-20180609.1253/error.rkt Normal file
View File

@@ -0,0 +1,180 @@
#lang racket/base
(require racket/match
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 exn)
(when (exn? exn)
(unless (equal? "Check failure" (exn-message exn)) ;rackunit check fails
(fresh-line)
(display-commented (fully-qualify-error-path str))
(display-srclocs exn)
(unless (exn:fail:user? exn)
(display-context exn))
(maybe-suggest-packages exn))))
(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 run.rkt "run.rkt")
(define-runtime-path namespace.rkt "namespace.rkt")
(define (system-context? ci)
(match-define (cons id src) ci)
(or (not src)
(let ([src (srcloc-source src)])
(and (path? src)
(or (equal? src run.rkt)
(equal? src namespace.rkt)
(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/lib pkg-catalog-suggestions-for-module])
(λ (exn)
(when (exn:missing-module? exn)
(define mod ((exn:missing-module-accessor exn) exn))
(match (pkg-catalog-suggestions-for-module mod)
[(list) void]
[(list p)
(display-commented (format "Try `raco pkg install ~a`?" p))]
[(? list? ps)
(display-commented (format "Try `raco pkg install` one of ~a?"
(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))))))

45
elpa/racket-mode-20180609.1253/find-module-path-completions.rkt Normal file
View File

@@ -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)))))))

37
elpa/racket-mode-20180609.1253/fresh-line.rkt Normal file
View File

@@ -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))

33
elpa/racket-mode-20180609.1253/gui.rkt Normal file
View File

@@ -0,0 +1,33 @@
#lang racket/base
(require "util.rkt")
(provide gui-required?
require-gui
txt/gui)
(define root-eventspace #f) ;#f until racket/gui/base required first time
(define (gui-required?)
(not (not root-eventspace)))
;; This must be called from the main thread, under the main custodian!
(define (require-gui)
(when (gui-required?)
(error 'require-gui "Already required"))
(display-commented "on-demand one-time instantiation of racket/gui/base")
(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))

102
elpa/racket-mode-20180609.1253/help.rkt Normal file
View File

@@ -0,0 +1,102 @@
#lang at-exp racket/base
(require (only-in help/help-utils find-help)
(only-in help/search perform-search)
json
net/url
racket/contract
racket/file
racket/format
racket/match
racket/port
racket/promise
racket/system
"scribble.rkt")
(provide
(contract-out [rename -find-help find-help (-> syntax? boolean?)]
[perform-search (-> string? any)]))
;; 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".
(define mac-browser ;; (promise/c (or/c string? #f))
(delay/sync (mac-default-browser)))
(define (-find-help stx)
((if (force mac-browser)
find-help/mac
find-help/boolean)
stx))
(define (find-help/boolean stx)
;; 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 (find-help/mac stx)
(let-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]))
(force mac-browser))))))
(define osascript (delay/sync (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*
(force osascript)
"-e"
@~a{tell application "@browser" to open location "@file-url" activate}))
;;; Discover default browser on macOS
(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 (delay/sync (find-executable-path "plutil" #f)))
(define (read-bplist plist-path) ;path? -> json?
(define out-path (make-temporary-file))
(begin0
(if (system* (force plutil)
"-convert" "json"
"-o" out-path
plist-path)
(with-input-from-file out-path read-json)
(make-hash))
(delete-file out-path)))

26
elpa/racket-mode-20180609.1253/image.rkt Normal file
View File

@@ -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]))

229
elpa/racket-mode-20180609.1253/instrument.rkt Normal file
View File

@@ -0,0 +1,229 @@
#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) orig-exp)
;; This is modeled after the one in DrRacket.
(cond
[(or (not (instrumenting-enabled))
(compiled-expression? (if (syntax? orig-exp)
(syntax-e orig-exp)
orig-exp)))
(orig-eval orig-exp)]
[else
(let loop ([exp (if (syntax? orig-exp)
orig-exp
(namespace-syntax-introduce (datum->syntax #f 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)

98
elpa/racket-mode-20180609.1253/keywords.rkt Normal file
View File

@@ -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)

84
elpa/racket-mode-20180609.1253/logger.rkt Normal file
View File

@@ -0,0 +1,84 @@
#lang at-exp racket/base
(require racket/match
racket/format
racket/tcp)
(provide start-logger-server)
(define global-logger (make-logger))
(current-logger global-logger)
(define (start-logger-server port)
(void (thread (logger-thread port))))
(define ((logger-thread port))
(define listener (tcp-listen port 4 #t))
(let accept ()
(define-values (in out) (tcp-accept listener))
;; 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)]))))

151
elpa/racket-mode-20180609.1253/mod.rkt Normal file
View File

@@ -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.})))

269
elpa/racket-mode-20180609.1253/namespace.rkt Normal file
View File

@@ -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)))

83
elpa/racket-mode-20180609.1253/racket-bug-report.el Normal file
View File

@@ -0,0 +1,83 @@
;;; racket-bug-report.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'cl-lib)
(require 'racket-util)
(defconst racket--source-dir
(file-name-directory (or load-file-name (racket--buffer-file-name))))
;;;###autoload
(defun racket-bug-report ()
"Fill a buffer with data to make a racket-mode bug report."
(interactive)
(unless (memq major-mode '(racket-mode racket-repl-mode))
(user-error "Please run this from a racket-mode or racket-repl-mode buffer."))
(with-help-window "*racket-mode bug report*"
(princ "TIP: If you get an `invalid function' error, be aware that Emacs package\n")
(princ "updates don't necessarily fully update Emacs' state. In some cases, you\n")
(princ "might even need to:\n\n")
(princ " 1. Uninstall racket-mode\n")
(princ " 2. Exit and restart Emacs\n")
(princ " 3. Install racket-mode\n\n\n")
(princ "When you submit a bug report at:\n\n")
(princ " https://github.com/greghendershott/racket-mode/issues/new\n\n")
(princ "Please copy and paste ALL OF THE FOLLOWING LINES from\n")
(princ "`<details>' through `</details>':\n\n\n")
(princ "<details>\n")
(princ "```\n")
(cl-labels ((id-val (id) (list id
(condition-case () (symbol-value id)
(error 'UNDEFINED)))))
(let ((emacs-uptime (emacs-uptime)))
(pp `(,@(mapcar #'id-val
`(emacs-version
emacs-uptime
system-type
major-mode
racket--source-dir
racket-program
racket-memory-limit
racket-error-context
racket-history-filter-regexp
racket-images-inline
racket-images-keep-last
racket-images-system-viewer
racket-pretty-print
racket-indent-curly-as-sequence
racket-indent-sequence-depth
racket-pretty-lambda
racket-smart-open-bracket-enable)))))
;; Show lists of enabled and disabled minor modes, each sorted by name.
(let* ((minor-modes (cl-remove-duplicates
(append minor-mode-list
(mapcar #'car minor-mode-alist))))
(modes/values (mapcar #'id-val minor-modes))
(sorted (sort modes/values
(lambda (a b)
(string-lessp (format "%s" (car a))
(format "%s" (car b)))))))
(cl-labels ((f (x) (list (car x)))) ;car as a list so pp line-wraps
(pp `(enabled-minor-modes ,@(mapcar #'f (cl-remove-if-not #'cadr sorted))))
(pp `(disabled-minor-modes ,@(mapcar #'f (cl-remove-if #'cadr sorted)))))))
(princ "```\n")
(princ "</details>\n")))
(provide 'racket-bug-report)
;;; racket-bug-report.el ends here

328
elpa/racket-mode-20180609.1253/racket-collection.el Normal file
View File

@@ -0,0 +1,328 @@
;;; racket-collection.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'ido)
(require 'tq)
(require 'racket-repl)
(require 'racket-complete) ;for `racket--symbol-at-point-or-prompt'
(require 'racket-custom) ;for `racket-program'
(require 'racket-util)
;;; racket-find-collection
(defun racket-find-collection (&optional prefix)
"Given a collection name, try to find its directory and files.
Takes a collection name from point (or, with a prefix, prompts you).
If only one directory is found, `ido-find-file-in-dir' lets you
pick a file there.
If more than one directory is found, `ido-completing-read' lets
you pick one, then `ido-find-file-in-dir' lets you pick a file
there.
Note: This requires the `raco-find-collection' package to be
installed. To install it, in `shell' enter:
raco pkg install raco-find-collection
Tip: This works best with `ido-enable-flex-matching' set to t.
Also handy is the `flx-ido' package from MELPA.
See also: `racket-visit-module' and `racket-open-require-path'."
(interactive "P")
(pcase (racket--symbol-at-point-or-prompt prefix "Collection name: ")
(`() nil)
(coll
(pcase (racket--repl-command "find-collection \"%s\"" coll)
(`find-collection-not-installed
;; FIXME? Offer to run this for them?
(user-error "Run `raco pkg install raco-find-collection'"))
(`()
(user-error (format "Collection `%s' not found" coll)))
(`(,path)
(racket--find-file-in-dir path))
(paths
(let ((done nil))
(while (not done)
;; `(ido-find-file-in-dir (ido-completing-read paths))`
;; -- except we want to let the user press C-g inside
;; ido-find-file-in-dir to back up and pick a different
;; module path.
(let ((dir (ido-completing-read "Directory: " paths)))
(condition-case ()
(progn (racket--find-file-in-dir dir)
(setq done t))
(quit nil))))))))))
(defun racket--find-file-in-dir (dir)
"Like `ido-find-file-in-dir', but allows C-d to `dired' as does `ido-find-file'."
(ido-file-internal ido-default-file-method nil dir))
;;; racket-open-require-path
;; From looking at ido-mode and ido-vertical-mode:
;;
;; Just use read-from-minibuffer.
;;
;; We're doing vertical mode, so we don't need var like ido-eoinput.
;; We can simply look for the first \n in the minibuffer -- that's the
;; end of user input.
;;
;; Everything after the input and first \n, is the candiates we
;; display, \n separated. The minibuffer automatically grows
;; vertically.
;;
;; Have some maximum number of candidates to display (10?). If > 10, print
;; last line 10 as "...", like ido-vertical-mode.
;;
;; Also use a keymap for commands:
;; - C-n and C-p, which move through the candidates
;; - ENTER
;; - on a dir will add its contents to the candidates (like DrR's
;; "Enter Subsellection" button.
;; - on a file will exit and open the file.
;;
;; Remember that typing a letter triggers `self-insert-command'.
;; Therefore the pre and post command hooks will run then, too.
;;
;; Early version of this used racket--eval/sexpr. Couldn't keep up
;; with typing. Instead: run dedicated Racket process and more direct
;; pipe style; the process does a read-line and responds with each
;; choice on its own line, terminated by a blank like (like HTTP
;; headers).
(defvar racket--orp/tq nil
"tq queue")
(defvar racket--orp/active nil ;;FIXME: Use minibuffer-exit-hook instead?
"Is `racket-open-require-path' using the minibuffer?")
(defvar racket--orp/input ""
"The current user input. Unless user C-g's this persists, as with DrR.")
(defvar racket--orp/matches nil
"The current user matches. Unless user C-g's this persists, as with DrR.")
(defvar racket--orp/match-index 0
"The index of the current match selected by the user.")
(defvar racket--orp/max-height 10
"The maximum height of the minibuffer.")
(defvar racket--orp/keymap
(racket--easy-keymap-define
'((("RET" "C-j") racket--orp/enter)
("C-g" racket--orp/quit)
(("C-p" "<up>") racket--orp/prev)
(("C-n" "<down>") racket--orp/next)
;; Some keys should be no-ops.
(("SPC" "TAB" "C-v" "<next>" "M-v" "<prior>" "M-<" "<home>" "M->" "<end>")
racket--orp/nop))))
(defvar racket-find-module-path-completions-rkt
(expand-file-name "find-module-path-completions.rkt"
(file-name-directory (or load-file-name
(racket--buffer-file-name))))
"Path to find-module-path-completions.rkt")
(defun racket--orp/begin ()
(let ((proc (start-process "racket-find-module-path-completions-process"
"*racket-find-module-path-completions*"
racket-program
racket-find-module-path-completions-rkt)))
(setq racket--orp/tq (tq-create proc))))
(defun racket--orp/request-tx-matches (input)
"Request matches from the Racket process; delivered to `racket--orp/rx-matches'."
(when racket--orp/tq
(tq-enqueue racket--orp/tq
(concat input "\n")
".*\n\n"
(current-buffer)
'racket--orp/rx-matches)))
(defun racket--orp/rx-matches (buffer answer)
"Completion proc; receives answer to request by `racket--orp/request-tx-matches'."
(when racket--orp/active
(setq racket--orp/matches (split-string answer "\n" t))
(setq racket--orp/match-index 0)
(with-current-buffer buffer
(racket--orp/draw-matches))))
(defun racket--orp/end ()
(when racket--orp/tq
(tq-close racket--orp/tq)
(setq racket--orp/tq nil)))
(defun racket-open-require-path ()
"Like Dr Racket's Open Require Path.
Type (or delete) characters that are part of a module path name.
\"Fuzzy\" matches appear. For example try typing \"t/t/r\".
Choices are displayed in a vertical list. The current choice is
at the top, marked with \"->\".
- C-n and C-p move among the choices.
- RET on a directory adds its contents to the choices.
- RET on a file exits doing `find-file'.
- C-g aborts.
Note: This requires Racket 6.1.1.6 or newer. Otherwise it won't
error, it will just never return any matches."
(interactive)
(racket--orp/begin)
(setq racket--orp/active t)
(setq racket--orp/match-index 0)
;; We do NOT initialize `racket--orp/input' or `racket--orp/matches'
;; here. Like DrR, we remember from last time invoked. We DO
;; initialize them in racket--orp/quit i.e. user presses C-g.
(add-hook 'minibuffer-setup-hook #'racket--orp/minibuffer-setup)
(condition-case ()
(progn
(read-from-minibuffer "Open require path: "
racket--orp/input
racket--orp/keymap)
(when racket--orp/matches
(find-file (elt racket--orp/matches racket--orp/match-index))))
(error (setq racket--orp/input "")
(setq racket--orp/matches nil)))
(setq racket--orp/active nil)
(racket--orp/end))
(defun racket--orp/minibuffer-setup ()
(add-hook 'pre-command-hook #'racket--orp/pre-command nil t)
(add-hook 'post-command-hook #'racket--orp/post-command nil t)
(when racket--orp/active
(racket--orp/draw-matches)))
(defun racket--orp/eoinput ()
"Return position where user input ends, i.e. the first \n before the
candidates or (point-max)."
(save-excursion
(goto-char (point-min))
(condition-case ()
(1- (re-search-forward "\n"))
(error (point-max)))))
(defun racket--orp/get-user-input ()
"Get the user's input from the mini-buffer."
(buffer-substring-no-properties (minibuffer-prompt-end)
(racket--orp/eoinput)))
(defun racket--orp/pre-command ()
nil)
(defun racket--orp/post-command ()
"Update matches if input changed.
Also constrain point in case user tried to navigate past
`racket--orp/eoinput'."
(when racket--orp/active
(let ((input (racket--orp/get-user-input)))
(when (not (string-equal input racket--orp/input))
(racket--orp/on-input-changed input)))
(let ((eoi (racket--orp/eoinput)))
(when (> (point) eoi)
(goto-char eoi)))))
(defun racket--orp/on-input-changed (input)
(setq racket--orp/input input)
(cond ((string-equal input "") ;"" => huge list; ignore like DrR
(setq racket--orp/match-index 0)
(setq racket--orp/matches nil)
(racket--orp/draw-matches))
(t (racket--orp/request-tx-matches input))))
(defun racket--orp/draw-matches ()
(save-excursion
(let* ((inhibit-read-only t)
(eoi (racket--orp/eoinput))
(len (length racket--orp/matches))
(n (min racket--orp/max-height len))
(i racket--orp/match-index))
(delete-region eoi (point-max)) ;delete existing
(while (> n 0)
(insert "\n")
(cond ((= i racket--orp/match-index) (insert "-> "))
(t (insert " ")))
(insert (elt racket--orp/matches i))
(setq n (1- n))
(cond ((< (1+ i) len) (setq i (1+ i)))
(t (setq i 0))))
(when (< racket--orp/max-height len)
(insert "\n ..."))
(put-text-property eoi (point-max) 'read-only 'fence))))
(defun racket--orp/enter ()
"On a dir, adds its contents to choices. On a file, opens the file."
(interactive)
(when racket--orp/active
(let ((match (and racket--orp/matches
(elt racket--orp/matches racket--orp/match-index))))
(cond (;; Pressing RET on a directory inserts its contents, like
;; "Enter subcollection" button in DrR.
(and match (file-directory-p match))
(racket--trace "enter" 'add-subdir)
(setq racket--orp/matches
(delete-dups ;if they RET same item more than once
(sort (append racket--orp/matches
(directory-files match t "[^.]+$"))
#'string-lessp)))
(racket--orp/draw-matches))
(;; Pressing ENTER on a file selects it. We exit the
;; minibuffer; our main function treats non-nil
;; racket--orp/matches and racket--orp/match-index as a
;; choice (as opposed to quitting w/o a choice.
t
(racket--trace "enter" 'exit-minibuffer)
(exit-minibuffer))))))
(defun racket--orp/quit ()
"Our replacement for `keyboard-quit'."
(interactive)
(when racket--orp/active
(racket--trace "quit")
(setq racket--orp/input "")
(setq racket--orp/matches nil)
(exit-minibuffer)))
(defun racket--orp/next ()
"Select the next match."
(interactive)
(when racket--orp/active
(setq racket--orp/match-index (1+ racket--orp/match-index))
(when (>= racket--orp/match-index (length racket--orp/matches))
(setq racket--orp/match-index 0))
(racket--orp/draw-matches)))
(defun racket--orp/prev ()
"Select the previous match."
(interactive)
(when racket--orp/active
(setq racket--orp/match-index (1- racket--orp/match-index))
(when (< racket--orp/match-index 0)
(setq racket--orp/match-index (max 0 (1- (length racket--orp/matches)))))
(racket--orp/draw-matches)))
(defun racket--orp/nop ()
"A do-nothing command target."
(interactive)
nil)
(provide 'racket-collection)
;; racket-collection.el ends here

720
elpa/racket-mode-20180609.1253/racket-common.el Normal file
View File

@@ -0,0 +1,720 @@
;;; racket-common.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
;; Things used by both racket-mode and racket-repl-mode
(require 'cl-lib)
(require 'thingatpt)
(require 'racket-custom)
(require 'racket-keywords-and-builtins)
(require 'racket-font-lock)
(require 'racket-indent)
(require 'racket-ppss)
(require 'racket-util)
(declare-function racket-complete-at-point "racket-complete.el" (&optional predicate))
(defvar racket-mode-abbrev-table nil)
(define-abbrev-table 'racket-mode-abbrev-table ())
;;; syntax-table and syntax-propertize-function
(defvar racket-mode-syntax-table
(let ((st (make-syntax-table))
(i 0))
;; Symbol constituents
(while (< i ?0)
(modify-syntax-entry i "_ " st)
(setq i (1+ i)))
(setq i (1+ ?9))
(while (< i ?A)
(modify-syntax-entry i "_ " st)
(setq i (1+ i)))
(setq i (1+ ?Z))
(while (< i ?a)
(modify-syntax-entry i "_ " st)
(setq i (1+ i)))
(setq i (1+ ?z))
(while (< i 128)
(modify-syntax-entry i "_ " st)
(setq i (1+ i)))
;; Whitespace (except ?\n, see below in comment section)
(modify-syntax-entry ?\t " " st)
(modify-syntax-entry ?\f " " st)
(modify-syntax-entry ?\r " " st)
(modify-syntax-entry ?\s " " st)
;; These characters are delimiters but otherwise undefined.
;; Brackets and braces balance for editing convenience.
(modify-syntax-entry ?\( "() " st)
(modify-syntax-entry ?\) ")( " st)
(modify-syntax-entry ?\[ "(] " st)
(modify-syntax-entry ?\] ")[ " st)
(modify-syntax-entry ?{ "(} " st)
(modify-syntax-entry ?} "){ " st)
;; Other atom delimiters
(modify-syntax-entry ?\" "\" " st)
(modify-syntax-entry ?' "' " st)
(modify-syntax-entry ?` "' " st)
(modify-syntax-entry ?, "' " st)
(modify-syntax-entry ?@ "' " st)
(modify-syntax-entry ?\\ "\\ " st)
;; Comment related
(modify-syntax-entry ?\; "< " st) ;line comments but NOT sexp #;
(modify-syntax-entry ?\n "> " st)
(modify-syntax-entry ?# "w 14" st) ;not necessarily prefix
(modify-syntax-entry ?| "_ 23bn" st)
st))
(defun racket-syntax-propertize-function (start end)
(goto-char start)
(racket--syntax-propertize-here-string end)
(funcall
(syntax-propertize-rules
;; here strings: The main responsibility here is to set the "|"
;; char syntax around the "body" so it's treated as a string for
;; indent, nav, font-lock. Think of the \n in #<<ID\n as the open
;; | quote and the \n in ^ID\n as the close | quote.
((rx "#<<" (group (+? (not (any blank ?\n)))) (group ?\n))
(2 (racket--syntax-propertize-open-here-string
(match-beginning 0)
(match-string-no-properties 1)
(match-beginning 2))))
((rx (syntax string-delimiter))
(0 (ignore (racket--syntax-propertize-here-string end))))
;; sexp comments should LOOK like comments but NOT ACT like
;; comments: Give the #; itself the syntax class "prefix" [1], but
;; allow the following sexp to get the usual syntaxes. That way
;; things like indent and sexp nav work within the sexp. Only
;; font-lock handles the sexp specially; see racket-font-lock.el.
;;
;; [1]: Although it's tempting to use punctuation -- so things like
;; `backward-sexp' and `racket-send-last-sexp' ignore the #; --
;; that would mess up indentation of things following the sexp
;; comment. Instead special-case `racket-send-last-sexp'.
((rx "#;")
(0 "'"))
;; Treat "complex" reader literals as a single sexp for nav and
;; indent, by marking the stuff after the # as prefix syntax.
;; Racket predefines reader literals like #"" #rx"" #px"" #hash()
;; #hasheq() #fx3(0 1 2) #s() and so on. I think these -- plus any
;; user defined reader extensions -- can all be covered with the
;; following general rx. Also it seems sufficient to look for just
;; the opening delimiter -- the ( [ { or " -- here.
((rx (group ?#
(zero-or-more (or (syntax symbol)
(syntax word))))
(or ?\" ?\( ?\[ ?\{))
(1 "'"))
;; Syntax quoting
((rx ?# (or ?` ?' ?,))
(0 "'"))
;; Treat '|symbol with spaces| as word syntax
((rx ?' ?| (+ any) ?|)
(0 "w"))
;; Treat |identifier with spaces| -- but not #|comment|# -- as
;; word syntax
((rx (not (any ?#))
(group ?| (+? (not (any "|\r\n"))) ?|)
(not (any ?#)))
(1 "w")))
(point)
end))
(defun racket--syntax-propertize-open-here-string (start string eol)
"Determine the syntax of the \\n after a #<<HERE
START is the position of #<<.
STRING is the actual word used as delimiter (e.g. \"HERE\").
EOL is the position of the \\n.
Point is at the beginning of the next line.
This sets the open | syntax and sets a 'racket-here-string
property whose value is STRING. The close | syntax is set by
`racket--syntax-propertize-here-string'."
(unless (save-excursion
(let ((ppss (syntax-ppss start)))
(or (racket--ppss-string-p ppss)
(racket--ppss-comment-p ppss))))
(let ((ppss (save-excursion (syntax-ppss eol))))
(if (racket--ppss-comment-p ppss)
;; The \n not only starts the heredoc but also closes a comment.
;; Let's close the comment just before the \n.
(put-text-property (1- eol) eol 'syntax-table '(12))) ;">"
(if (or (racket--ppss-quote-p ppss)
(< 1 (count-lines start eol)))
;; If we matched several lines, make sure we refontify them
;; together. Furthermore, if the \n is quoted, it means the
;; right \n is actually further down. Don't bother fixing it
;; now, but place a multiline property so that when
;; jit-lock-context-* refontifies the rest of the buffer, it
;; also refontifies the current line with it.
(put-text-property start (1+ eol) 'syntax-multiline t))
(put-text-property eol (1+ eol) 'racket-here-string string)
(goto-char (+ 3 start))
(string-to-syntax "|"))))
(defun racket--syntax-propertize-here-string (end)
"If in a here string that ends before END, add | syntax for its close."
(let ((ppss (syntax-ppss)))
(when (eq (racket--ppss-string-p ppss) t) ;t as opposed to ?" or ?'
(let ((key (get-text-property (racket--ppss-string/comment-start ppss)
'racket-here-string)))
(when (and key
(re-search-forward (concat "^" (regexp-quote key) "\\(\n\\)")
end t))
(let ((eol (match-beginning 1)))
(put-text-property eol (1+ eol)
'syntax-table
(string-to-syntax "|"))))))))
;;;
(defun racket--common-variables ()
"Set variables common to `racket-mode' and `racket-repl-mode'."
;;; Syntax
(set-syntax-table racket-mode-syntax-table)
(setq-local multibyte-syntax-as-symbol t)
(setq-local parse-sexp-ignore-comments t)
(setq-local syntax-propertize-function #'racket-syntax-propertize-function)
(syntax-propertize (point-max)) ;for e.g. paredit: see issue #222
;; -----------------------------------------------------------------
;; Font-lock
(setq-local font-lock-defaults
(list racket-font-lock-keywords ;keywords
nil ;keywords-only?
nil ;case-fold?
nil ;syntax-alist
nil ;syntax-begin
;; Additional variables:
(cons 'font-lock-mark-block-function #'mark-defun)
(cons 'parse-sexp-lookup-properties t)
(cons 'font-lock-multiline t)
(cons 'font-lock-syntactic-face-function
#'racket-font-lock-syntactic-face-function)
(list 'font-lock-extend-region-functions
#'font-lock-extend-region-wholelines
#'font-lock-extend-region-multiline)))
;; -----------------------------------------------------------------
;; Comments. Mostly borrowed from lisp-mode and/or scheme-mode
(setq-local comment-start ";")
(setq-local comment-add 1) ;default to `;;' in comment-region
(setq-local comment-start-skip ";+ *")
(setq-local comment-column 40)
(setq-local comment-multi-line t) ;for auto-fill-mode and #||# comments
;; Font lock mode uses this only when it knows a comment is starting:
(setq-local font-lock-comment-start-skip ";+ *")
;; -----------------------------------------------------------------
;; Indent
(setq-local indent-line-function #'racket-indent-line)
(racket--set-indentation)
(setq-local indent-tabs-mode nil)
;; -----------------------------------------------------------------
;;; Misc
(setq-local local-abbrev-table racket-mode-abbrev-table)
(setq-local paragraph-start (concat "$\\|" page-delimiter))
(setq-local paragraph-separate paragraph-start)
(setq-local paragraph-ignore-fill-prefix t)
(setq-local fill-paragraph-function #'lisp-fill-paragraph)
(setq-local adaptive-fill-mode nil)
(setq-local outline-regexp ";;; \\|(....")
(setq-local completion-at-point-functions (list #'racket-complete-at-point))
(setq-local eldoc-documentation-function nil)
(setq-local beginning-of-defun-function #'racket--beginning-of-defun-function))
;;; Insert lambda char (like DrRacket)
(defconst racket-lambda-char (make-char 'greek-iso8859-7 107)
"Character inserted by `racket-insert-labmda'.")
(defun racket-insert-lambda ()
(interactive)
(insert-char racket-lambda-char 1))
(put 'racket-insert-lambda 'delete-selection t)
;;; racket--self-insert
(defun racket--self-insert (event)
"Simulate a `self-insert-command' of EVENT.
Using this intead of `insert' allows self-insert hooks to run,
which is important for things like `'electric-pair-mode'.
A command using this should probably set its 'delete-selection
property to t so that `delete-selection-mode' works:
(put 'racket-command 'delete-selection t)
If necessary the value of the property can be a function, for
example `racket--electric-pair-mode-not-active'."
(let ((last-command-event event)) ;set this for hooks
(self-insert-command (prefix-numeric-value nil))))
(defun racket--electric-pair-mode-not-active ()
"A suitable value for the 'delete-selection property of
commands that insert parens: Inserted text should replace the
selection unless a mode like `electric-pair-mode' is enabled, in
which case the selection is to be wrapped in parens."
(not (and (boundp 'electric-pair-mode)
electric-pair-mode)))
;;; Automatically insert matching \?) \?] or \?}
(defconst racket--matching-parens
'(( ?\( . ?\) )
( ?\[ . ?\] )
( ?\{ . ?\} )))
(defun racket-insert-closing (&optional prefix)
"Insert a matching closing delimiter.
With a prefix, insert the typed character as-is.
This is handy if you're not yet using `paredit-mode',
`smartparens-mode', or simply `electric-pair-mode' added in Emacs
24.5."
(interactive "P")
(let* ((do-it (not (or prefix
(and (string= "#\\"
(buffer-substring-no-properties
(- (point) 2) (point) )))
(racket--ppss-string-p (syntax-ppss)))))
(open-char (and do-it (racket--open-paren #'backward-up-list)))
(close-pair (and open-char (assq open-char racket--matching-parens)))
(close-char (and close-pair (cdr close-pair))))
(racket--self-insert (or close-char last-command-event))))
(put 'racket-insert-closing 'delete-selection
#'racket--electric-pair-mode-not-active)
;;; Smart open bracket
(defconst racket--smart-open-bracket-data
(eval-when-compile
`(;; cond-like
(0 0 ,(rx (seq "("
(or "augment"
"augment-final"
"augride"
"cond"
"field"
"inherit"
"inherit-field"
"inherit/super"
"inherit/inner"
"init"
"init-field"
"match-lambda"
"match-lambda*"
"match-lambda**"
"overment"
"override"
"override-final"
"public"
"pubment"
"public-final"
"rename-inner"
"rename-super"
"super-new")
(or space line-end))))
;; case-like
(2 0 ,(rx (seq "("
(or "case"
"new"
"match"
"match*"
"syntax-parse"
"syntax-rules")
(or space line-end))))
;; syntax-case
(3 0 ,(rx (seq "("
(or "syntax-case")
(or space line-end))))
;; syntax-case*
(4 0 ,(rx (seq "("
(or "syntax-case*")
(or space line-end))))
;; let-like
;;
;; In addition to the obvious suspects with 'let' in the name,
;; handles forms like 'parameterize', 'with-handlers', 'for',
;; and 'for/fold' accumulator bindings.
(0 1 ,(rx (seq (or "for"
"for/list"
"for/vector"
"for/hash"
"for/hasheq"
"for/hasheqv"
"for/and"
"for/or"
"for/lists"
"for/first"
"for/last"
"for/fold"
"for/flvector"
"for/extflvector"
"for/set"
"for/sum"
"for/product"
"for*"
"for*/list"
"for*/vector"
"for*/hash"
"for*/hasheq"
"for*/hasheqv"
"for*/and"
"for*/or"
"for*/lists"
"for*/first"
"for*/last"
"for*/fold"
"for*/flvector"
"for*/extflvector"
"for*/set"
"for*/sum"
"for*/product"
"fluid-let"
"let"
"let*"
"let*-values"
"let-struct"
"let-syntax"
"let-syntaxes"
"let-values"
"let/cc"
"let/ec"
"letrec"
"letrec-syntax"
"letrec-syntaxes"
"letrec-syntaxes+values"
"letrec-values"
"match-let"
"match-let*"
"match-let-values"
"match-let*-values"
"match-letrec"
"parameterize"
"parameterize*"
"with-handlers"
"with-handlers*"
"with-syntax"
"with-syntax*")
(or space line-end))))
;; for/fold bindings
;;
;; Note: Previous item handles the first, accumulators subform.
(0 2 ,(rx (seq (or "for/fold"
"for*/fold")
(or space line-end))))
;; named-let bindings
;;
(0 2 ,(rx (seq "let" (1+ whitespace) (1+ (not (in "()[]{}\",'`;#|\" "))))))))
"A list of lists. Each sub list is arguments to supply to
`racket--smart-open-bracket-helper'.")
(defun racket--smart-open-bracket-helper (pre-backward-sexps
post-backward-sexps
regexp)
"Is point is a subform (of a known form REGEXP) that should open with '['.
Returns '[' or nil."
(and (save-excursion
(ignore-errors
(backward-sexp pre-backward-sexps) t))
(save-excursion
(ignore-errors
(let ((pt (point)))
(backward-up-list)
(backward-sexp post-backward-sexps)
(when (looking-at-p regexp)
?\[))))))
(defun racket-smart-open-bracket ()
"Automatically insert a `(` or a `[` as appropriate.
When `racket-smart-open-bracket-enable' is nil, this simply
inserts `[`. Otherwise, this behaves like the \"Automatically
adjust opening square brackets\" feature in Dr. Racket:
By default, inserts a `(`. Inserts a `[` in the following cases:
- `let`-like bindings -- forms with `let` in the name as well
as things like `parameterize`, `with-handlers`, and
`with-syntax`.
- `case`, `cond`, `match`, `syntax-case`, `syntax-parse`, and
`syntax-rules` clauses.
- `for`-like bindings and `for/fold` accumulators.
- `class` declaration syntax, such as `init` and `inherit`.
When the previous s-expression in a sequence is a compound
expression, uses the same kind of delimiter.
To force insert `[`, use `quoted-insert': \\[quoted-insert] [.
Combined with `racket-insert-closing' this means that
you can press the unshifted `[` and `]` keys to get whatever
delimiters follow the Racket conventions for these forms. (When
`electric-pair-mode' or `paredit-mode' is active, you need not
even press `]`."
(interactive)
(let ((ch (or (and (not racket-smart-open-bracket-enable)
?\[)
(and (save-excursion
(let ((pt (point)))
(beginning-of-defun)
(let ((state (parse-partial-sexp (point) pt)))
(or (racket--ppss-string-p state)
(racket--ppss-comment-p state)))))
?\[)
(cl-some (lambda (xs)
(apply #'racket--smart-open-bracket-helper xs))
racket--smart-open-bracket-data)
(racket--open-paren #'backward-sexp)
?\()))
(if (fboundp 'racket--paredit-aware-open)
(racket--paredit-aware-open ch)
(racket--self-insert ch))))
(put 'racket-smart-open-bracket 'delete-selection
#'racket--electric-pair-mode-not-active)
(eval-after-load 'paredit
'(progn
(defvar paredit-mode-map nil) ;byte compiler
(declare-function paredit-open-round 'paredit)
(declare-function paredit-open-square 'paredit)
(declare-function paredit-open-curly 'paredit)
(defvar racket--paredit-original-open-bracket-binding
(lookup-key paredit-mode-map (kbd "["))
"The previous `paredit-mode-map' binding for [.
Rather than assuming that it's `paredit-open-square', we store
the actual value. This seems like the right thing to do in case
someone else is doing similar hackery.")
(add-hook 'paredit-mode-hook
(lambda ()
(define-key paredit-mode-map
(kbd "[") 'racket--paredit-open-square)))
(defun racket--paredit-open-square ()
"`racket-smart-open-bracket' or original `paredit-mode-map' binding.
To be compatible with `paredit-mode', `racket-smart-open-bracket'
must intercept [ and decide whether to call `paredit-open-round'
or `paredit-open-square'. To do so it must modify
`paredit-mode-map', which affects all major modes. Therefore we
check whether the current buffer's major mode is `racket-mode'.
If not we call the function in the variable
`racket--paredit-original-open-bracket-binding'."
(interactive)
(if (racket--mode-edits-racket-p)
(racket-smart-open-bracket)
(funcall racket--paredit-original-open-bracket-binding)))
(defun racket--paredit-aware-open (ch)
"A paredit-aware helper for `racket-smart-open-bracket'.
When `paredit-mode' is active, use its functions (such as
`paredit-open-round') Note: This function isn't defined unless
paredit is loaded, so check for this function's existence using
`fboundp'."
(let ((paredit-active (and (boundp 'paredit-mode) paredit-mode)))
(cond ((not paredit-active) (racket--self-insert ch))
((eq ch ?\() (paredit-open-round))
((eq ch ?\[) (paredit-open-square))
((eq ch ?\{) (paredit-open-curly))
(t (racket--self-insert ch)))))))
;;; paredit and reader literals
(defun racket--reader-literal-paredit-space-for-delimiter-predicate (endp delimiter)
"`paredit-mode' shouldn't insert space beteween # and open delimiters.
Examples: #() #2() #fl() #hasheq etc.
This function is a suitable element for the list variable
`paredit-space-for-delimiter-predicates'. "
(if (and (racket--mode-edits-racket-p)
(not endp))
(not (looking-back (rx ?# (* (or (syntax word) (syntax symbol))))
nil))
t))
(eval-after-load 'paredit
'(add-hook 'paredit-space-for-delimiter-predicates
#'racket--reader-literal-paredit-space-for-delimiter-predicate))
;;; paredit and at-expressions
(defun racket--at-expression-paredit-space-for-delimiter-predicate (endp delimiter)
"`paredit-mode' shouldn't insert space before [ or { in Racket at-expressions.
This function is a suitable element for the list variable
`paredit-space-for-delimiter-predicates'. "
(if (and (racket--mode-edits-racket-p)
(not endp))
(not (or
;; @foo[ @foo{
(and (memq delimiter '(?\[ ?\{))
(looking-back (rx ?@ (* (or (syntax word) (syntax symbol))))
nil))
;; @foo[]{
(and (eq delimiter ?\{)
(looking-back (rx ?@ (* (or (syntax word) (syntax symbol)))
?\[
(* (or (syntax word) (syntax symbol)))
?\])
nil))))
t))
(eval-after-load 'paredit
'(add-hook 'paredit-space-for-delimiter-predicates
#'racket--at-expression-paredit-space-for-delimiter-predicate))
;;; Cycle paren shapes
(defconst racket--paren-shapes
'( (?\( ?\[ ?\] )
(?\[ ?\{ ?\} )
(?\{ ?\( ?\) ))
"This is not user-configurable because we expect them have to
have actual ?\( and ?\) char syntax.")
(defun racket-cycle-paren-shapes ()
"Cycle the sexpr among () [] {}."
(interactive)
(save-excursion
(unless (eq ?\( (char-syntax (char-after)))
(backward-up-list))
(pcase (assq (char-after) racket--paren-shapes)
(`(,_ ,open ,close)
(delete-char 1)
(insert open)
(backward-char 1)
(forward-sexp 1)
(backward-delete-char 1)
(insert close))
(_
(user-error "Don't know that paren shape")))))
;;; racket--beginning-of-defun
(defun racket--beginning-of-defun-function ()
"Like `beginning-of-defun' but aware of Racket module forms."
(let ((orig (point)))
(racket--escape-string-or-comment)
(pcase (racket--module-level-form-start)
(`() (ignore-errors (backward-sexp 1)))
(pos (goto-char pos)))
(/= orig (point))))
(defun racket--module-level-form-start ()
"Start position of the module-level form point is within.
A module-level form is the outermost form not nested in a Racket
module form.
If point is not within a module-level form, returns nil.
If point is already exactly at the start of a module-level form,
-- i.e. on the opening ?\( -- returns nil.
If point is within a string or comment, returns nil.
This is NOT suitable for the variable `syntax-begin-function'
because it (i) doesn't move point, and (ii) doesn't know how to
find the start of a string or comment."
(save-excursion
(ignore-errors
(let ((pos nil)
(parse-sexp-ignore-comments t))
(while (ignore-errors
(goto-char (scan-lists (point) -1 1))
(unless (looking-at racket-module-forms)
(setq pos (point)))
t))
(and pos
(or (racket--sexp-comment-start pos)
pos))))))
(defun racket--sexp-comment-start (pos)
"Start pos of sexp comment (if any) immediately before POS.
Allows #; to be followed by zero or more space or newline chars."
(save-excursion
(goto-char pos)
(while (memq (char-before) '(32 ?\n))
(goto-char (1- (point))))
(when (string= "#;" (buffer-substring-no-properties (- (point) 2) (point)))
(- (point) 2))))
;;; Misc
(defun racket--escape-string-or-comment ()
"If point is in a string or comment, move to its start.
Note that this can be expensive, as it uses `syntax-ppss' which
parses from the start of the buffer. Although `syntax-ppss' uses
a cache, that is invalidated after any changes to the buffer. As
a result, the worst case would be to call this function after
every character is inserted to a buffer."
(pcase (racket--ppss-string/comment-start (syntax-ppss))
(`() nil)
(pos (goto-char pos))))
(defun racket-backward-up-list ()
"Like `backward-up-list' but works when point is in a string or comment.
Typically you should not use this command in Emacs Lisp --
especially not repeatedly. Instead, initially use
`racket--escape-string-or-comment' to move to the start of a
string or comment, if any, then use normal `backward-up-list'
repeatedly."
(interactive)
(racket--escape-string-or-comment)
(backward-up-list 1))
(defun racket--open-paren (back-func)
"Use BACK-FUNC to find an opening ( [ or { if any.
BACK-FUNC should be something like #'backward-sexp or #'backward-up-list."
(save-excursion
(ignore-errors
(funcall back-func)
(let ((ch (char-after)))
(and (eq ?\( (char-syntax ch))
ch)))))
(provide 'racket-common)
;; racket-common.el ends here

319
elpa/racket-mode-20180609.1253/racket-complete.el Normal file
View File

@@ -0,0 +1,319 @@
;;; racket-complete.el -*- lexical-binding: t -*-
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'cl-lib)
(require 'ido)
(require 'racket-custom)
(require 'racket-repl)
(require 'shr)
(require 's)
;;; namespace symbols i.e. completion candidates
(make-variable-buffer-local
(defvar racket--namespace-symbols nil
"A cache of the list of all Racket namespace symbols.
This var is local to each buffer, including the REPL buffer.
See `racket--invalidate-completion-cache' and
`racket--get-namespace-symbols'."))
(defun racket--invalidate-completion-cache ()
"Both current `racket-mode' buffer and `racket-repl-mode' buffer (if any)."
(setq racket--namespace-symbols nil)
(with-racket-repl-buffer
(setq racket--namespace-symbols nil)))
(defun racket--get-namespace-symbols ()
"Get Racket namespace symbols from the cache or from the Racket process."
(unless racket--namespace-symbols
(if (racket--in-repl-or-its-file-p)
(setq racket--namespace-symbols
(racket--repl-command "syms"))
(error "Completions not available until you `racket-run' this buffer")))
racket--namespace-symbols)
(defun racket--complete-prefix (prefix)
(all-completions prefix (racket--get-namespace-symbols)))
(defun racket--complete-prefix-begin ()
(save-excursion (skip-syntax-backward "^-()>")
(point)))
(defun racket--complete-prefix-end (beg)
(unless (or (eq beg (point-max))
(member (char-syntax (char-after beg)) '(?\" ?\( ?\))))
(let ((pos (point)))
(condition-case nil
(save-excursion
(goto-char beg)
(forward-sexp 1)
(when (>= (point) pos)
(point)))
(scan-error pos)))))
(defun racket-complete-at-point (&optional _predicate)
(with-syntax-table racket-mode-syntax-table ;probably don't need this??
(let* ((beg (racket--complete-prefix-begin))
(end (or (racket--complete-prefix-end beg) beg))
(prefix (and (> end beg) (buffer-substring-no-properties beg end)))
(cmps (and prefix (completion-table-dynamic
(lambda (_)
(racket--complete-prefix prefix))))))
(and cmps
(list beg
end
cmps
:predicate #'identity
:company-docsig #'racket--get-type
:company-doc-buffer #'racket--do-describe
:company-location #'racket--get-def-file+line)))))
(defun racket--get-def-file+line (sym)
"Return a value suitable for use as :company-location."
(pcase (racket--repl-command "def %s" sym)
(`(,path ,line ,_) (cons path line))
(_ nil)))
;;; "types" (i.e. TR types, contracts, and/or function signatures)
(make-variable-buffer-local
(defvar racket--type-cache (make-hash-table :test #'eq)
"Memoize ,type commands in Racket REPL.
`racket-run' should call `racket-invalidate-type-cache'."))
(defun racket--invalidate-type-cache ()
(setq racket--type-cache (make-hash-table :test #'eq))
(with-racket-repl-buffer
(setq racket--type-cache (make-hash-table :test #'eq))))
(defun racket--get-type (str)
(let* ((sym (intern str))
(v (gethash sym racket--type-cache)))
(or v
(and (racket--in-repl-or-its-file-p)
(let ((v (racket--repl-command (concat "type " str))))
(puthash sym v racket--type-cache)
v)))))
;;; at-point
(defun racket--symbol-at-point-or-prompt (force-prompt-p prompt)
"Helper for functions that want symbol-at-point, or, to prompt
when there is no symbol-at-point or FORCE-PROMPT-P is true. The
prompt uses `read-from-minibuffer'."
(racket--x-at-point-or-prompt force-prompt-p
prompt
#'read-from-minibuffer))
(defun racket--identifier-at-point-or-prompt (force-prompt-p prompt)
"Helper for functions that want symbol-at-point, or, to prompt
when there is no symbol-at-point or FORCE-PROMPT-P is true. The
prompt uses `racket--read-identifier'."
(racket--x-at-point-or-prompt force-prompt-p
prompt
#'racket--read-identifier))
(defun racket--x-at-point-or-prompt (force-prompt-p prompt reader)
"Helper for functions that want symbol-at-point, or, to prompt
when there is no symbol-at-point or FORCE-PROMPT-P is true. The
prompt uses READER, which must be a function like
`read-from-minibuffer'."
(let ((sap (symbol-at-point)))
(if (or force-prompt-p (not sap))
(let ((s (funcall reader prompt (and sap (symbol-name sap)))))
(if (equal "" (s-trim s))
nil
s))
sap)))
(defun racket--read-identifier (prompt default)
"Do `ido-completing-read with `racket--get-namespace-symbols'."
(ido-completing-read prompt
(racket--get-namespace-symbols)
nil ;predicate
nil ;require-match
default ;initial
nil ;history
default))
;;; eldoc
(defun racket-eldoc-function ()
"A value suitable for the variable `eldoc-documentation-function'.
By default racket-mode sets `eldoc-documentation-function' to nil
-- no `eldoc-mode' support. You may set it to this function in a
`racket-mode-hook' if you really want to use `eldoc-mode' with
Racket. But it is not a very satisfying experience because Racket
is not a very \"eldoc friendly\" language. Although racket-mode
attempts to discover argument lists, contracts, or types this
doesn't work in many common cases:
- Many Racket functions are defined in #%kernel. There's no easy
way to determine their argument lists. Most are not provided
with a contract.
- Many of the interesting Racket forms are syntax (macros) not
functions. There's no easy way to determine their \"argument
lists\".
A more satisfying experience is to use `racket-describe' or
`racket-doc'."
(and (racket--repl-live-p)
(> (point) (point-min))
(save-excursion
(condition-case nil
;; The char-before and looking-at checks below are to
;; avoid calling `racket--get-type' when the sexp is
;; quoted or when its first elem couldn't be a Racket
;; function name.
(let* ((beg (progn
(backward-up-list)
(and (not (memq (char-before) '(?` ?' ?,)))
(progn (forward-char 1) (point)))))
(beg (and beg (looking-at "[^0-9#'`,\"]") beg))
(end (and beg (progn (forward-sexp) (point))))
(end (and end
(char-after (point))
(eq ?\s (char-syntax (char-after (point))))
end))
(sym (and beg end (buffer-substring-no-properties beg end)))
(str (and sym (racket--get-type sym))))
str)
(scan-error nil)))))
;;; describe
(defun racket-describe (&optional prefix)
"Describe the identifier at point in a `*Racket Describe*` buffer.
The intent is to give a quick reminder or introduction to
something, regardless of whether it has installed documentation
-- and to do so within Emacs, without switching to a web browser.
This buffer is also displayed when you use `company-mode' and
press F1 or C-h in its pop up completion list.
- If the identifier has installed Racket documentation, then a
simplified version of the HTML is presented in the buffer,
including the \"blue box\", documentation prose, and examples.
- Otherwise, if the identifier is a function, then its signature
is displayed, for example `(name arg-1-name arg-2-name)`. If it
has a Typed Racket type or a contract, that is also displayed.
You can quit the buffer by pressing q. Also, at the bottom of the
buffer are Emacs buttons -- which you may navigate among using
TAB, and activate using RET -- for `racket-visit-definition' and
`racket-doc'."
(interactive "P")
(let ((sym (racket--identifier-at-point-or-prompt prefix
"Describe: ")))
(when sym
(racket--do-describe sym t))))
(defun racket--do-describe (sym &optional pop-to)
"A helper for `racket-describe' and company-mode.
POP-TO should be t for the former (in which case some buttons are
added) and nil for the latter.
Returns the buffer in which the description was written."
(let* ((bufname "*Racket Describe*")
(html (racket--repl-command "describe %s" sym))
;; Emacs shr renderer removes leading &nbsp; from <td> elements
;; -- which messes up the indentation of s-expressions including
;; contracts. So replace &nbsp with `spc' in the source HTML,
;; and replace `spc' with " " after shr-insert-document outputs.
(spc (string #x2020)) ;unlikely character (hopefully)
(dom (with-temp-buffer
(insert html)
(goto-char (point-min))
(while (re-search-forward "&nbsp;" nil t)
(replace-match spc t t))
(libxml-parse-html-region (point-min) (point-max))))
;; Work around what seems to be a bug with shr -- inserting
;; elements out of order, when an existing Racket Describe buffer
;; hasn't had a quit-window -- by re-creating the bufer.
(buf (get-buffer bufname))
(_ (and buf (kill-buffer buf)))
(buf (get-buffer-create bufname)))
(with-current-buffer buf
(racket-describe-mode)
(read-only-mode -1)
(erase-buffer)
(let ((shr-use-fonts nil))
(shr-insert-document dom))
(goto-char (point-min))
(while (re-search-forward spc nil t)
(replace-match " " t t))
(goto-char (point-max))
(when pop-to
(insert-text-button "Definition"
'action
`(lambda (_btn)
(racket--do-visit-def-or-mod
"def"
,(substring-no-properties (format "%s" sym)))))
(insert " ")
(insert-text-button "Documentation in Browser"
'action
`(lambda (_btn)
(racket--repl-command
"doc %s"
,(substring-no-properties (format "%s" sym)))))
(insert " [q]uit"))
(read-only-mode 1)
(goto-char (point-min))
(display-buffer (current-buffer) t)
(when pop-to
(pop-to-buffer (current-buffer))
(message "Type TAB to move to links, 'q' to restore previous window"))
(current-buffer))))
(defvar racket-describe-mode-map
(let ((m (make-sparse-keymap)))
(set-keymap-parent m special-mode-map)
(mapc (lambda (x)
(define-key m (kbd (car x)) (cadr x)))
'(("<tab>" racket-describe--next-button)
("S-<tab>" racket-describe--prev-button)))
m)
"Keymap for Racket Describe mode.")
(define-derived-mode racket-describe-mode special-mode
"RacketDescribe"
"Major mode for describing Racket functions.
\\{racket-describe-mode-map}"
(setq show-trailing-whitespace nil))
(defun racket-describe--next-button ()
(interactive)
(forward-button 1 t t))
(defun racket-describe--prev-button ()
(interactive)
(forward-button -1 t t))
(provide 'racket-complete)
;; racket-complete.el ends here

334
elpa/racket-mode-20180609.1253/racket-custom.el Normal file
View File

@@ -0,0 +1,334 @@
;;; racket-custom.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
;;; All `defcustom's and `defface's go here.
;;; This makes it easier to provide a consistent UI.
;; NOTE: `:prefix` is disabled as of Emacs 24.3, so I'm using explicit
;; `:tag`s. But also note that options are sorted (by default; user
;; can turn that off) based on the identifier name not the `:tag`. As
;; a result, I'm defining `:tag`s AS IF `:prefix "racket-"` did work.
;; In other words defcustom of racket-foo-bar has a :tag "Foo Bar".
(require 'rx)
(require 'sh-script) ;for sh-heredoc-face
(defgroup racket nil
"Editing and REPL for the Racket language."
:group 'languages
:link '(url-link :tag "README on GitHub" "https://github.com/greghendershott/racket-mode/blob/master/README.md"))
;; This should be _before_ the `defcustom' of `racket-program' (see
;; note in doc for `define-obsolete-variable-alias').
(define-obsolete-variable-alias
'racket-racket-program
'racket-program
"2017-06-02")
(make-obsolete-variable
'racket-raco-program
"You need only set `racket-program' to the Racket executable pathname."
"2017-06-02")
(defvar racket--winp (string-match "windows" (symbol-name system-type)))
(defcustom racket-program (cond (racket--winp "Racket.exe")
(t "racket"))
"Pathname of the racket executable."
:tag "Racket Program"
:type '(file :must-match t)
:risky t
:group 'racket)
(defcustom racket-command-port 55555
"Port number for Racket REPL command server."
:tag "Command Port"
:type 'integer
:risky t
:group 'racket)
(defcustom racket-command-timeout 10
"Timeout for Racket REPL command server."
:tag "Command Timeout"
:type 'integer
:risky t
:group 'racket)
(defcustom racket-memory-limit 2048
"Terminate the Racket process if memory use exceeds this value in MB.
Changes to this value take effect upon the next `racket-run'. A value
of 0 means no limit.
Caveat: This uses Racket's `custodian-limit-memory`, which does
not enforce the limit exactly. Instead, the program will be
terminated upon the first garbage collection where memory exceeds
the limit (maybe by a significant amount)."
:tag "Memory Limit"
:type 'integer
:safe #'integerp
:group 'racket)
(defcustom racket-error-context 'medium
"The level of context used for `racket-run' error stack traces.
Each level improves stack trace information, but causes your
program to run more slowly.
- 'low corresponds to `compile-context-preservation-enabled`
`#f`.
- 'medium corresponds to `compile-context-preservation-enabled`
`#t`, which disables some optimizations like inlining.
- 'high corresponds to `compile-context-preservation-enabled`
`#t` and to use of `errortrace`, which heavily instruments
your code and therefore may be significantly slower.
Tip: Regardless of this setting, you can enable 'high errortrace
for a specific `racket-run' using a C-u prefix. This lets you
normally run with a faster setting, and temporarily re-run to get
a more-helpful error message."
:tag "Error Context"
:type '(radio (const :tag "Low" low)
(const :tag "Medium (slower)" medium)
(const :tag "High (much slower)" high))
:risky t
:group 'racket)
;;; REPL
(defgroup racket-repl nil
"REPL Options"
:tag "REPL"
:group 'racket)
(defcustom racket-history-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
"Input matching this regexp are not saved on the history list.
Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters."
:tag "History Filter Regexp"
:type 'regexp
:safe #'stringp
:group 'racket-repl)
(defcustom racket-images-inline t
"Whether to display inline images in the REPL."
:tag "Images Inline"
:type 'boolean
:safe #'booleanp
:group 'racket-repl)
(defcustom racket-images-keep-last 100
"How many images to keep in the image cache."
:tag "Images Keep Last"
:type 'integer
:safe #'integerp
:group 'racket-repl)
(defcustom racket-images-system-viewer "display"
"Which system image viewer program to invoke upon M-x
`racket-view-last-image'."
:tag "Images System Viewer"
:type 'string
:risky t
:group 'racket-repl)
(defcustom racket-pretty-print t
"Use pretty-print instead of print in REPL."
:tag "Pretty Print"
:type 'boolean
:safe #'booleanp
:group 'racket-repl)
;;; Other
(defgroup racket-other nil
"Other Options"
:tag "Other"
:group 'racket)
(defcustom racket-indent-curly-as-sequence t
"Indent `{}` with items aligned with the head item?
This is indirectly disabled if `racket-indent-sequence-depth' is 0.
This is safe to set as a file-local variable."
:tag "Indent Curly As Sequence"
:type 'boolean
:safe #'booleanp
:group 'racket-other)
(defcustom racket-indent-sequence-depth 0
"To what depth should `racket-indent-line' search.
This affects the indentation of forms like `` '()` `() #() `` --
and `{}` if `racket-indent-curly-as-sequence' is t -- but not
`` #'() #`() ,() ,@() ``. A zero value disables, giving the
normal indent behavior of DrRacket or Emacs `lisp-mode' derived
modes like `scheme-mode'. Setting this to a high value can make
indentation noticeably slower. This is safe to set as a
file-local variable."
:tag "Indent Sequence Depth"
:type 'integerp
:safe #'integerp
:group 'racket-other)
(defcustom racket-pretty-lambda nil
"Display lambda keywords using λ. This is DEPRECATED.
Instead use `prettify-symbols-mode' in newer verisons of Emacs,
or, use `racket-insert-lambda' to insert actual λ characters."
:tag "Pretty Lambda"
:type 'boolean
:safe #'booleanp
:group 'racket-other)
(defcustom racket-smart-open-bracket-enable nil
"Use `racket-smart-open-bracket' when `[` is pressed?"
:tag "Smart Open Bracket Enable"
:type 'boolean
:safe #'booleanp
:group 'racket-other)
(defcustom racket-module-forms
(rx (syntax ?\()
(or (seq "module" (zero-or-one (any ?* ?+)))
"library"))
"Regexp for the start of a `module`-like form.
Affects what `beginning-of-defun' will move to.
This is safe to set as a file-local variable."
:tag "Top Level Forms"
:type 'string
:safe #'stringp
:group 'racket-other)
(defcustom racket-logger-config
'((cm-accomplice . warning)
(GC . info)
(module-prefetch . warning)
(optimizer . info)
(racket/contract . error)
(sequence-specialization . info)
(* . fatal))
"Configuration of `racket-logger-mode' topics and levels
The topic '* respresents the default level used for topics not
assigned a level. Otherwise, the topic symbols are the same as
used by Racket's `define-logger`.
The levels are those used by Racket's logging system: 'debug,
'info, 'warning, 'error, 'fatal.
For more information see:
<https://docs.racket-lang.org/reference/logging.html>
The default value sets some known \"noisy\" topics to be one
level quieter. That way you can set the '* topic to a level like
'debug and not get overhwelmed by these noisy topics."
:tag "Logger Configuration"
:type '(alist :key-type symbol :value-type symbol)
:safe (lambda (xs)
(cl-every (lambda (x)
(and (symbolp (car x))
(symbolp (cdr x))))
xs))
:group 'racket-other)
;;; Faces
(defgroup racket-faces nil
"Racket Faces"
:tag "Racket Faces"
:group 'faces
:group 'racket)
(defmacro defface-racket (id facespec docstr tag)
`(progn
(defconst ,id ',id)
(defface ,id
,facespec
,docstr
:tag ,tag
:group 'racket-faces)))
(defface-racket racket-check-syntax-def-face
'((t (:foreground "Black" :background "SeaGreen1" :weight bold)))
"Face `racket-check-syntax' uses to highlight definitions."
"Check Syntax Def Face")
(defface-racket racket-check-syntax-use-face
'((t (:foreground "Black" :background "PaleGreen1" :slant italic)))
"Face `racket-check-syntax' uses to highlight uses."
"Check Syntax Use Face")
(defface-racket racket-keyword-argument-face
'((((background dark))
(:foreground "IndianRed"))
(((background light))
(:foreground "Red3")))
"Face for `#:keyword` arguments."
"Keyword Argument Face")
(define-obsolete-face-alias
'racket-paren-face
"Instead use the `paren-face' package: <https://melpa.org/#/paren-face>."
"2017-06-13")
(defface-racket racket-selfeval-face
'((t (:foreground "SeaGreen")))
"Face for self-evaluating expressions like numbers, symbols, strings."
"Selfeval Face")
(defface-racket racket-here-string-face
'((t (:inherit sh-heredoc-face)))
"Face for here strings."
"Here String Face")
(defface-racket racket-logger-config-face
'((t (:inherit font-lock-comment-face :slant italic)))
"Face for `racket-logger-mode' configuration."
"Racket Logger Config Face")
(defface-racket racket-logger-topic-face
'((t (:inherit font-lock-function-name-face :slant italic)))
"Face for `racket-logger-mode' topics."
"Racket Logger Config Face")
(defface-racket racket-logger-fatal-face
'((t (:inherit error :weight bold)))
"Face for `racket-logger-mode' fatal level."
"Racket Logger Fatal Face")
(defface-racket racket-logger-error-face
'((t (:inherit error)))
"Face for `racket-logger-mode' error level."
"Racket Logger Error Face")
(defface-racket racket-logger-warning-face
'((t (:inherit warning)))
"Face for `racket-logger-mode' warning level."
"Racket Logger Warning Face")
(defface-racket racket-logger-info-face
'((t (:inherit font-lock-string-face)))
"Face for `racket-logger-mode' info level."
"Racket Logger Info Face")
(defface-racket racket-logger-debug-face
'((t (:inherit font-lock-constant-face)))
"Face for `racket-logger-mode' debug level."
"Racket Logger Debug Face")
(provide 'racket-custom)
;; racket-custom.el ends here

951
elpa/racket-mode-20180609.1253/racket-edit.el Normal file
View File

@@ -0,0 +1,951 @@
;;; racket-edit.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
;; racket-mode per se, i.e. the .rkt file buffers
(require 'cl-lib)
(require 'cl-macs)
(require 'racket-custom)
(require 'racket-common)
(require 'racket-complete)
(require 'racket-util)
(require 'hideshow)
(require 'tooltip)
(defun racket-run (&optional errortracep)
"Save and evaluate the buffer in REPL, much like DrRacket's Run.
With a C-u prefix, uses errortrace for improved stack traces.
Otherwise follows the `racket-error-context' setting.
If point is within a Racket `module` form, the REPL \"enters\"
that submodule (uses its language info and namespace).
When you run again, the file is evaluated from scratch -- the
custodian releases resources like threads and the evaluation
environment is reset to the contents of the file. In other words,
like DrRacket, this provides the predictability of a \"static\"
baseline, plus the ability to explore interactively using the
REPL.
See also `racket-run-and-switch-to-repl', which is even more like
DrRacket's Run because it selects the REPL window (gives it the
focus), too.
If your source file has a syntax or runtime error, a \"skeleton\"
of your file is evaluated to get identifiers from module
languages, `require`s, and definitions. That way, things like
completion and `racket-describe' are more likely to work while
you edit the file to fix the error. If not even the \"skeleton\"
evaluation succeeds, you'll have only identifiers provided by
racket/base, until you fix the error and run again.
Output in the `*Racket REPL*` buffer that describes a file and
position is automatically \"linkified\". Examples of such text
include:
- Racket error messages.
- `rackunit` test failure location messages.
- `print`s of `#<path>` objects.
To visit these locations, move point there and press RET or mouse
click. Or, use the standard `next-error' and `previous-error'
commands.
In the `*Racket REPL*` buffer you can issue some special
commands. Some of them are the foundation for Emacs commands.
Others are available only as a command in the REPL.
- `,help`: See these commands.
- `,top`: Reset the REPL to an empty module (i.e. a racket/base namespace).
- `,run <module>` : What `racket-run' uses.
- `<module> = <file> | (<file> <submodule-id> ...)`
- `<file> = file.rkt | /path/to/file.rkt | \"file.rkt\" | \"/path/to/file.rkt\"`
- `,exit`: Exit Racket. Handy in a `#lang` like r5rs where the
`exit` procedure is not available. (Regardless of how Racket
exits, the `*Racket REPL*` buffer is not killed and is reused
if you `racket-run' again.)
- `,doc <symbol-or-string>`: Look for `<symbol-or-string>` in
Racket's documentation. What `racket-doc' uses.
- `,cd`, `,pwd`: Change and show `current-directory`."
(interactive "P")
(racket--do-run (if errortracep
'high
racket-error-context)))
(defun racket-run-with-errortrace ()
"Run with `racket-error-context' temporarily set to 'high.
This is just `racket-run' with a C-u prefix. Defined as a function so
it can be a menu target."
(interactive)
(racket-run t))
(defvar-local racket-user-command-line-arguments
nil
"List of command-line arguments to supply to your Racket program.
Accessible in your Racket program in the usual way -- the
parameter `current-command-line-arguments` and friends.
This is an Emacs buffer-local variable -- convenient to set as a
file local variable. For example at the end of your .rkt file:
;; Local Variables:
;; racket-user-command-line-arguments: (\"-f\" \"bar\")
;; End:
Set this way the value must be an unquoted list of strings such
as:
(\"-f\" \"bar\")
but NOT:
'(\"-f\" \"bar\")
(list \"-f\" \"bar\")
")
(defun racket--do-run (context-level &optional what-to-run)
"Helper function for `racket-run'-like commands.
Supplies CONTEXT-LEVEL to the back-end ,run command; see run.rkt.
If supplied, WHAT-TO-RUN should be a buffer filename, or a cons
of a file name to a list of submodule symbols. Otherwise, the
`racket--what-to-run' is used."
(unless (eq major-mode 'racket-mode)
(user-error "Current buffer is not a racket-mode buffer"))
(when (or (buffer-modified-p)
(and (racket--buffer-file-name)
(not (file-exists-p (racket--buffer-file-name)))))
(save-buffer))
(remove-overlays (point-min) (point-max) 'name 'racket-uncovered-overlay)
(racket--invalidate-completion-cache)
(racket--invalidate-type-cache)
(racket--repl-eval ",run %S %s %s %s %S\n"
(or what-to-run (racket--what-to-run))
racket-memory-limit
racket-pretty-print
context-level
racket-user-command-line-arguments))
(defun racket--what-to-run ()
(cons (racket--buffer-file-name) (racket--submod-path)))
(defun racket--submod-path ()
(and (racket--lang-p)
(racket--modules-at-point)))
(defun racket--lang-p ()
"Is #lang the first sexpr in the file?"
(save-excursion
(goto-char 0)
(ignore-errors
(forward-sexp)
(backward-sexp)
(looking-at (rx "#lang")))))
(defun racket--modules-at-point ()
"List of module names that point is within, from outer to inner.
Ignores module forms nested (at any depth) in any sort of plain
or syntax quoting, because those won't be valid Racket syntax."
(let ((xs nil))
(condition-case ()
(save-excursion
(save-match-data
(racket--escape-string-or-comment)
(while t
(when (racket--looking-at-module-form)
(push (intern (match-string-no-properties 1)) xs))
(when (racket--looking-at-quoted-form)
(push nil xs))
(backward-up-list))))
(scan-error xs))
(racket--take-while xs #'identity)))
(defun racket--looking-at-module-form ()
"Sets match data group 1 to the module name."
(looking-at (rx ?\(
(or "module" "module*" "module+")
(1+ " ")
(group (+ (or (syntax symbol)
(syntax word)))))))
(defun racket--looking-at-quoted-form ()
(or (memq (char-before) '(?\' ?\` ?\,))
(and (eq (char-before (1- (point))) ?\,)
(eq (char-before) ?\@))
(looking-at
(rx ?\(
(or "quote" "quasiquote"
"unquote" "unquote-splicing"
"quote-syntax"
"syntax" "syntax/loc"
"quasisyntax" "quasisyntax/loc"
"unsyntax" "unsyntax-splicing")
" "))))
(defun racket-run-and-switch-to-repl (&optional errortracep)
"This is `racket-run' followed by `racket-switch-to-repl'.
With a C-u prefix, uses errortrace for improved stack traces.
Otherwise follows the `racket-error-context' setting."
(interactive "P")
(racket-run errortracep)
(racket-repl))
(defun racket-racket ()
"Do `racket <file>` in `*shell*` buffer."
(interactive)
(racket--shell (concat racket-program
" "
(shell-quote-argument (racket--buffer-file-name)))))
(defun racket-test (&optional coverage)
"Run the `test` submodule.
With prefix, runs with coverage instrumentation and highlights
uncovered code.
Put your tests in a `test` submodule. For example:
(module+ test
(require rackunit)
(check-true #t))
rackunit test failure messages show the location. You may use
`next-error' to jump to the location of each failing test.
See also:
- `racket-fold-all-tests'
- `racket-unfold-all-tests'
"
(interactive "P")
(racket--do-run (if coverage 'coverage racket-error-context)
(list 'submod (racket--buffer-file-name) 'test))
(when coverage
(message "Running tests with coverage instrumentation enabled...")
(while (not (racket--repl-command "prompt"))
(sit-for 0.5))
(message "Processing coverage results...")
(pcase (racket--repl-command "get-uncovered")
((and xs `((,beg0 . ,_) . ,_))
(dolist (x xs)
(let ((o (make-overlay (car x) (cdr x))))
(overlay-put o 'name 'racket-uncovered-overlay)
(overlay-put o 'priority 100)
(overlay-put o 'face font-lock-warning-face)))
(message "Missing coverage in %s place(s)." (length xs))
(goto-char beg0))
(_ (message "Full coverage.")))))
(defun racket-raco-test ()
"Do `raco test -x <file>` in `*shell*` buffer.
To run <file>'s `test` submodule."
(interactive)
(racket--shell (concat racket-program
" -l raco test -x "
(shell-quote-argument (racket--buffer-file-name)))))
(defun racket--shell (cmd)
(let ((w (selected-window)))
(save-buffer)
(pcase (get-buffer-window "*shell*" t)
(`() (other-window -1))
(win (select-window win)))
(with-temp-message cmd
(shell)
(pop-to-buffer-same-window "*shell*")
(comint-send-string "*shell*" (concat cmd "\n"))
(select-window w)
(sit-for 3))))
;;; visiting defs and mods
(defun racket-visit-definition (&optional prefix)
"Visit definition of symbol at point.
Use \\[racket-unvisit] to return.
Note: Only finds symbols defined in the current namespace. You
may need to invoke `racket-run' on the current buffer, first.
Note: Only visits the definition of module level identifiers (i.e.
things for which Racket's `identifier-binding` function returns a
list, as opposed to `'lexical`).
Note: If the definition is from Racket's `#%kernel` module, it
will tell you so but won't visit the definition site."
(interactive "P")
(let ((sym (racket--identifier-at-point-or-prompt prefix
"Visit definition of: ")))
(when sym
(racket--do-visit-def-or-mod "def" sym))))
(defun racket--do-visit-def-or-mod (cmd sym)
"CMD must be \"def\" or \"mod\". SYM must be `symbolp`."
(pcase (racket--repl-command "%s %s" cmd sym)
(`(,path ,line ,col)
(racket--push-loc)
(find-file path)
(goto-char (point-min))
(forward-line (1- line))
(forward-char col)
(message "Type M-, to return"))
(`kernel
(message "`%s' defined in #%%kernel -- source not available." sym))
(_ (when (y-or-n-p "Not found. Run current buffer and try again? ")
(racket-run)
(racket--do-visit-def-or-mod cmd sym)))))
(defun racket-visit-module (&optional prefix)
"Visit definition of module at point, e.g. net/url or \"file.rkt\".
Use \\[racket-unvisit] to return.
Note: Only works if you've `racket-run' the buffer so that its
namespace is active.
See also: `racket-find-collection'."
(interactive "P")
(let* ((v (thing-at-point 'filename)) ;matches both net/url and "file.rkt"
(v (and v (substring-no-properties v)))
(v (if (or prefix (not v))
(read-from-minibuffer "Visit module: " (or v ""))
v)))
(racket--do-visit-def-or-mod "mod" v)))
(defun racket-doc (&optional prefix)
"View documentation of the identifier or string at point.
Uses the default external web browser.
If point is an identifier required in the current namespace that
has help, opens the web browser directly at that help
topic. (i.e. Uses the identifier variant of racket/help.)
Otherwise, opens the 'search for a term' page, where you can
choose among multiple possibilities. (i.e. Uses the string
variant of racket/help.)
With a C-u prefix, prompts for the identifier or quoted string,
instead of looking at point."
(interactive "P")
(let ((sym (racket--symbol-at-point-or-prompt prefix
"Racket help for: ")))
(when sym
(racket--repl-command "doc %s" sym))))
(defvar racket--loc-stack '())
(defun racket--push-loc ()
(push (cons (current-buffer) (point))
racket--loc-stack))
(defun racket-unvisit ()
"Return from previous `racket-visit-definition' or `racket-visit-module'."
(interactive)
(if racket--loc-stack
(pcase (pop racket--loc-stack)
(`(,buffer . ,pt)
(pop-to-buffer-same-window buffer)
(goto-char pt)))
(message "Stack empty.")))
;;; code folding
;;;###autoload
(add-to-list 'hs-special-modes-alist
'(racket-mode "(" ")" ";" nil nil))
(defun racket--for-all-tests (verb f)
(save-excursion
(goto-char (point-min))
(let ((n 0))
(while (re-search-forward "^(module[+*]? test" (point-max) t)
(funcall f)
(cl-incf n)
(goto-char (match-end 0)))
(message "%s %d test submodules" verb n))))
(defun racket-fold-all-tests ()
"Fold (hide) all test submodules."
(interactive)
(racket--for-all-tests "Folded" 'hs-hide-block))
(defun racket-unfold-all-tests ()
"Unfold (show) all test submodules."
(interactive)
(racket--for-all-tests "Unfolded" 'hs-show-block))
;;; macro expansion
(defun racket-expand-region (start end &optional prefix)
"Like `racket-send-region', but macro expand.
With C-u prefix, expands fully.
Otherwise, expands once. You may use `racket-expand-again'."
(interactive "rP")
(unless (region-active-p)
(user-error "No region"))
(racket--repl-send-expand-command prefix)
(racket--send-region-to-repl start end))
(defun racket-expand-definition (&optional prefix)
"Like `racket-send-definition', but macro expand.
With C-u prefix, expands fully.
Otherwise, expands once. You may use `racket-expand-again'."
(interactive "P")
(racket--repl-send-expand-command prefix)
(racket-send-definition))
(defun racket-expand-last-sexp (&optional prefix)
"Like `racket-send-last-sexp', but macro expand.
With C-u prefix, expands fully.
Otherwise, expands once. You may use `racket-expand-again'."
(interactive "P")
(racket--repl-send-expand-command prefix)
(racket-send-last-sexp))
(defun racket--repl-send-expand-command (prefix)
(comint-send-string (racket--get-repl-buffer-process)
(if prefix ",exp!" ",exp ")))
(defun racket-expand-again ()
"Macro expand again the previous expansion done by one of:
- `racket-expand-region'
- `racket-expand-definition'
- `racket-expand-last-sexp'
- `racket-expand-again'"
(interactive)
(comint-send-string (racket--get-repl-buffer-process) ",exp+\n"))
;;; requires
(defun racket-tidy-requires ()
"Make a single top-level `require`, modules sorted, one per line.
All top-level `require` forms are combined into a single form.
Within that form:
- A single subform is used for each phase level, sorted in this
order: for-syntax, for-template, for-label, for-meta, and
plain (phase 0).
- Within each level subform, the modules are sorted:
- Collection path modules -- sorted alphabetically.
- Subforms such as `only-in`.
- Quoted relative requires -- sorted alphabetically.
At most one module is listed per line.
Note: This only works for requires at the top level of a source
file using `#lang`. It does *not* work for `require`s inside
`module` forms.
See also: `racket-trim-requires' and `racket-base-requires'."
(interactive)
(let* ((reqs (racket--top-level-requires 'find))
(new (and reqs
(racket--repl-command "requires/tidy %S" reqs))))
(unless (string-equal "" new)
(goto-char (racket--top-level-requires 'kill))
(insert (concat new "\n")))))
(defun racket-trim-requires ()
"Like `racket-tidy-requires' but also deletes unused modules.
Note: This only works when the source file can be evaluated with
no errors.
Note: This only works for requires at the top level of a source
file using `#lang`. It does *not* work for `require`s inside
`module` forms.
See also: `racket-base-requires'."
(interactive)
(when (buffer-modified-p) (save-buffer))
(let* ((reqs (racket--top-level-requires 'find))
(new (and reqs
(racket--repl-command
"requires/trim \"%s\" %S"
(racket--buffer-file-name)
reqs))))
(unless new
(user-error "Can't do, source file has error"))
(goto-char (racket--top-level-requires 'kill))
(unless (string-equal "" new)
(insert (concat new "\n")))))
(defun racket-base-requires ()
"Change from `#lang racket` to `#lang racket/base`.
Adds explicit requires for modules that are provided by `racket`
but not by `racket/base`.
This is a recommended optimization for Racket applications.
Avoiding loading all of `racket` can reduce load time and memory
footprint.
Also, as does `racket-trim-requires', this removes unneeded
modules and tidies everything into a single, sorted require form.
Note: This only works when the source file can be evaluated with
no errors.
Note: This only works for requires at the top level of a source
file using `#lang`. It does *not* work for `require`s inside
`module` forms.
Note: Currently this only helps change `#lang racket` to
`#lang racket/base`. It does *not* help with other similar conversions,
such as changing `#lang typed/racket` to `#lang typed/racket/base`."
(interactive)
(when (racket--buffer-start-re "^#lang.*? racket/base$")
(user-error "Already using #lang racket/base. Nothing to change."))
(unless (racket--buffer-start-re "^#lang.*? racket$")
(user-error "File does not use use #lang racket. Cannot change."))
(when (buffer-modified-p) (save-buffer))
(let* ((reqs (racket--top-level-requires 'find))
(new (racket--repl-command
"requires/base \"%s\" %S"
(racket--buffer-file-name)
reqs)))
(unless new
(user-error "Source file has error"))
(goto-char (point-min))
(re-search-forward "^#lang.*? racket$")
(insert "/base")
(goto-char (or (racket--top-level-requires 'kill)
(progn (insert "\n") (point))))
(unless (string= "" new)
(insert (concat new "\n")))))
(defun racket--buffer-start-re (re)
(save-excursion
(ignore-errors
(goto-char (point-min))
(re-search-forward re)
t)))
(defun racket--top-level-requires (what)
"Identify all top-level requires and do WHAT.
When WHAT is 'find, returns the top-level require forms.
When WHAT is 'kill, kill the top-level requires, returning the
location of the first one."
(save-excursion
(goto-char (point-min))
(let ((first-beg nil)
(requires nil))
(while (re-search-forward "^(require " nil t)
(let* ((beg (progn (up-list -1) (point)))
(end (progn (forward-sexp) (point)))
(str (buffer-substring-no-properties beg end))
(sexpr (read str)))
(unless first-beg (setq first-beg beg))
(setq requires (cons sexpr requires))
(when (eq 'kill what)
(kill-sexp -1)
(delete-blank-lines))))
(if (eq 'kill what) first-beg requires))))
;;; racket-check-syntax
(defvar racket--highlight-overlays nil)
(defun racket--highlight (beg end defp)
;; Unless one of our highlight overlays already exists there...
(let ((os (overlays-at beg)))
(unless (cl-some (lambda (o) (member o racket--highlight-overlays)) os)
(let ((o (make-overlay beg end)))
(setq racket--highlight-overlays (cons o racket--highlight-overlays))
(overlay-put o 'name 'racket-check-syntax-overlay)
(overlay-put o 'priority 100)
(overlay-put o 'face (if defp
racket-check-syntax-def-face
racket-check-syntax-use-face))))))
(defun racket--unhighlight-all ()
(while racket--highlight-overlays
(delete-overlay (car racket--highlight-overlays))
(setq racket--highlight-overlays (cdr racket--highlight-overlays))))
(defun racket--non-empty-string-p (v)
(and (stringp v)
(not (string-match-p "\\`[ \t\n\r]*\\'" v)))) ;`string-blank-p'
(defun racket--point-entered (_old new)
(pcase (get-text-property new 'help-echo)
((and s (pred racket--non-empty-string-p))
(if (and (boundp 'tooltip-mode)
tooltip-mode
(fboundp 'window-absolute-pixel-position))
(pcase (window-absolute-pixel-position new)
(`(,left . ,top)
(let ((tooltip-frame-parameters `((left . ,left)
(top . ,top)
,@tooltip-frame-parameters)))
(tooltip-show s))))
(message "%s" s))))
(pcase (get-text-property new 'racket-check-syntax-def)
((and uses `((,beg ,end) . ,_))
(pcase (get-text-property beg 'racket-check-syntax-use)
(`(,beg ,end) (racket--highlight beg end t)))
(dolist (use uses)
(pcase use (`(,beg ,end) (racket--highlight beg end nil))))))
(pcase (get-text-property new 'racket-check-syntax-use)
(`(,beg ,end)
(racket--highlight beg end t)
(dolist (use (get-text-property beg 'racket-check-syntax-def))
(pcase use (`(,beg ,end) (racket--highlight beg end nil)))))))
(defun racket--point-left (_old _new)
(racket--unhighlight-all))
(defun racket-check-syntax-mode-quit ()
(interactive)
(racket-check-syntax-mode -1))
(defun racket-check-syntax-mode-goto-def ()
"When point is on a use, go to its definition."
(interactive)
(pcase (get-text-property (point) 'racket-check-syntax-use)
(`(,beg ,end) (goto-char beg))))
(defun racket-check-syntax-mode-forward-use (amt)
"When point is on a use, go AMT uses forward. AMT may be negative.
Moving before/after the first/last use wraps around.
If point is instead on a definition, then go to its first use."
(pcase (get-text-property (point) 'racket-check-syntax-use)
(`(,beg ,end)
(pcase (get-text-property beg 'racket-check-syntax-def)
(uses (let* ((pt (point))
(ix-this (cl-loop for ix from 0 to (1- (length uses))
for use = (nth ix uses)
when (and (<= (car use) pt) (< pt (cadr use)))
return ix))
(ix-next (+ ix-this amt))
(ix-next (if (> amt 0)
(if (>= ix-next (length uses)) 0 ix-next)
(if (< ix-next 0) (1- (length uses)) ix-next)))
(next (nth ix-next uses)))
(goto-char (car next))))))
(_ (pcase (get-text-property (point) 'racket-check-syntax-def)
(`((,beg ,end) . ,_) (goto-char beg))))))
(defun racket-check-syntax-mode-goto-next-use ()
"When point is on a use, go to the next (sibling) use."
(interactive)
(racket-check-syntax-mode-forward-use 1))
(defun racket-check-syntax-mode-goto-prev-use ()
"When point is on a use, go to the previous (sibling) use."
(interactive)
(racket-check-syntax-mode-forward-use -1))
(defun racket-check-syntax-mode-help ()
(interactive)
(describe-function #'racket-check-syntax-mode))
(defun racket-check-syntax-mode-rename ()
(interactive)
;; If we're on a def, get its uses. If we're on a use, get its def.
(let* ((pt (point))
(uses (get-text-property pt 'racket-check-syntax-def))
(def (get-text-property pt 'racket-check-syntax-use)))
;; If we got one, get the other.
(when (or uses def)
(let* ((uses (or uses (get-text-property (car def) 'racket-check-syntax-def)))
(def (or def (get-text-property (caar uses) 'racket-check-syntax-use)))
(locs (cons def uses))
(strs (mapcar (lambda (loc)
(apply #'buffer-substring-no-properties loc))
locs)))
;; Proceed only if all the strings are the same. (They won't
;; be for e.g. import bindings.)
(when (cl-every (lambda (s) (equal (car strs) s))
(cdr strs))
(let ((new (read-from-minibuffer (format "Rename %s to: " (car strs))))
(marker-pairs
(mapcar (lambda (loc)
(let ((beg (make-marker))
(end (make-marker)))
(set-marker beg (nth 0 loc) (current-buffer))
(set-marker end (nth 1 loc) (current-buffer))
(list beg end)))
locs))
(point-marker (let ((m (make-marker)))
(set-marker m (point) (current-buffer)))))
(racket-check-syntax-mode -1)
(dolist (marker-pair marker-pairs)
(let ((beg (marker-position (nth 0 marker-pair)))
(end (marker-position (nth 1 marker-pair))))
(delete-region beg end)
(goto-char beg)
(insert new)))
(goto-char (marker-position point-marker))
(racket-check-syntax-mode 1)))))))
(defun racket-check-syntax-mode-goto-next-def ()
(interactive)
(let ((pos (next-single-property-change (point) 'racket-check-syntax-def)))
(when pos
(unless (get-text-property pos 'racket-check-syntax-def)
(setq pos (next-single-property-change pos 'racket-check-syntax-def)))
(and pos (goto-char pos)))))
(defun racket-check-syntax-mode-goto-prev-def ()
(interactive)
(let ((pos (previous-single-property-change (point) 'racket-check-syntax-def)))
(when pos
(unless (get-text-property pos 'racket-check-syntax-def)
(setq pos (previous-single-property-change pos 'racket-check-syntax-def)))
(and pos (goto-char pos)))))
(define-minor-mode racket-check-syntax-mode
"Analyze the buffer and annotate with information.
The buffer becomes read-only until you exit this minor mode.
However you may navigate the usual ways. When point is on a
definition or use, related items are highlighted and
information is displayed in the echo area. You may also use
special commands to navigate among the definition and its uses.
```
\\{racket-check-syntax-mode-map}
```
"
:lighter " CheckSyntax"
:keymap (racket--easy-keymap-define
'(("q" racket-check-syntax-mode-quit)
("h" racket-check-syntax-mode-help)
(("j" "TAB") racket-check-syntax-mode-goto-next-def)
(("k" "<backtab>") racket-check-syntax-mode-goto-prev-def)
("." racket-check-syntax-mode-goto-def)
("n" racket-check-syntax-mode-goto-next-use)
("p" racket-check-syntax-mode-goto-prev-use)
("r" racket-check-syntax-mode-rename)))
(unless (eq major-mode 'racket-mode)
(setq racket-check-syntax-mode nil)
(user-error "racket-check-syntax-mode only works with racket-mode"))
(racket--check-syntax-stop)
(when racket-check-syntax-mode
(racket--check-syntax-start)))
(defvar racket--check-syntax-start-timeout 30)
(defun racket--check-syntax-start ()
(let ((xs (with-temp-message "Analyzing..."
(let ((racket-command-timeout racket--check-syntax-start-timeout))
(racket--repl-command "check-syntax \"%s\""
(buffer-file-name))))))
(unless xs
(racket-check-syntax-mode -1)
(user-error "No bindings found"))
(unless (listp xs)
(racket-check-syntax-mode -1)
(error "Requires a newer version of Racket."))
(with-silent-modifications
(dolist (x xs)
(pcase x
(`(,`info ,beg ,end ,str)
(put-text-property beg end 'help-echo str))
(`(,`def/uses ,def-beg ,def-end ,uses)
(add-text-properties def-beg
def-end
(list 'racket-check-syntax-def uses
'point-entered #'racket--point-entered
'point-left #'racket--point-left))
(dolist (use uses)
(pcase-let* ((`(,use-beg ,use-end) use))
(add-text-properties use-beg
use-end
(list 'racket-check-syntax-use (list def-beg
def-end)
'point-entered #'racket--point-entered
'point-left #'racket--point-left)))))))
(setq buffer-read-only t)
(setq header-line-format
"Check Syntax. Buffer is read-only. Press h for help, q to quit.")
;; Make 'point-entered and 'point-left work in Emacs 25+. Note
;; that this is somewhat of a hack -- I spent a lot of time
;; trying to Do the Right Thing using the new
;; cursor-sensor-mode, but could not get it to work
;; satisfactorily. See:
;; http://emacs.stackexchange.com/questions/29813/point-motion-strategy-for-emacs-25-and-older
(setq-local inhibit-point-motion-hooks nil)
;; Go to next definition, as an affordance/hint what this does:
(racket-check-syntax-mode-goto-next-def))))
(defun racket--check-syntax-stop ()
(setq header-line-format nil)
(with-silent-modifications
(remove-text-properties (point-min)
(point-max)
'(help-echo nil
racket-check-syntax-def nil
racket-check-syntax-use nil
point-entered
point-left))
(racket--unhighlight-all)
(setq buffer-read-only nil)))
;;; align
(defun racket-align ()
"Align values in the same column.
Useful for binding forms like `let` and `parameterize`,
conditionals like `cond` and `match`, association lists, and any
series of couples like the arguments to `hash`.
Before choosing this command, put point on the first of a series
of \"couples\". A couple is:
- A list of two or more sexprs: `[sexpr val sexpr ...]`
- Two sexprs: `sexpr val`.
Each `val` moves to the same column and is
`prog-indent-sexp'-ed (in case it is a multi-line form).
For example with point on the `[` before `a`:
Before After
(let ([a 12] (let ([a 12]
[bar 23]) [bar 23])
....) ....)
'([a . 12] '([a . 12]
[bar . 23]) [bar . 23])
(cond [a? #t] (cond [a? #t]
[b? (f x [b? (f x
y)] y)]
[else #f]) [else #f])
Or with point on the `'` before `a`:
(list 'a 12 (list 'a 12
'bar 23) 'bar 23)
If more than one couple is on the same line, none are aligned,
because it is unclear where the value column should be. For
example the following form will not change; `racket-align' will
display an error message:
(let ([a 0][b 1]
[c 2]) error; unchanged
....)
When a couple's sexprs start on different lines, that couple is
ignored. Other, single-line couples in the series are aligned as
usual. For example:
(let ([foo (let ([foo
0] 0]
[bar 1] [bar 1]
[x 2]) [x 2])
....) ....)
See also: `racket-unalign'."
(interactive)
(save-excursion
(let ((listp (eq ?\( (char-syntax (char-after))))
(prev-line 0)
(max-col 0))
(racket--for-each-couple listp
(lambda ()
(setq max-col (max max-col (current-column)))
(let ((this-line (line-number-at-pos)))
(when (= prev-line this-line)
(user-error
"Can't align if any couples are on same line"))
(setq prev-line this-line))))
(racket--for-each-couple listp
(lambda ()
(indent-to max-col)
(prog-indent-sexp))))))
(defun racket-unalign ()
"The opposite of `racket-align'.
Effectively does M-x `just-one-space' and `prog-indent-sexp' for
each couple's value."
(interactive)
(save-excursion
(let ((listp (eq ?\( (char-syntax (char-after)))))
(racket--for-each-couple listp
(lambda ()
(just-one-space)
(prog-indent-sexp))))))
(defun racket--for-each-couple (listp f)
"Move point to each value sexp of a couple, and `funcall' F.
Only call F when the couple's sexprs are on the same line.
When LISTP is true, expects couples to be `[id val]`, else `id val`."
(save-excursion
(condition-case ()
(while t
(when listp
(down-list))
(forward-sexp)
(let ((line (line-number-at-pos)))
(forward-sexp)
(backward-sexp)
(when (= line (line-number-at-pos))
;; Defensive: Backup over any prefix or punctuation
;; chars just in case backward-sexp didn't (although it
;; should have if our syntax table is correct).
(while (memq (char-syntax (char-before)) '(?\' ?\.))
(goto-char (1- (point))))
(funcall f)))
;; On to the next couple...
(if listp
(up-list)
(forward-sexp)))
(scan-error nil))))
(provide 'racket-edit)
;; racket-edit.el ends here

351
elpa/racket-mode-20180609.1253/racket-font-lock.el Normal file
View File

@@ -0,0 +1,351 @@
;;; racket-font-lock.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'cl-lib)
(require 'racket-custom)
(require 'racket-keywords-and-builtins)
(require 'racket-ppss)
(require 'racket-util)
;; Define 3 levels of font-lock, as documented in 23.6.5 "Levels of
;; Font Lock". User may control using `font-lock-maximum-decoration'.
;; Note: font-lock iterates by matcher, doing an re-search-forward
;; over the entire region. As a result, it's faster to consolidate
;; matchers that will yield the same result (unless they need to be
;; tried in a certain order).
;; Note: This relies on our character syntax already having been
;; applied. For example a Racket identifier like `|name with spaces|`
;; will already have word/symbol syntax on everything including the
;; pipe and space chars.
(defconst racket-font-lock-keywords-0
(eval-when-compile
`(
;; #shebang
(,(rx bol "#!" (+ nonl) eol) . font-lock-comment-face)
;; #lang
(,(rx (group (group "#lang")
(1+ " ")
(group (1+ not-newline))))
(2 font-lock-keyword-face nil t)
(3 font-lock-variable-name-face nil t))
;; #; sexp comments
;;
;; We don't put any comment syntax on these -- that way things
;; like indent and nav work within the sexp. They are solely
;; font-locked as comments, here.
(,#'racket--font-lock-sexp-comments
(1 font-lock-comment-delimiter-face t)
(2 font-lock-comment-face t))
;; #<< here strings
;;
;; We only handle the opening #<<ID here. The remainder is
;; handled in `racket-font-lock-syntatic-face-function'.
(,(rx (group "#<<" (+? (not (any blank ?\n)))) ?\n)
(1 racket-here-string-face nil t))
))
"Strings, comments, #lang.")
(defconst racket-font-lock-keywords-1
(eval-when-compile
`(
;; keyword argument
(,(rx "#:" (1+ (or (syntax word) (syntax symbol))))
. racket-keyword-argument-face)
;; Various things for racket-selfeval-face
(,(rx (or
;; symbol
(seq ?' ?| (+ any) ?|)
(seq ?' (1+ (or (syntax word) (syntax symbol))))
(seq "#\\" (1+ (or (syntax word) (syntax symbol))))))
. racket-selfeval-face)
;; #rx #px
(,(rx (group (or "#rx" "#px")) ?\")
1 racket-selfeval-face)
;; Some self-eval constants
(,(regexp-opt '("#t" "#true" "#f" "#false" "+inf.0" "-inf.0" "+nan.0") 'symbols)
. racket-selfeval-face)
;; Numeric literals including Racket reader hash prefixes.
(,(rx
(seq symbol-start
(or
;; #d #e #i or no hash prefix
(seq (? "#" (any "dei"))
(or (seq (? (any "-+"))
(1+ digit)
(? (any "./") (1+ digit)))
(seq (1+ digit)
?e
(? (any "-+"))
(1+ digit))))
;; #x
(seq "#x"
(? (any "-+"))
(1+ hex-digit)
(? (any "./") (1+ hex-digit)))
;; #b
(seq "#b"
(or (seq (? (any "-+"))
(1+ (any "01"))
(? (any "./") (1+ (any "01"))))
(seq (1+ (any "01"))
?e
(? (any "-+"))
(1+ (any "01")))))
;; #o
(seq "#o"
(or (seq (? (any "-+"))
(1+ (any "0-7"))
(? (any "./") (1+ (any "0-7"))))
(seq (1+ (any "0-7"))
?e
(? (any "-+"))
(1+ (any "0-7"))))))
symbol-end))
. racket-selfeval-face)
))
"Self-evals")
(defconst racket-font-lock-keywords-2
(eval-when-compile
`(
;; def* -- variables
(,(rx (syntax open-parenthesis)
"def" (0+ (or (syntax word) (syntax symbol)))
(1+ space)
(group (1+ (or (syntax word) (syntax symbol)))))
1 font-lock-variable-name-face)
(,(rx (syntax open-parenthesis)
"define-values"
(1+ space)
(syntax open-parenthesis)
(group (1+ (or (syntax word) (syntax symbol) space)))
(syntax close-parenthesis))
1 font-lock-variable-name-face)
;; def* -- functions
(,(rx (syntax open-parenthesis)
"def" (0+ (or (syntax word) (syntax symbol)))
(1+ space)
(1+ (syntax open-parenthesis)) ;1+ b/c curried define
(group (1+ (or (syntax word) (syntax symbol)))))
1 font-lock-function-name-face)
;; let identifiers
(,#'racket--font-lock-let-identifiers . font-lock-variable-name-face)
;; module and module*
(,(rx (syntax open-parenthesis)
(group "module" (? "*"))
(1+ space)
(group (1+ (or (syntax word) (syntax symbol))))
(1+ space)
(group (1+ (or (syntax word) (syntax symbol)))))
(1 font-lock-keyword-face nil t)
(2 font-lock-function-name-face nil t)
(3 font-lock-variable-name-face nil t))
;; module+
(,(rx (syntax open-parenthesis)
(group "module+")
(1+ space)
(group (1+ (or (syntax word) (syntax symbol)))))
(1 font-lock-keyword-face nil t)
(2 font-lock-function-name-face nil t))
))
"Parens, modules, function/variable identifiers, syntax-")
(defconst racket-font-lock-keywords-3
(eval-when-compile
`(
(,(regexp-opt racket-keywords 'symbols) . font-lock-keyword-face)
(,(regexp-opt racket-builtins-1-of-2 'symbols) . font-lock-builtin-face)
(,(regexp-opt racket-builtins-2-of-2 'symbols) . font-lock-builtin-face)
(,(regexp-opt racket-type-list 'symbols) . font-lock-type-face)
;; pretty lambda (deprecated)
(,(rx (syntax open-parenthesis)
(? (or "case-" "match-" "opt-"))
(group "lambda")
(or word-end symbol-end))
1
(ignore
(when racket-pretty-lambda
(compose-region (match-beginning 1)
(match-end 1)
racket-lambda-char)))
nil t)
))
"Function/variable identifiers, Typed Racket types.
Note: To the extent you use #lang racket or #typed/racket, this
may be handy. But Racket is also a tool to make #lang's, and this
doesn't really fit that.")
(defconst racket-font-lock-keywords-level-0
(append racket-font-lock-keywords-0))
(defconst racket-font-lock-keywords-level-1
(append racket-font-lock-keywords-0
racket-font-lock-keywords-1))
(defconst racket-font-lock-keywords-level-2
(append racket-font-lock-keywords-0
racket-font-lock-keywords-1
racket-font-lock-keywords-2))
(defconst racket-font-lock-keywords-level-3
(append racket-font-lock-keywords-0
racket-font-lock-keywords-1
racket-font-lock-keywords-2
racket-font-lock-keywords-3))
(defconst racket-font-lock-keywords
'(racket-font-lock-keywords-level-0
racket-font-lock-keywords-level-1
racket-font-lock-keywords-level-2
racket-font-lock-keywords-level-3))
(defun racket-font-lock-syntactic-face-function (state)
(let ((q (racket--ppss-string-p state)))
(if q
(let ((startpos (racket--ppss-string/comment-start state)))
(if (eq (char-after startpos) ?|)
nil ;a |...| symbol
(if (characterp q)
font-lock-string-face
racket-here-string-face)))
font-lock-comment-face)))
;;; sexp comments
(defun racket--font-lock-sexp-comments (limit)
"Font-lock sexp comments.
Note that the syntax table does NOT show these as comments in
order to let indent and nav work within the sexp. We merely
font-lock them as comments."
(ignore-errors
(when (re-search-forward (rx (group-n 1 "#;" (* " "))
(group-n 2 (not (any " "))))
limit t)
(let ((md (match-data)))
(goto-char (match-beginning 2))
(forward-sexp 1)
(setf (elt md 5) (point)) ;set (match-end 2)
(set-match-data md)
t))))
;;; let forms
(defun racket--font-lock-let-identifiers (limit)
"In let forms give identifiers `font-lock-variable-name-face'.
This handles both let and let-values style forms (bindings with
with single identifiers or identifier lists).
Note: This works only when the let form has a closing paren.
\(Otherwise, when you type an incomplete let form before existing
code, this would mistakenly treat the existing code as part of
the let form.) The font-lock will kick in after you type the
closing paren. Or if you use electric-pair-mode, paredit, or
similar, it will already be there."
(while (re-search-forward
(rx (syntax open-parenthesis)
(* (syntax whitespace))
(group-n 1 "let" (* (or (syntax word) (syntax symbol)))))
limit
t)
(ignore-errors
(when (and (not (member (match-string-no-properties 1) '("let/ec" "let/cc")))
(racket--inside-complete-sexp))
;; Resume search before this let's bindings list, so we can
;; check rhs of bindings for more lets.
(save-excursion
;; Check for named let
(when (looking-at (rx (+ space) (+ (or (syntax word) (syntax symbol)))))
(forward-sexp 1)
(backward-sexp 1)
(racket--sexp-set-face font-lock-function-name-face))
;; Set font-lock-multiline property on entire identifier
;; list. Avoids need for font-lock-extend-region function.
(put-text-property (point)
(save-excursion (forward-sexp 1) (point))
'font-lock-multiline t)
(down-list 1) ;to the open paren of the first binding form
(while (ignore-errors
(down-list 1) ;to the id or list of id's
(if (not (looking-at "[([{]"))
(racket--sexp-set-face font-lock-variable-name-face)
;; list of ids, e.g. let-values
(down-list 1) ;to first id
(cl-loop
do (racket--sexp-set-face font-lock-variable-name-face)
while (ignore-errors (forward-sexp 1) (backward-sexp 1) t))
(backward-up-list))
(backward-up-list) ;to open paren of this binding form
(forward-sexp 1) ;to open paren of next binding form
t))))))
nil)
;;; misc
(defun racket--inside-complete-sexp ()
"Return whether point is inside a complete sexp."
(condition-case ()
(save-excursion (backward-up-list) (forward-sexp 1) t)
(error nil)))
(defun racket--sexp-set-face (face &optional forcep)
"Set 'face prop to FACE, rear-nonsticky, for the sexp starting at point.
Unless FORCEP is t, does so only if not already set in the
region.
Moves point to the end of the sexp."
(racket--region-set-face (point)
(progn (forward-sexp 1) (point))
face
forcep))
(defun racket--region-set-face (beg end face &optional forcep)
"Set 'face prop to FACE, rear-nonsticky, in the region BEG..END.
Unless FORCEP is t, does so only if not already set in the
region."
(when (or forcep (not (text-property-not-all beg end 'face nil)))
(add-text-properties beg end
`(face ,face
;;rear-nonsticky (face)
))))
(provide 'racket-font-lock)
;; racket-font-lock.el ends here

89
elpa/racket-mode-20180609.1253/racket-imenu.el Normal file
View File

@@ -0,0 +1,89 @@
;;; racket-imenu.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'cl-lib)
(require 'imenu)
(defun racket--variables-imenu ()
(set (make-local-variable 'imenu-case-fold-search) t)
(set (make-local-variable 'imenu-create-index-function)
#'racket--imenu-create-index-function))
(defun racket--imenu-create-index-function ()
"A function for the variable `imenu-create-index-function'.
Knows about Racket module forms, and prefixes identiers with
their parent module name(s)."
(save-excursion
(goto-char (point-min))
(racket--next-sexp)
(racket--walk-sexps "")))
(defun racket--walk-sexps (prefix)
"With point at the start of a sexp, walk all the sepxs.
`racket--menu-sexp' will walk into Racket module forms and call
us recursively."
(cl-loop append (racket--menu-sexp prefix) into xs
while (racket--next-next-sexp)
finally return xs))
(defun racket--menu-sexp (prefix)
"Return the identifier for the sexp at point if any, else nil.
If sexp at point is a Racket module form, descend and walk that."
(cond ((looking-at (rx "(define" (* (or (syntax word) (syntax symbol)))
(+ (syntax whitespace))
(? ?\()
(group (+ (or (syntax word) (syntax symbol))))))
(let* ((beg (match-beginning 1))
(beg (if imenu-use-markers
(save-excursion (goto-char beg) (point-marker))
beg)))
(list (cons (concat prefix (match-string-no-properties 1))
beg))))
((looking-at (rx "(module" (? (any ?+ ?*))
(+ (syntax whitespace))
(group (+ (or (syntax word) (syntax symbol))))))
(save-excursion
(goto-char (match-end 1))
(racket--next-sexp)
(racket--walk-sexps (concat prefix (match-string-no-properties 1) ":"))))
(t nil)))
(defun racket--next-sexp ()
"Move point to start of next sexp in buffer."
(forward-sexp 1)
(forward-sexp -1))
(defun racket--next-next-sexp ()
"If another sexp, move point to its start and return t, else return nil."
(condition-case nil
(progn
(forward-sexp 1)
(let ((orig (point)))
(forward-sexp 1)
(if (or (eobp) (equal orig (point)))
nil
(forward-sexp -1)
t)))
(scan-error nil)))
(provide 'racket-imenu)
;;; racket-imenu.el ends here

530
elpa/racket-mode-20180609.1253/racket-indent.el Normal file
View File

@@ -0,0 +1,530 @@
;;; racket-indent.el -*- lexical: t; -*-
;; Copyright (c) 2013-2017 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'cl-lib)
(require 'racket-util)
(require 'racket-custom)
(require 'racket-ppss)
;; The two top-level commands we care about are:
;; 1. `prog-indent-sexp' C-M-q
;; 2. `indent-region' C-M-\
;;
;; 1. `prog-indent-sexp' thinly wraps `indent-region'.
;;
;; 2. `indent-region' calls `indent-according-to-mode', which in turn
;; calls the mode-specific `indent-line-function'. In lisp-mode that's
;; `lisp-indent-line', which in turn calls `calculate-lisp-indent'.
;; That in turn calls the mode-specific `indent-function'; in
;; lisp-mode that's `lisp-indent-function'.
;;
;; However `calculate-lisp-indent' is complicated and doesn't always
;; behave the way we want. So we use a simplified version of that
;; (`racket--calculate-indent') in our `indent-line-function',
;; `racket-indent-line'. That just directly calls
;; `racket-indent-function'.
;; Having said all that, we still have the matter of `paredit-mode'.
;; It directly calls `lisp-indent-line' instead of `indent-function'.
;; And, it directly calls `indent-sexp' instead of `prog-indent-sep'.
;; Therefore it gets `lisp-mode' indent, not ours. To address this,
;; advise those two functions to do the right thing when one of our
;; major modes is active.
(defun racket--lisp-indent-line-advice (orig &rest args)
"When `racket--mode-edits-racket-p' instead use `racket-indent-line'."
(apply (if (racket--mode-edits-racket-p) #'racket-indent-line orig)
args))
(defun racket--indent-sexp-advice (orig &rest args)
"When `racket--mode-edits-racket-p' instead use `prog-indent-sexp'."
(apply (if (racket--mode-edits-racket-p) #'prog-indent-sexp orig)
args))
;; I don't want to muck with the old `defadvice' for this. Instead use
;; `advice-add' in Emacs 24.4+. Although we still support Emacs 24.3,
;; not sure how much longer; I'm OK having it silently not work.
(when (fboundp 'advice-add)
(advice-add 'lisp-indent-line :around #'racket--lisp-indent-line-advice)
(advice-add 'indent-sexp :around #'racket--indent-sexp-advice))
(defun racket-indent-line (&optional whole-exp)
"Indent current line as Racket code.
This behaves like `lisp-indent-line', except that whole-line
comments are treated the same regardless of whether they start
with single or double semicolons.
- Automatically indents forms that start with `begin` in the usual
way that `begin` is indented.
- Automatically indents forms that start with `def` or `with-` in the
usual way that `define` is indented.
- Has rules for many specific standard Racket forms.
To extend, use your Emacs init file to
(put SYMBOL 'racket-indent-function INDENT)
where `SYMBOL` is the name of the Racket form (e.g. `'test-case`)
and `INDENT` is an integer or the symbol `'defun`. When `INDENT`
is an integer, the meaning is the same as for
`lisp-indent-function` and `scheme-indent-function`: Indent the
first `n` arguments specially and then indent any further
arguments like a body.
For example in your `.emacs` file you could use:
(put 'test-case 'racket-indent-function 1)
to change the indent of `test-case` from this:
(test-case foo
blah
blah)
to this:
(test-case foo
blah
blah)
If `racket-indent-function` has no property for a symbol,
`scheme-indent-function` is also considered (although the with-x
indents defined by `scheme-mode` are ignored). This is only to
help people who may have extensive `scheme-indent-function`
settings, particularly in the form of file or dir local
variables. Otherwise prefer `racket-indent-function`."
(interactive)
(pcase (racket--calculate-indent)
(`() nil)
;; When point is within the leading whitespace, move it past the
;; new indentation whitespace. Otherwise preserve its position
;; relative to the original text.
(amount (let ((pos (- (point-max) (point)))
(beg (progn (beginning-of-line) (point))))
(skip-chars-forward " \t")
(unless (= amount (current-column))
(delete-region beg (point))
(indent-to amount))
(when (< (point) (- (point-max) pos))
(goto-char (- (point-max) pos)))))))
(defun racket--calculate-indent ()
"Return appropriate indentation for current line as Lisp code.
In usual case returns an integer: the column to indent to.
If the value is nil, that means don't change the indentation
because the line starts inside a string.
This is `calculate-lisp-indent' distilled to what we actually
need."
(save-excursion
(beginning-of-line)
(let ((indent-point (point))
(state nil))
(racket--plain-beginning-of-defun)
(while (< (point) indent-point)
(setq state (parse-partial-sexp (point) indent-point 0)))
(let ((strp (racket--ppss-string-p state))
(last (racket--ppss-last-sexp state))
(cont (racket--ppss-containing-sexp state)))
(cond
(strp nil)
((and state last cont) (racket-indent-function indent-point state))
(cont (goto-char (1+ cont)) (current-column))
(t (current-column)))))))
(defun racket--plain-beginning-of-defun ()
"Like default/plain `beginning-of-function'.
Our `racket--beginning-of-defun-function' is aware of module
forms and tailored to using C-M-a to navigate interactively. But
it is too slow to be used here -- especially in \"degenerate\"
cases like a 3000 line file consisting of one big `module` or
`library` sexpr."
(when (re-search-backward (rx bol (syntax open-parenthesis))
nil
'move)
(goto-char (1- (match-end 0)))))
(defun racket-indent-function (indent-point state)
"Called by `racket--calculate-indent' to get indent column.
INDENT-POINT is the position at which the line being indented begins.
STATE is the `parse-partial-sexp' state for that position.
There is special handling for:
- forms that begin with a #:keyword (as found in contracts)
- forms like #hasheq()
- data sequences when `racket-indent-sequence-depth' is > 0
- {} forms when `racket-indent-curly-as-sequence' is not nil
See `racket-indent-line' for more information about users setting
the `racket-indent-function` property."
(goto-char (racket--ppss-containing-sexp state))
(let ((body-indent (+ (current-column) lisp-body-indent)))
(forward-char 1)
(if (or (racket--hash-literal-or-keyword-p)
(racket--data-sequence-p))
(progn (backward-prefix-chars) (current-column))
(let* ((head (buffer-substring (point) (progn (forward-sexp 1) (point))))
(method (racket--get-indent-function-method head)))
(cond ((integerp method)
(racket--indent-special-form method indent-point state))
((eq method 'defun)
body-indent)
(method
(funcall method indent-point state))
((string-match (rx bos (or "def" "with-")) head)
body-indent) ;just like 'defun
((string-match (rx bos "begin") head)
(racket--indent-special-form 0 indent-point state))
(t
(racket--normal-indent indent-point state)))))))
(defun racket--hash-literal-or-keyword-p ()
"Looking at things like #fl() #hash() or #:keyword ?
The last occurs in Racket contract forms, e.g. (->* () (#:kw kw)).
Returns nil for #% identifiers like #%app."
(looking-at (rx ?\# (or ?\:
(not (any ?\%))))))
(defun racket--data-sequence-p ()
"Looking at \"data\" sequences where we align under head item?
These sequences include '() `() #() -- and {} when
`racket-indent-curly-as-sequence' is t -- but never #'() #`() ,()
,@().
To handle nested items, we search `backward-up-list' up to
`racket-indent-sequence-depth' times."
(and (< 0 racket-indent-sequence-depth)
(save-excursion
(ignore-errors
(let ((answer 'unknown)
(depth racket-indent-sequence-depth))
(while (and (eq answer 'unknown)
(< 0 depth))
(backward-up-list)
(cl-decf depth)
(cond ((or
;; a quoted '( ) or quasiquoted `( ) list --
;; but NOT syntax #'( ) or quasisyntax #`( )
(and (memq (char-before (point)) '(?\' ?\`))
(eq (char-after (point)) ?\()
(not (eq (char-before (1- (point))) ?#)))
;; a vector literal: #( )
(and (eq (char-before (point)) ?#)
(eq (char-after (point)) ?\())
;; { }
(and racket-indent-curly-as-sequence
(eq (char-after (point)) ?{)))
(setq answer t))
(;; unquote or unquote-splicing
(and (or (eq (char-before (point)) ?,)
(and (eq (char-before (1- (point))) ?,)
(eq (char-before (point)) ?@)))
(eq (char-after (point)) ?\())
(setq answer nil))))
(eq answer t))))))
(defun racket--normal-indent (indent-point state)
;; Credit: Substantially borrowed from clojure-mode
(goto-char (racket--ppss-last-sexp state))
(backward-prefix-chars)
(let ((last-sexp nil))
(if (ignore-errors
;; `backward-sexp' until we reach the start of a sexp that is the
;; first of its line (the start of the enclosing sexp).
(while (string-match (rx (not blank))
(buffer-substring (line-beginning-position)
(point)))
(setq last-sexp (prog1 (point)
(forward-sexp -1))))
t)
;; Here we've found an arg before the arg we're indenting
;; which is at the start of a line.
(current-column)
;; Here we've reached the start of the enclosing sexp (point is
;; now at the function name), so the behavior depends on whether
;; there's also an argument on this line.
(when (and last-sexp
(< last-sexp (line-end-position)))
;; There's an arg after the function name, so align with it.
(goto-char last-sexp))
(current-column))))
(defun racket--indent-special-form (method indent-point state)
"METHOD must be a nonnegative integer -- the number of
\"special\" args that get extra indent when not on the first
line. Any additinonl args get normal indent."
;; Credit: Substantially borrowed from clojure-mode
(let ((containing-column (save-excursion
(goto-char (racket--ppss-containing-sexp state))
(current-column)))
(pos -1))
(condition-case nil
(while (and (<= (point) indent-point)
(not (eobp)))
(forward-sexp 1)
(cl-incf pos))
;; If indent-point is _after_ the last sexp in the current sexp,
;; we detect that by catching the `scan-error'. In that case, we
;; should return the indentation as if there were an extra sexp
;; at point.
(scan-error (cl-incf pos)))
(cond ((= method pos) ;first non-distinguished arg
(+ containing-column lisp-body-indent))
((< method pos) ;more non-distinguished args
(racket--normal-indent indent-point state))
(t ;distinguished args
(+ containing-column (* 2 lisp-body-indent))))))
(defun racket--conditional-indent (indent-point state looking-at-regexp true false)
(skip-chars-forward " \t")
(let ((n (if (looking-at looking-at-regexp) true false)))
(racket--indent-special-form n indent-point state)))
(defconst racket--identifier-regexp
(rx (or (syntax symbol) (syntax word) (syntax punctuation)))
"A regexp matching valid Racket identifiers.")
(defun racket--indent-maybe-named-let (indent-point state)
"Indent a let form, handling named let (let <id> <bindings> <expr> ...)"
(racket--conditional-indent indent-point state
racket--identifier-regexp
2 1))
(defun racket--indent-for (indent-point state)
"Indent function for all for/ and for*/ forms EXCEPT
for/fold and for*/fold.
Checks for either of:
- maybe-type-ann e.g. (for/list : T ([x xs]) x)
- for/vector optional length, (for/vector #:length ([x xs]) x)"
(racket--conditional-indent indent-point state
(rx (or ?\: ?\#))
3 1))
(defun racket--indent-for/fold (indent-point state)
"Indent function for for/fold and for*/fold."
;; check for maybe-type-ann e.g. (for/fold : T ([n 0]) ([x xs]) x)
(skip-chars-forward " \t\n")
(if (looking-at ":")
(racket--indent-special-form 4 indent-point state)
(racket--indent-for/fold-untyped indent-point state)))
(defun racket--indent-for/fold-untyped (indent-point state)
(let* ((containing-sexp-start (racket--ppss-containing-sexp state))
(_ (goto-char containing-sexp-start))
(containing-sexp-column (current-column))
(containing-sexp-line (line-number-at-pos))
(body-indent (+ containing-sexp-column lisp-body-indent))
(clause-indent nil))
;; Move to the open paren of the first, accumulator sexp
(forward-char 1) ;past the open paren
(forward-sexp 2) ;to the next sexp, past its close paren
(backward-sexp 1) ;back to its open paren
;; If the first, accumulator sexp is not on the same line as
;; `for/fold`, then this is simply specform 2.
(if (/= (line-number-at-pos) containing-sexp-line) ;expensive?
(racket--indent-special-form 2 indent-point state)
(setq clause-indent (current-column))
(forward-sexp 1) ;past close paren
;; Now go back to the beginning of the line holding
;; the indentation point. Count the sexps on the way.
(parse-partial-sexp (point) indent-point 1 t)
(let ((n 1))
(while (and (< (point) indent-point)
(ignore-errors
(cl-incf n)
(forward-sexp 1)
(parse-partial-sexp (point) indent-point 1 t))))
(if (= 1 n) clause-indent body-indent)))))
(defun racket--get-indent-function-method (head)
"Get property of racket- or scheme-indent-function.
Ignores certain with-xxx indents defined by scheme-mode --
because we automatically indent with- forms just like def forms.
However if a _user_ has defined their own legacy scheme-mode
indents for _other_ with- forms, those _will_ be used. We only
ignore a short list defined by scheme-mode itself."
(let ((sym (intern-soft head)))
(or (get sym 'racket-indent-function)
(and (not (memq sym '(call-with-values
with-mode
with-input-from-file
with-input-from-port
with-output-to-file
with-output-to-port
with-input-from-string
with-output-to-string
with-values)))
(get sym 'scheme-indent-function)))))
(defun racket--set-indentation ()
"Set indentation for various Racket forms.
Note that `beg*`, `def*` and `with-*` aren't listed here because
`racket-indent-function' handles those.
Note that indentation is set for the symbol alone, and also with
a : suffix for legacy Typed Racket. For example both `let` and
`let:`. Although this is overzealous in the sense that Typed
Racket does not define its own variant of all of these, it
doesn't hurt to do so."
(mapc (lambda (x)
(put (car x) 'racket-indent-function (cadr x))
(let ((typed (intern (format "%s:" (car x)))))
(put typed 'racket-indent-function (cadr x))))
'(;; begin* forms default to 0 unless otherwise specified here
(begin0 1)
(c-declare 0)
(c-lambda 2)
(call-with-input-file defun)
(call-with-input-file* defun)
(call-with-output-file defun)
(call-with-output-file* defun)
(case 1)
(case-lambda 0)
(catch 1)
(class defun)
(class* defun)
(compound-unit/sig 0)
(cond 0)
;; def* forms default to 'defun unless otherwise specified here
(delay 0)
(do 2)
(dynamic-wind 0)
(fn 1) ;alias for lambda (although not officially in Racket)
(for 1)
(for/list racket--indent-for)
(for/vector racket--indent-for)
(for/hash racket--indent-for)
(for/hasheq racket--indent-for)
(for/hasheqv racket--indent-for)
(for/and racket--indent-for)
(for/or racket--indent-for)
(for/lists racket--indent-for/fold)
(for/first racket--indent-for)
(for/last racket--indent-for)
(for/fold racket--indent-for/fold)
(for/flvector racket--indent-for)
(for/set racket--indent-for)
(for/seteq racket--indent-for)
(for/seteqv racket--indent-for)
(for/sum racket--indent-for)
(for/product racket--indent-for)
(for* 1)
(for*/list racket--indent-for)
(for*/vector racket--indent-for)
(for*/hash racket--indent-for)
(for*/hasheq racket--indent-for)
(for*/hasheqv racket--indent-for)
(for*/and racket--indent-for)
(for*/or racket--indent-for)
(for*/lists racket--indent-for/fold)
(for*/first racket--indent-for)
(for*/last racket--indent-for)
(for*/fold racket--indent-for/fold)
(for*/flvector racket--indent-for)
(for*/set racket--indent-for)
(for*/seteq racket--indent-for)
(for*/seteqv racket--indent-for)
(for*/sum racket--indent-for)
(for*/product racket--indent-for)
(instantiate 2)
(interface 1)
(λ 1)
(lambda 1)
(lambda/kw 1)
(let racket--indent-maybe-named-let)
(let* 1)
(letrec 1)
(letrec-values 1)
(let-values 1)
(let*-values 1)
(let+ 1)
(let-syntax 1)
(let-syntaxes 1)
(letrec-syntax 1)
(letrec-syntaxes 1)
(letrec-syntaxes+values racket--indent-for/fold-untyped)
(local 1)
(let/cc 1)
(let/ec 1)
(match 1)
(match* 1)
(match-define defun)
(match-lambda 0)
(match-lambda* 0)
(match-let 1)
(match-let* 1)
(match-let*-values 1)
(match-let-values 1)
(match-letrec 1)
(match-letrec-values 1)
(match/values 1)
(mixin 2)
(module 2)
(module+ 1)
(module* 2)
(opt-lambda 1)
(parameterize 1)
(parameterize-break 1)
(parameterize* 1)
(quasisyntax/loc 1)
(receive 2)
(require/typed 1)
(require/typed/provide 1)
(send* 1)
(shared 1)
(sigaction 1)
(splicing-let 1)
(splicing-letrec 1)
(splicing-let-values 1)
(splicing-letrec-values 1)
(splicing-let-syntax 1)
(splicing-letrec-syntax 1)
(splicing-let-syntaxes 1)
(splicing-letrec-syntaxes 1)
(splicing-letrec-syntaxes+values racket--indent-for/fold-untyped)
(splicing-local 1)
(splicing-syntax-parameterize 1)
(struct defun)
(syntax-case 2)
(syntax-case* 3)
(syntax-rules 1)
(syntax-id-rules 1)
(syntax-parse 1)
(syntax-parser 0)
(syntax-parameterize 1)
(syntax/loc 1)
(syntax-parse 1)
(test-begin 0)
(test-case 1)
(unit defun)
(unit/sig 2)
(unless 1)
(when 1)
(while 1)
;; with- forms default to 1 unless otherwise specified here
)))
(provide 'racket-indent)
;; racket-indent.el ends here

2819
elpa/racket-mode-20180609.1253/racket-keywords-and-builtins.el Normal file
View File

File diff suppressed because it is too large Load Diff

263
elpa/racket-mode-20180609.1253/racket-logger.el Normal file
View File

@@ -0,0 +1,263 @@
;;; racket-logger.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'easymenu)
(require 'rx)
(require 'racket-custom)
(require 'racket-repl)
;; Need to define this before racket-logger-mode
(defvar racket-logger-mode-map
(racket--easy-keymap-define
'(("l" racket-logger-topic-level)
("w" toggle-truncate-lines)
("n" racket-logger-next-item)
("p" racket-logger-previous-item)
("g" racket-logger-clear)
("x" racket-logger-exit)
("C-c C-z" racket-repl))))
(easy-menu-define racket-logger-mode-menu racket-logger-mode-map
"Menu for Racket logger mode."
'("Racket"
["Configure Topic and Level" racket-logger-topic-level]
["Toggle Truncate Lines" toggle-truncate-lines]
"---"
["Switch to REPL" racket-repl]
"---"
["Clear and Reconnect" racket-logger-clear]
["Exit Logger" racket-logger-exit]))
(define-derived-mode racket-logger-mode special-mode "Racket-Logger"
"Major mode for Racket logger output.
\\<racket-logger-mode-map>
The customization variable `racket-logger-config' determines the
levels for topics. During a session you may change topic levels
using `racket-logger-topic-level', bound to
\"\\[racket-logger-topic-level]\".
For more information see:
<https://docs.racket-lang.org/reference/logging.html>
```
\\{racket-logger-mode-map}
```
"
(setq-local font-lock-defaults (list racket-logger-font-lock-keywords))
(setq-local truncate-lines t))
(defconst racket-logger-font-lock-keywords
(eval-when-compile
`((,#'racket--font-lock-config . racket-logger-config-face)
(,(rx bol "[ fatal]") . racket-logger-fatal-face)
(,(rx bol "[ error]") . racket-logger-error-face)
(,(rx bol "[warning]") . racket-logger-warning-face)
(,(rx bol "[ info]") . racket-logger-info-face)
(,(rx bol "[ debug]") . racket-logger-debug-face)
(,(rx bol ?\[ (+? anything) ?\] space
(group (+? anything) ?:) space)
1 racket-logger-topic-face))))
(defun racket--font-lock-config (limit)
"Handle multi-line font-lock of the configuration info."
(ignore-errors
(when (re-search-forward (concat "^" racket-logger--print-config-prefix) limit t)
(let ((md (match-data)))
(goto-char (match-end 0))
(forward-sexp 1)
(setf (elt md 1) (point)) ;; set (match-end 0)
(set-match-data md)
t))))
(defvar racket-logger--buffer-name "*Racket Logger*")
(defvar racket-logger--process nil)
(defvar racket-logger--connect-timeout 3)
(defun racket-logger--connect ()
(unless racket-logger--process
(with-temp-message "Connecting to logger process..."
(with-timeout (racket-logger--connect-timeout
(error "Could not connect; try `racket-run' first"))
(while (not racket-logger--process)
(condition-case ()
(setq racket-logger--process
(let ((process-connection-type nil)) ;use pipe not pty
(open-network-stream "racket-logger"
(get-buffer-create racket-logger--buffer-name)
"127.0.0.1"
(1+ racket-command-port))))
(error (sit-for 0.1)))))
(racket-logger--activate-config)
(set-process-sentinel racket-logger--process
#'racket-logger--process-sentinel))))
(defun racket-logger--process-sentinel (proc change)
(funcall (process-filter proc) proc change) ;display in buffer
(unless (memq (process-status proc) '(run open connect))
(setq racket-logger--process nil)))
(defun racket-logger--disconnect ()
(when racket-logger--process
(with-temp-message "Disconnecting from logger process..."
(set-process-sentinel racket-logger--process (lambda (_p _c)))
(delete-process racket-logger--process)
(setq racket-logger--process nil))))
(defconst racket-logger--print-config-prefix
"racket-logger-config:\n")
(defun racket-logger--activate-config ()
"Send config to Racket process, and, display it in the buffer."
(process-send-string racket-logger--process
(format "%S" racket-logger-config))
(funcall (process-filter racket-logger--process)
racket-logger--process
(propertize (concat racket-logger--print-config-prefix
(pp-to-string racket-logger-config))
'font-lock-multiline t)))
(defun racket-logger--set (topic level)
(unless (symbolp topic) (error "TOPIC must be symbolp"))
(unless (symbolp level) (error "LEVEL must be symbolp"))
(pcase (assq topic racket-logger-config)
(`() (add-to-list 'racket-logger-config (cons topic level)))
(v (setcdr v level)))
(racket-logger--activate-config))
(defun racket-logger--unset (topic)
(unless (symbolp topic) (error "TOPIC must be symbolp"))
(when (eq topic '*)
(user-error "Cannot unset the level for the '* topic"))
(setq racket-logger-config
(assq-delete-all topic racket-logger-config))
(racket-logger--activate-config))
(defun racket-logger--topics ()
"Effectively (sort (dict-keys racket-logger-config))."
(sort (mapcar (lambda (x) (format "%s" (car x)))
racket-logger-config)
#'string<))
(defun racket-logger--topic-level (topic not-found)
"Effectively (dict-ref racket-logger-config topic not-found)."
(or (cdr (assq topic racket-logger-config))
not-found))
;;; commands
(defun racket-logger ()
"Create the `racket-logger-mode' buffer and connect to logger output.
If the `racket-repl-mode' buffer is displayed in a window, split
that window and put the logger in the bottom window. Otherwise,
use `pop-to-buffer'."
(interactive)
;; Create buffer if necessary
(unless (get-buffer racket-logger--buffer-name)
(with-current-buffer (get-buffer-create racket-logger--buffer-name)
(racket-logger-mode))
(racket-logger--connect))
;; Give it a window if necessary
(unless (get-buffer-window racket-logger--buffer-name)
(pcase (get-buffer-window racket--repl-buffer-name)
(`() (pop-to-buffer (get-buffer racket-logger--buffer-name)))
(win (set-window-buffer (split-window win)
(get-buffer racket-logger--buffer-name)))))
;; Select the window
(select-window (get-buffer-window racket-logger--buffer-name)))
(defun racket-logger-exit ()
"Disconnect, kill the buffer, and delete the window."
(interactive)
(when (y-or-n-p "Disconnect and kill buffer? ")
(racket-logger--disconnect)
(kill-buffer)
(delete-window)))
(defun racket-logger-clear ()
"Clear the buffer and reconnect."
(interactive)
(when (y-or-n-p "Clear buffer and reconnect? ")
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max)))
(racket-logger--disconnect)
(racket-logger--connect)))
(defconst racket-logger--item-rx
(rx bol ?\[ (0+ space) (or "fatal" "error" "warning" "info" "debug") ?\] space))
(defun racket-logger-next-item (&optional count)
"Move point N items forward.
An \"item\" is a line starting with a log level in brackets.
Interactively, N is the numeric prefix argument.
If N is omitted or nil, move point 1 item forward."
(interactive "P")
(forward-char 1)
(if (re-search-forward racket-logger--item-rx nil t count)
(beginning-of-line)
(backward-char 1)))
(defun racket-logger-previous-item (&optional count)
"Move point N items backward.
An \"item\" is a line starting with a log level in brackets.
Interactively, N is the numeric prefix argument.
If N is omitted or nil, move point 1 item backward."
(interactive "P")
(re-search-backward racket-logger--item-rx nil t count))
(defun racket-logger-topic-level ()
"Set or unset the level for a topic.
For convenience, input choices using `ido-completing-read'.
The topic labeled \"*\" is the level to use for all topics not
specifically assigned a level.
The level choice \"*\" means the topic will no longer have its
own level, therefore will follow the level specified for the
\"*\" topic."
(interactive)
(let* ((topic (ido-completing-read
"Topic: "
(racket-logger--topics)))
(topic (pcase topic
("" "*")
(v v)))
(topic (intern topic))
(levels (list "fatal" "error" "warning" "info" "debug"))
(levels (if (eq topic '*) levels (cons "*" levels)))
(level (ido-completing-read
(format "Level for topic `%s': " topic)
levels
nil t nil nil
(format "%s" (racket-logger--topic-level topic "*"))))
(level (pcase level
("" nil)
("*" nil)
(v (intern v)))))
(if level
(racket-logger--set topic level)
(racket-logger--unset topic))))
(provide 'racket-logger)
;;; racket-logger.el ends here

259
elpa/racket-mode-20180609.1253/racket-make-doc.el Normal file
View File

@@ -0,0 +1,259 @@
;;; racket-make-doc.el --- Major mode for Racket language.
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
;;; Generate a markdown format file for Reference documentation.
(require 'racket-mode)
(require 'racket-profile)
(require 'racket-edit)
(require 'racket-util)
(require 'racket-unicode-input-method)
(require 'cl-lib)
(require 's)
;;; Top
(defvar racket-make-doc/Reference.md
(expand-file-name "Reference.md"
(file-name-directory (or load-file-name
(racket--buffer-file-name)))))
(defun racket-make-doc/write-reference-file ()
(interactive)
(with-temp-buffer
(insert (racket-make-doc/reference))
(write-region nil nil racket-make-doc/Reference.md nil)))
(defun racket-make-doc/reference ()
(let ((text-quoting-style 'grave))
(concat "# Reference\n\n"
(racket-make-doc/toc)
"# Commands\n\n"
(racket-make-doc/commands)
"# Variables\n\n"
"> Note: You may also set these via Customize.\n\n"
(racket-make-doc/variables)
"# Faces\n\n"
"> Note: You may also set these via Customize.\n\n"
(racket-make-doc/faces))))
;;; Commands
(defconst racket-make-doc/commands
'("Run"
racket-run
racket-racket
racket-profile
racket-profile-mode
racket-logger
racket-logger-mode
"Test"
racket-test
racket-raco-test
"Eval"
racket-send-region
racket-send-definition
racket-send-last-sexp
"Visit"
racket-visit-definition
racket-visit-module
racket-unvisit
racket-open-require-path
racket-find-collection
"Learn"
racket-describe
racket-doc
"Edit"
racket-fold-all-tests
racket-unfold-all-tests
racket-tidy-requires
racket-trim-requires
racket-base-requires
racket-indent-line
racket-smart-open-bracket
racket-cycle-paren-shapes
racket-backward-up-list
racket-check-syntax-mode
racket-unicode-input-method-enable
racket-align
racket-unalign
"Macro expand"
racket-expand-region
racket-expand-definition
racket-expand-last-sexp
racket-expand-again)
"Commands to include in the Reference.")
(defun racket-make-doc/commands ()
(apply #'concat
(mapcar #'racket-make-doc/command racket-make-doc/commands)))
(defun racket-make-doc/command (s)
(if (stringp s)
(format "## %s\n\n" s)
(concat (format "### %s\n" s)
(racket-make-doc/bindings-as-kbd s)
(racket-make-doc/tweak-quotes
(racket-make-doc/linkify
(or (documentation s) "No documentation.\n\n")))
"\n\n")))
(defun racket-make-doc/bindings-as-kbd (symbol)
(let* ((bindings (racket-make-doc/bindings symbol))
(strs (and bindings
(cl-remove-if-not
#'identity
(mapcar (lambda (binding)
(unless (eq (aref binding 0) 'menu-bar)
(format "<kbd>%s</kbd>"
(racket-make-doc/html-escape
(key-description binding)))))
bindings))))
(str (if strs
(mapconcat #'identity strs " or ")
(format "<kbd>M-x %s</kbd>" symbol))))
(concat str "\n\n")))
(defun racket-make-doc/bindings (symbol)
(where-is-internal symbol racket-mode-map))
(defun racket-make-doc/html-escape (str)
(with-temp-buffer
(insert str)
(format-replace-strings '(("&" . "&amp;")
("<" . "&lt;")
(">" . "&gt;")))
(buffer-substring-no-properties (point-min) (point-max))))
;;; Variables
(defconst racket-make-doc/variables
'("General"
racket-program
racket-command-port
racket-command-timeout
racket-memory-limit
racket-error-context
racket-user-command-line-arguments
"REPL"
racket-history-filter-regexp
racket-images-inline
racket-images-keep-last
racket-images-system-viewer
racket-pretty-print
"Other"
racket-indent-curly-as-sequence
racket-indent-sequence-depth
racket-pretty-lambda
racket-smart-open-bracket-enable
racket-logger-config)
"Variables to include in the Reference.")
(defun racket-make-doc/variables ()
(apply #'concat
(mapcar #'racket-make-doc/variable racket-make-doc/variables)))
(defun racket-make-doc/variable (s)
(if (stringp s)
(format "## %s\n\n" s)
(concat (format "### %s\n" s)
(racket-make-doc/tweak-quotes
(racket-make-doc/linkify
(or (documentation-property s 'variable-documentation)
"No documentation.\n\n")))
"\n\n")))
;;; Faces
(defconst racket-make-doc/faces
'(racket-keyword-argument-face
racket-selfeval-face
racket-here-string-face
racket-check-syntax-def-face
racket-check-syntax-use-face
racket-logger-config-face
racket-logger-topic-face
racket-logger-fatal-face
racket-logger-error-face
racket-logger-warning-face
racket-logger-info-face
racket-logger-debug-face)
"Faces to include in the Reference.")
(defun racket-make-doc/faces ()
(apply #'concat
(mapcar #'racket-make-doc/face racket-make-doc/faces)))
(defun racket-make-doc/face (symbol)
(concat (format "### %s\n" symbol)
(racket-make-doc/tweak-quotes
(racket-make-doc/linkify
(or (documentation-property symbol 'face-documentation)
"No documentation.\n\n")))
"\n\n"))
;;; TOC
(defun racket-make-doc/toc ()
(concat "- [Commands](#commands)\n"
(racket-make-doc/subheads racket-make-doc/commands)
"- [Variables](#variables)\n"
(racket-make-doc/subheads racket-make-doc/variables)
"- [Faces](#faces)\n"
"\n"))
(defun racket-make-doc/subheads (xs)
(apply #'concat
(mapcar #'racket-make-doc/subhead
(cl-remove-if-not #'stringp xs))))
(defun racket-make-doc/subhead (x)
(format " - [%s](#%s)\n"
x
(s-dashed-words x)))
;;; Utility
(defun racket-make-doc/linkify (s)
(with-temp-buffer
(insert s)
(goto-char (point-min))
(while (re-search-forward (rx ?\`
(group "racket-" (+ (or (syntax word)
(syntax symbol))))
?\')
nil t)
(let ((name (buffer-substring-no-properties (match-beginning 1)
(match-end 1))))
(replace-match (format "[`%s`](#%s)" name name)
nil nil)))
(buffer-substring-no-properties (point-min) (point-max))))
(defun racket-make-doc/tweak-quotes (s)
"Change \` \' style quotes to \` \` style."
(with-temp-buffer
(insert s)
(goto-char (point-min))
(while (re-search-forward (rx ?\`
(group (+ (or (syntax word)
(syntax symbol))))
?\')
nil t)
(let ((name (buffer-substring-no-properties (match-beginning 1)
(match-end 1))))
(replace-match (format "`%s`" name)
nil nil)))
(buffer-substring-no-properties (point-min) (point-max))))
;;; racket-make-doc.el ends here

232
elpa/racket-mode-20180609.1253/racket-mode-autoloads.el Normal file
View File

@@ -0,0 +1,232 @@
;;; racket-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "racket-bug-report" "racket-bug-report.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from racket-bug-report.el
(autoload 'racket-bug-report "racket-bug-report" "\
Fill a buffer with data to make a racket-mode bug report.
\(fn)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-bug-report" '("racket--source-dir")))
;;;***
;;;### (autoloads nil "racket-collection" "racket-collection.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from racket-collection.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-collection" '("racket-")))
;;;***
;;;### (autoloads nil "racket-common" "racket-common.el" (0 0 0 0))
;;; Generated autoloads from racket-common.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-common" '("racket-")))
;;;***
;;;### (autoloads nil "racket-complete" "racket-complete.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from racket-complete.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-complete" '("racket-")))
;;;***
;;;### (autoloads nil "racket-custom" "racket-custom.el" (0 0 0 0))
;;; Generated autoloads from racket-custom.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-custom" '("racket-" "defface-racket")))
;;;***
;;;### (autoloads nil "racket-edit" "racket-edit.el" (0 0 0 0))
;;; Generated autoloads from racket-edit.el
(add-to-list 'hs-special-modes-alist '(racket-mode "(" ")" ";" nil nil))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-edit" '("racket-")))
;;;***
;;;### (autoloads nil "racket-font-lock" "racket-font-lock.el" (0
;;;;;; 0 0 0))
;;; Generated autoloads from racket-font-lock.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-font-lock" '("racket-")))
;;;***
;;;### (autoloads nil "racket-imenu" "racket-imenu.el" (0 0 0 0))
;;; Generated autoloads from racket-imenu.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-imenu" '("racket--")))
;;;***
;;;### (autoloads nil "racket-indent" "racket-indent.el" (0 0 0 0))
;;; Generated autoloads from racket-indent.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-indent" '("racket-")))
;;;***
;;;### (autoloads nil "racket-keywords-and-builtins" "racket-keywords-and-builtins.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from racket-keywords-and-builtins.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-keywords-and-builtins" '("racket-")))
;;;***
;;;### (autoloads nil "racket-logger" "racket-logger.el" (0 0 0 0))
;;; Generated autoloads from racket-logger.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-logger" '("racket-")))
;;;***
;;;### (autoloads nil "racket-make-doc" "racket-make-doc.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from racket-make-doc.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-make-doc" '("racket-make-doc/")))
;;;***
;;;### (autoloads nil "racket-mode" "racket-mode.el" (0 0 0 0))
;;; Generated autoloads from racket-mode.el
(autoload 'racket-mode "racket-mode" "\
Major mode for editing Racket.
\\{racket-mode-map}
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.rkt[dl]?\\'" . racket-mode))
(modify-coding-system-alist 'file "\\.rkt[dl]?\\'" 'utf-8)
(add-to-list 'interpreter-mode-alist '("racket" . racket-mode))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-mode" '("racket-")))
;;;***
;;;### (autoloads nil "racket-ppss" "racket-ppss.el" (0 0 0 0))
;;; Generated autoloads from racket-ppss.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-ppss" '("racket--ppss-")))
;;;***
;;;### (autoloads nil "racket-profile" "racket-profile.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from racket-profile.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-profile" '("racket-")))
;;;***
;;;### (autoloads nil "racket-repl" "racket-repl.el" (0 0 0 0))
;;; Generated autoloads from racket-repl.el
(autoload 'racket-repl "racket-repl" "\
Run the Racket REPL and display its buffer in some window.
If the Racket process is not already running, it is started.
If NOSELECT is not nil, does not select the REPL
window (preserves the originally selected window).
Commands that don't want the REPL to be displayed can instead use
`racket--repl-ensure-buffer-and-process'.
\(fn &optional NOSELECT)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-repl" '("racket-" "with-racket-repl-buffer")))
;;;***
;;;### (autoloads nil "racket-tests" "racket-tests.el" (0 0 0 0))
;;; Generated autoloads from racket-tests.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-tests" '("racket-tests/")))
;;;***
;;;### (autoloads nil "racket-unicode-input-method" "racket-unicode-input-method.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from racket-unicode-input-method.el
(autoload 'racket-unicode-input-method-enable "racket-unicode-input-method" "\
Set input method to `racket-unicode`.
The `racket-unicode` input method lets you easily type various
Unicode symbols that might be useful when writing Racket
code.
To automatically enable the `racket-unicode` input method in
`racket-mode` buffers use `M-x customize-variable <RET>
racket-mode-hook` or put the following code in your Emacs init
file:
(add-hook 'racket-mode-hook #'racket-unicode-input-method-enable)
Likewise for `racket-repl-mode` buffers:
(add-hook 'racket-repl-mode-hook #'racket-unicode-input-method-enable)
To temporarily enable this input method for a single buffer you
can use `M-x racket-unicode-input-method-enable`.
Use `C-\\` to toggle the input method.
When the `racket-unicode` input method is active, you can for
example type `All` and it is immediately replaced with `∀`. A few
other examples:
omega ω
x_1 x₁
x^1 x¹
|A| 𝔸
test-->>E test-->>∃ (racket/redex)
To see a table of all key sequences use `M-x
describe-input-method <RET> racket-unicode`.
If you don’t like the highlighting of partially matching tokens you
can turn it off by setting `input-method-highlight-flag' to nil via
`M-x customize-variable`.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "racket-util" "racket-util.el" (0 0 0 0))
;;; Generated autoloads from racket-util.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-util" '("racket--")))
;;;***
;;;### (autoloads nil nil ("racket-mode-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; racket-mode-autoloads.el ends here

8
elpa/racket-mode-20180609.1253/racket-mode-pkg.el Normal file
View File

@@ -0,0 +1,8 @@
(define-package "racket-mode" "20180609.1253" "Major mode for Racket language."
'((emacs "24.3")
(faceup "0.0.2")
(s "1.9.0"))
:url "https://github.com/greghendershott/racket-mode")
;; Local Variables:
;; no-byte-compile: t
;; End:

167
elpa/racket-mode-20180609.1253/racket-mode.el Normal file
View File

@@ -0,0 +1,167 @@
;;; racket-mode.el --- Major mode for Racket language.
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Package: racket-mode
;; Package-Requires: ((emacs "24.3") (faceup "0.0.2") (s "1.9.0"))
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
;;; Commentary:
;; Goals:
;; - Focus on Racket (not various Schemes).
;; - Follow DrRacket concepts where applicable.
;; - Thorough font-lock and indent.
;; - Compatible with Emacs 24.3+ and Racket 5.3.5+.
;;
;; Details: https://github.com/greghendershott/racket-mode
;;; Code:
(defconst racket-mode-copyright
"Copyright (c) 2013-2016 by Greg Hendershott. Portions Copyright (c) Free Software Foundation and Copyright (c) 2002-2012 Neil Van Dyke.")
(defconst racket-mode-legal-notice
"This is free software; you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation; either version 2, or (at your option) any later version. This is
distributed in the hope that it will be useful, but without any warranty;
without even the implied warranty of merchantability or fitness for a
particular purpose. See the GNU General Public License for more details. See
http://www.gnu.org/licenses/ for details.")
(defconst racket-mode-version "0.4")
(require 'racket-edit)
(require 'racket-imenu)
(require 'racket-profile)
(require 'racket-logger)
(require 'racket-repl)
(require 'racket-collection)
(require 'racket-bug-report)
(require 'racket-util)
(require 'easymenu)
(defvar racket-mode-map
(racket--easy-keymap-define
'((("C-c C-c"
"C-c C-k") racket-run)
("C-c C-z" racket-repl)
("<f5>" racket-run-and-switch-to-repl)
("M-C-<f5>" racket-racket)
("C-<f5>" racket-test)
("C-c C-t" racket-test)
("C-c C-l" racket-logger)
("C-c C-o" racket-profile)
("M-C-x" racket-send-definition)
("C-x C-e" racket-send-last-sexp)
("C-c C-r" racket-send-region)
("C-c C-e x" racket-expand-definition)
("C-c C-e e" racket-expand-last-sexp)
("C-c C-e r" racket-expand-region)
("C-c C-e a" racket-expand-again)
("C-c C-x C-f" racket-open-require-path)
("TAB" indent-for-tab-command)
("M-C-u" racket-backward-up-list)
("[" racket-smart-open-bracket)
(")" racket-insert-closing)
("]" racket-insert-closing)
("}" racket-insert-closing)
("C-c C-p" racket-cycle-paren-shapes)
("M-C-y" racket-insert-lambda)
("C-c C-d" racket-doc)
("C-c C-." racket-describe)
("M-." racket-visit-definition)
("M-C-." racket-visit-module)
("M-," racket-unvisit)
("C-c C-f" racket-fold-all-tests)
("C-c C-u" racket-unfold-all-tests)))
"Keymap for Racket mode.")
(easy-menu-define racket-mode-menu racket-mode-map
"Menu for Racket mode."
'("Racket"
("Run"
["in REPL" racket-run]
["in REPL and switch to REPL" racket-run-and-switch-to-repl]
["in *shell* using `racket`" racket-racket])
("Tests"
["in REPL" racket-test]
["in *shell* using `raco test`" racket-raco-test]
"---"
["Fold All" racket-fold-all-tests]
["Unfold All" racket-unfold-all-tests])
("Eval"
["Region" racket-send-region :active (region-active-p)]
["Definition" racket-send-definition]
["Last S-Expression" racket-send-last-sexp])
("Macro Expand"
["Region" racket-expand-region :active (region-active-p)]
["Definition" racket-expand-definition]
["Last S-Expression" racket-expand-last-sexp]
"---"
["Again" racket-expand-again])
["Switch to REPL" racket-repl]
("Tools"
["Profile" racket-profile]
["Check Syntax" racket-check-syntax-mode]
["Error Trace" racket-run-with-errortrace])
"---"
["Comment" comment-dwim]
["Insert λ" racket-insert-lambda]
["Indent Region" indent-region]
["Cycle Paren Shapes" racket-cycle-paren-shapes]
["Align" racket-align]
["Unalign" racket-unalign]
"---"
["Visit Definition" racket-visit-definition]
["Visit Module" racket-visit-module]
["Return from Visit" racket-unvisit]
"---"
["Open Require Path" racket-open-require-path]
["Find Collection" racket-find-collection]
"---"
["Next Error or Link" next-error]
["Previous Error" previous-error]
"---"
["Tidy Requires" racket-tidy-requires]
["Trim Requires" racket-trim-requires]
["Use #lang racket/base" racket-base-requires]
"---"
["Racket Documentation" racket-doc]
["Describe" racket-describe]
["Customize..." customize-mode]))
(defun racket--variables-imenu ()
(setq-local imenu-case-fold-search t)
(setq-local imenu-create-index-function #'racket--imenu-create-index-function))
;;;###autoload
(define-derived-mode racket-mode prog-mode
"Racket"
"Major mode for editing Racket.
\\{racket-mode-map}"
(racket--common-variables)
(racket--variables-imenu)
(hs-minor-mode t))
;;;###autoload
(progn
(add-to-list 'auto-mode-alist '("\\.rkt[dl]?\\'" . racket-mode))
(modify-coding-system-alist 'file "\\.rkt[dl]?\\'" 'utf-8)
(add-to-list 'interpreter-mode-alist '("racket" . racket-mode)))
(provide 'racket-mode)
;;; racket-mode.el ends here

79
elpa/racket-mode-20180609.1253/racket-ppss.el Normal file
View File

@@ -0,0 +1,79 @@
;;; racket-ppss.el
;; Copyright (c) 2013-2017 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
;; Note: These doc strings are from the Parser State info topic, as of
;; Emacs 25.1.
(defun racket--ppss-paren-depth (xs)
"The depth in parentheses, counting from 0.
*Warning:* this can be negative if there are more close parens
than open parens between the parser’s starting point and end
point."
(elt xs 0))
(defun racket--ppss-containing-sexp (xs)
"The character position of the start of the innermost parenthetical
grouping containing the stopping point; ‘nil’ if none."
(elt xs 1))
(defun racket--ppss-last-sexp (xs)
"The character position of the start of the last complete
subexpression terminated; ‘nil’ if none.
Valid only for `parse-partial-sexp' -- NOT `syntax-ppss'."
(elt xs 2))
(defun racket--ppss-string-p (xs)
"Non-‘nil’ if inside a string.
More precisely, this is the character that will terminate the
string, or ‘t’ if a generic string delimiter character should
terminate it."
(elt xs 3))
(defun racket--ppss-comment-p (xs)
"‘t’ if inside a non-nestable comment (of any comment style;
*note Syntax Flags::); or the comment nesting level if inside a
comment that can be nested."
(elt xs 4))
(defun racket--ppss-quote-p (xs)
"‘t’ if the end point is just after a quote character."
(elt xs 5))
(defun racket--ppss-min-paren-depth (xs)
"The minimum parenthesis depth encountered during this scan.
Valid only for `parse-partial-sexp' -- NOT `syntax-ppss'."
(elt xs 6))
(defun racket--ppss-comment-type (xs)
"What kind of comment is active: ‘nil’ if not in a comment or
in a comment of style ‘a’; 1 for a comment of style ‘b’; 2 for a
comment of style ‘c’; and ‘syntax-table’ for a comment that
should be ended by a generic comment delimiter character."
(elt xs 7))
(defun racket--ppss-string/comment-start (xs)
"The string or comment start position.
While inside a comment, this is the position where the comment
began; while inside a string, this is the position where the
string began. When outside of strings and comments, this element
is ‘nil’."
(elt xs 8))
(provide 'racket-ppss)
;; racket-ppss.el ends here

171
elpa/racket-mode-20180609.1253/racket-profile.el Normal file
View File

@@ -0,0 +1,171 @@
;;; racket-profile.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'cl-lib)
(require 'racket-edit)
(require 'racket-repl)
(defvar racket--profile-results nil)
(defvar racket--profile-sort-col 1) ;0=Calls, 1=Msec
(defvar racket--profile-show-zero nil)
(defvar racket--profile-overlay-this nil)
(defvar racket--profile-overlay-that nil)
(defun racket-profile ()
"Runs with profiling instrumentation and shows results.
Results are presented in a `racket-profile-mode' buffer, which
also lets you quickly view the source code.
You may evaluate expressions in the REPL. They are also profiled.
Use `racket--profile-refresh' to see the updated results. (In
other words a possible workflow is: `racket-profile' a .rkt file,
call one its functions in the REPL, and refresh the profile
results.)
Caveat: Only source files are instrumented. You may need to
delete compiled/*.zo files."
(interactive)
(when (eq major-mode 'racket-mode)
(message "Running with profiling instrumentation...")
(racket--do-run 'profile)
(message "Waiting for Racket prompt...")
(while (not (racket--repl-command "prompt"))
(sit-for 0.5))
(message "Getting results...")
(setq racket--profile-results (racket--repl-command "get-profile"))
(setq racket--profile-sort-col 1)
(with-current-buffer (get-buffer-create "*Racket Profile*")
(racket-profile-mode)
(racket--profile-draw)
(pop-to-buffer (current-buffer)))
(message "")))
(defun racket--profile-refresh ()
(interactive)
(setq racket--profile-results (racket--repl-command "get-profile"))
(racket--profile-draw))
(defun racket--profile-draw ()
(read-only-mode -1)
(erase-buffer)
(setq truncate-lines t) ;let run off right edge
;; TODO: Would be nice to set the Calls and Msec column widths based
;; on max values.
(setq header-line-format
(format " %8s %6s %-20.20s %s"
(if (= 0 racket--profile-sort-col) "CALLS" "Calls")
(if (= 1 racket--profile-sort-col) "MSEC" "Msec")
"Name (inferred)"
"File"))
(insert
(mapconcat (lambda (xs)
(cl-destructuring-bind (calls msec name file beg end) xs
(propertize (format "%8d %6d %-20.20s %s"
calls msec (or name "") (or file ""))
'racket-profile-location
(and file beg end
(list file beg end)))))
(sort (cl-remove-if-not (lambda (x)
(or racket--profile-show-zero
(/= 0 (nth 0 x))
(/= 0 (nth 1 x))))
(cl-copy-list racket--profile-results))
(lambda (a b) (> (nth racket--profile-sort-col a)
(nth racket--profile-sort-col b))))
"\n"))
(read-only-mode 1)
(goto-char (point-min)))
(defun racket--profile-sort ()
"Toggle sort between Calls and Msec."
(interactive)
(setq racket--profile-sort-col (if (= racket--profile-sort-col 0) 1 0))
(racket--profile-draw))
(defun racket--profile-show-zero ()
"Toggle between showing results with zero Calls or Msec."
(interactive)
(setq racket--profile-show-zero (not racket--profile-show-zero))
(racket--profile-draw))
(defun racket--profile-visit ()
(interactive)
(let ((win (selected-window)))
(pcase (get-text-property (point) 'racket-profile-location)
(`(,file ,beg ,end)
(setq racket--profile-overlay-this
(make-overlay (save-excursion (beginning-of-line) (point))
(save-excursion (end-of-line) (point))
(current-buffer)))
(overlay-put racket--profile-overlay-this 'face 'next-error)
(find-file-other-window file)
(setq racket--profile-overlay-that (make-overlay beg end (current-buffer)))
(overlay-put racket--profile-overlay-that 'face 'next-error)
(goto-char beg)
(add-hook 'pre-command-hook #'racket--profile-remove-overlay)
(select-window win)))))
(defun racket--profile-remove-overlay ()
(delete-overlay racket--profile-overlay-this)
(delete-overlay racket--profile-overlay-that)
(remove-hook 'pre-command-hook #'racket--profile-remove-overlay))
(defun racket--profile-next ()
(interactive)
(forward-line 1)
(racket--profile-visit))
(defun racket--profile-prev ()
(interactive)
(forward-line -1)
(racket--profile-visit))
(defun racket--profile-quit ()
(interactive)
(setq racket--profile-results nil)
(quit-window))
(defvar racket-profile-mode-map
(let ((m (make-sparse-keymap)))
(set-keymap-parent m nil)
(mapc (lambda (x)
(define-key m (kbd (car x)) (cadr x)))
'(("q" racket--profile-quit)
("g" racket--profile-refresh)
("n" racket--profile-next)
("p" racket--profile-prev)
("z" racket--profile-show-zero)
("RET" racket--profile-visit)
("," racket--profile-sort)))
m)
"Keymap for Racket Profile mode.")
(define-derived-mode racket-profile-mode special-mode
"RacketProfile"
"Major mode for results of `racket-profile'.
```
\\{racket-profile-mode-map}
```
"
(setq show-trailing-whitespace nil))
(provide 'racket-profile)
;; racket-profile.el ends here

498
elpa/racket-mode-20180609.1253/racket-repl.el Normal file
View File

@@ -0,0 +1,498 @@
;;; racket-repl.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Image portions Copyright (C) 2012 Jose Antonio Ortega Ruiz.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'racket-custom)
(require 'racket-common)
(require 'racket-util)
(require 'comint)
(require 'compile)
(require 'easymenu)
(defconst racket--repl-buffer-name/raw
"Racket REPL"
"The base buffer name, NOT surrounded in *stars*")
(defconst racket--repl-buffer-name
(concat "*" racket--repl-buffer-name/raw "*")
"The actual buffer name as created by comint-mode")
(defmacro with-racket-repl-buffer (&rest body)
"Execute the forms in BODY with `racket-repl-mode' temporarily current.
The value returned is the value of the last form in BODY --
unless no `racket-repl-mode' buffer exists, in which case no BODY
forms are evaluated and nil is returned. See also
`with-current-buffer'."
(declare (indent 0) (debug t))
(let ((repl-buffer (make-symbol "repl-buffer")))
`(let ((,repl-buffer (get-buffer racket--repl-buffer-name)))
(when ,repl-buffer
(with-current-buffer ,repl-buffer
,@body)))))
(defun racket--get-repl-buffer-process ()
(get-buffer-process racket--repl-buffer-name))
(defun racket-repl--input-filter (str)
"Don't save anything matching `racket-history-filter-regexp'."
(not (string-match racket-history-filter-regexp str)))
(defun racket--get-old-input ()
"Snarf the sexp ending at point."
(if (looking-back comint-prompt-regexp (line-beginning-position))
""
(save-excursion
(let ((end (point)))
(backward-sexp)
(buffer-substring (point) end)))))
(defun racket-repl-eval-or-newline-and-indent ()
"If complete sexpr, eval in Racket. Else do `racket-newline-and-indent'."
(interactive)
(let ((proc (get-buffer-process (current-buffer))))
(cond ((not proc) (user-error "Current buffer has no process"))
((not (eq "" (racket--get-old-input)))
(condition-case nil
(let* ((beg (marker-position (process-mark proc)))
(end (save-excursion
(goto-char beg)
(forward-list) ;scan-error unless complete sexpr
(point))))
(comint-send-input)
;; Remove comint-highlight-input face applied to
;; input. I don't like how that looks.
(remove-text-properties beg end '(font-lock-face comint-highlight-input)))
(scan-error (newline-and-indent)))))))
;;;###autoload
(defun racket-repl (&optional noselect)
"Run the Racket REPL and display its buffer in some window.
If the Racket process is not already running, it is started.
If NOSELECT is not nil, does not select the REPL
window (preserves the originally selected window).
Commands that don't want the REPL to be displayed can instead use
`racket--repl-ensure-buffer-and-process'."
(interactive "P")
(racket--repl-ensure-buffer-and-process t)
(unless noselect
(select-window (get-buffer-window racket--repl-buffer-name t))))
(defconst racket--minimum-required-version "6.0"
"The minimum version of Racket required by run.rkt.
Although some functionality may require an even newer version of
Racket, run.rkt will handle that via `dynamic-require` and
fallbacks. The version number here is a baseline for run.rkt to
be able to load at all.")
(defvar racket--run.rkt
(expand-file-name "run.rkt"
(file-name-directory (or load-file-name
(racket--buffer-file-name))))
"Path to run.rkt")
(defun racket--repl-live-p ()
"Does the Racket REPL buffer exist and have a live Racket process?"
(comint-check-proc racket--repl-buffer-name))
(defun racket--repl-ensure-buffer-and-process (&optional display)
"Ensure Racket REPL buffer exists and has live Racket process.
If the Racket process is not already running, it is started and
the buffer is put in `racket-repl-mode'.
Non-nil DISPLAY means `display-buffer'.
Never changes selected window."
(if (comint-check-proc racket--repl-buffer-name)
(when display
(display-buffer racket--repl-buffer-name))
(racket--require-version racket--minimum-required-version)
(with-current-buffer
(with-temp-message "Starting Racket process..."
(make-comint racket--repl-buffer-name/raw ;w/o *stars*
racket-program
nil
racket--run.rkt
(number-to-string racket-command-port)))
;; Display now so users see startup and banner sooner.
(when display
(display-buffer (current-buffer)))
;; The following is needed to make e.g. λ work when pasted
;; into the comint-buffer, both directly by the user and via
;; the racket--repl-eval functions.
(set-process-coding-system (get-buffer-process racket--repl-buffer-name)
'utf-8 'utf-8)
(racket-repl-mode)
(racket--repl-command-connect))))
(defun racket--version ()
"Get the `racket-program' version as a string."
(with-temp-message "Checking Racket version..."
(with-temp-buffer
(call-process racket-program
nil ;infile: none
t ;destination: current-buffer
nil ;redisplay: no
"-e"
"(version)")
(eval (read (buffer-substring (point-min) (point-max)))))))
(defun racket--require-version (at-least)
"Raise a `user-error' unless Racket is version AT-LEAST."
(let ((have (racket--version)))
(unless (version<= at-least have)
(user-error "racket-mode requires at least Racket version %s but you have %s"
at-least have))
t))
(defvar racket--repl-command-process nil)
(defvar racket--repl-command-connect-timeout 30)
(defun racket--repl-command-connect ()
"Connect to the Racket command process.
If already connected, disconnects then connects again."
(racket--repl-command-disconnect)
(with-temp-message "Connecting to command process..."
;; The command server may not be ready -- Racket itself and our
;; backend are still starting up -- so retry until timeout.
(with-timeout (racket--repl-command-connect-timeout
(error "Could not connect to command process"))
(while (not racket--repl-command-process)
(condition-case ()
(setq racket--repl-command-process
(let ((process-connection-type nil)) ;use pipe not pty
(open-network-stream "racket-command"
(get-buffer-create "*racket-command-output*")
"127.0.0.1"
racket-command-port)))
(error (sit-for 0.1)))))))
(defun racket--repl-command-disconnect ()
"Disconnect from the Racket command process."
(when racket--repl-command-process
(with-temp-message "Deleting existing connection to command process..."
(delete-process racket--repl-command-process)
(setq racket--repl-command-process nil))))
(defun racket--repl-command (fmt &rest xs)
"Send command to the Racket process and return the response sexp.
Do not prefix the command with a `,'. Not necessary to append \n."
(racket--repl-ensure-buffer-and-process)
(let ((proc racket--repl-command-process))
(unless proc
(error "Command process is nil"))
(with-current-buffer (process-buffer proc)
(delete-region (point-min) (point-max))
(process-send-string proc
(concat (apply #'format (cons fmt xs))
"\n"))
(with-timeout (racket-command-timeout
(error "Command process timeout"))
;; While command server running and not yet complete sexp
(while (and (memq (process-status proc) '(open run))
(or (= (point) (point-min))
(condition-case ()
(progn (scan-lists (point-min) 1 0) nil)
(scan-error t))))
(accept-process-output nil 0.1)))
(cond ((not (memq (process-status proc) '(open run)))
(error "Racket command process: died"))
((= (point-min) (point))
(error "Racket command process: Empty response"))
(t
(let ((result (buffer-substring (point-min) (point-max))))
(delete-region (point-min) (point-max))
(eval (read result))))))))
(defun racket-repl-file-name ()
"Return the file running in the buffer, or nil.
The result can be nil if the REPL is not started, or if it is
running no particular file as with the `,top` command.
On Windows this will replace \ with / in an effort to match the
Unix style names used by Emacs on Windows."
(when (comint-check-proc racket--repl-buffer-name)
(let ((path (racket--repl-command "path")))
(and path
(cl-case system-type
(windows-nt (subst-char-in-string ?\\ ?/ path))
(otherwise path))))))
(defun racket--in-repl-or-its-file-p ()
"Is current-buffer `racket-repl-mode' or buffer for file active in it?"
(or (eq (current-buffer)
(get-buffer racket--repl-buffer-name))
(string-equal (racket--buffer-file-name)
(racket-repl-file-name))))
(defun racket-repl-switch-to-edit ()
"Switch to the window for the buffer of the file running in the REPL.
If no buffer is visting the file, `find-file' it in `other-window'.
If the REPL is running no file -- if the prompt is `>` -- use the
most recent `racket-mode' buffer, if any."
(interactive)
(let ((path (racket-repl-file-name)))
(if path
(let ((buffer (find-buffer-visiting path)))
(if buffer
(pop-to-buffer buffer t)
(other-window 1)
(find-file path)))
(let ((buffer (racket--most-recent-racket-mode-buffer)))
(unless buffer
(user-error "There are no racket-mode buffers"))
(pop-to-buffer buffer t)))))
(defun racket--most-recent-racket-mode-buffer ()
(cl-some (lambda (b)
(with-current-buffer b
(and (eq major-mode 'racket-mode) b)))
(buffer-list)))
(defun racket--repl-eval (fmt &rest vs)
"Eval expression in the *Racket REPL* buffer.
Allow Racket process output to be displayed, and show the window.
Intended for use by things like ,run command."
(racket-repl t)
(racket--repl-forget-errors)
(comint-send-string (racket--get-repl-buffer-process)
(apply #'format (cons fmt vs)))
(racket--repl-show-and-move-to-end))
;;; send to REPL
(defun racket--send-region-to-repl (start end)
"Internal function to send the region to the Racket REPL.
Before sending the region, call `racket-repl' and
`racket--repl-forget-errors'. Also insert a ?\n at the process
mark so that output goes on a fresh line, not on the same line as
the prompt.
Afterwards call `racket--repl-show-and-move-to-end'."
(when (and start end)
(racket-repl t)
(racket--repl-forget-errors)
(let ((proc (racket--get-repl-buffer-process)))
(with-racket-repl-buffer
(save-excursion
(goto-char (process-mark proc))
(insert ?\n)
(set-marker (process-mark proc) (point))))
(comint-send-region proc start end)
(comint-send-string proc "\n"))
(racket--repl-show-and-move-to-end)))
(defun racket-send-region (start end)
"Send the current region (if any) to the Racket REPL."
(interactive "r")
(unless (region-active-p)
(user-error "No region"))
(racket--send-region-to-repl start end))
(defun racket-send-definition ()
"Send the current definition to the Racket REPL."
(interactive)
(save-excursion
(end-of-defun)
(let ((end (point)))
(beginning-of-defun)
(racket--send-region-to-repl (point) end))))
(defun racket-send-last-sexp ()
"Send the previous sexp to the Racket REPL.
When the previous sexp is a sexp comment the sexp itself is sent,
without the #; prefix."
(interactive)
(racket--send-region-to-repl (save-excursion
(backward-sexp)
(if (save-match-data (looking-at "#;"))
(+ (point) 2)
(point)))
(point)))
(defun racket--repl-forget-errors ()
"Forget existing errors in the REPL.
Although they remain clickable they will be ignored by
`next-error' and `previous-error'"
(with-racket-repl-buffer
(compilation-forget-errors)
;; `compilation-forget-errors' may have just set
;; `compilation-messages-start' to a marker at position 1. But in
;; that case process output (including error messages) will be
;; inserted ABOVE the marker, in which case `next-error' won't see
;; them. Instead use a non-marker position like 1 or use nil.
(when (and (markerp compilation-messages-start)
(equal (marker-position compilation-messages-start) 1)
(equal (marker-buffer compilation-messages-start) (current-buffer)))
(setq compilation-messages-start nil))))
(defun racket--repl-show-and-move-to-end ()
"Make the Racket REPL visible, and move point to end.
Keep original window selected."
(display-buffer racket--repl-buffer-name)
(save-selected-window
(select-window (get-buffer-window racket--repl-buffer-name t))
(comint-show-maximum-output)))
;;; Inline images in REPL
(defvar racket-image-cache-dir nil)
(defun racket-repl--list-image-cache ()
"List all the images in the image cache."
(and racket-image-cache-dir
(file-directory-p racket-image-cache-dir)
(let ((files (directory-files-and-attributes
racket-image-cache-dir t "racket-image-[0-9]*.png")))
(mapcar 'car
(sort files (lambda (a b)
(< (float-time (nth 6 a))
(float-time (nth 6 b)))))))))
(defun racket-repl--clean-image-cache ()
"Clean all except for the last `racket-images-keep-last'
images in 'racket-image-cache-dir'."
(interactive)
(dolist (file (butlast (racket-repl--list-image-cache)
racket-images-keep-last))
(delete-file file)))
(defun racket-repl--replace-images ()
"Replace all image patterns with actual images"
(with-silent-modifications
(save-excursion
(goto-char (point-min))
(while (re-search-forward "\"#<Image: \\(.+racket-image-.+\\.png\\)>\"" nil t)
;; can't pass a filename to create-image because emacs might
;; not display it before it gets deleted (race condition)
(let* ((file (match-string 1))
(begin (match-beginning 0))
(end (match-end 0)))
(delete-region begin end)
(goto-char begin)
(if (and racket-images-inline (display-images-p))
(insert-image (create-image file) "[image]")
(goto-char begin)
(insert "[image] ; use M-x racket-view-last-image to view"))
(setq racket-image-cache-dir (file-name-directory file))
(racket-repl--clean-image-cache))))))
(defun racket-view-last-image (n)
"Open the last displayed image using `racket-images-system-viewer'.
With prefix arg, open the N-th last shown image."
(interactive "p")
(let ((images (reverse (racket-repl--list-image-cache))))
(if (>= (length images) n)
(start-process "Racket image view"
nil
racket-images-system-viewer
(nth (- n 1) images))
(error "There aren't %d recent images" n))))
(defun racket-repl--output-filter (txt)
(racket-repl--replace-images))
;;; racket-repl-mode
(defvar racket-repl-mode-map
(racket--easy-keymap-define
'(("RET" racket-repl-eval-or-newline-and-indent)
("TAB" indent-for-tab-command)
("M-C-u" racket-backward-up-list)
("C-a" comint-bol)
("C-w" comint-kill-region)
("[C-S-backspace]" comint-kill-whole-line)
("[" racket-smart-open-bracket)
(")" racket-insert-closing)
("]" racket-insert-closing)
("}" racket-insert-closing)
("C-c C-e x" racket-expand-definition)
("C-c C-e e" racket-expand-last-sexp)
("C-c C-e r" racket-expand-region)
("C-c C-e a" racket-expand-again)
("M-C-y" racket-insert-lambda)
("C-c C-d" racket-doc)
("C-c C-." racket-describe)
("M-." racket-visit-definition)
("C-M-." racket-visit-module)
("M-," racket-unvisit)
("C-c C-z" racket-repl-switch-to-edit)
("C-c C-l" racket-logger)))
"Keymap for Racket REPL mode.")
(easy-menu-define racket-repl-mode-menu racket-repl-mode-map
"Menu for Racket REPL mode."
'("Racket"
["Insert Lambda" racket-insert-lambda] ;λ in string breaks menu
["Indent Region" indent-region]
["Cycle Paren Shapes" racket-cycle-paren-shapes]
("Macro Expand"
["Region" racket-expand-region :active (region-active-p)]
["Definition" racket-expand-definition]
["Last S-Expression" racket-expand-last-sexp]
"---"
["Again" racket-expand-again])
"---"
["Visit Definition" racket-visit-definition]
["Visit Module" racket-visit-module]
["Return from Visit" racket-unvisit]
"---"
["Racket Documentation" racket-doc]
["Describe" racket-describe]
"---"
["Switch to Edit Buffer" racket-repl-switch-to-edit]))
(define-derived-mode racket-repl-mode comint-mode "Racket-REPL"
"Major mode for Racket REPL.
\\{racket-repl-mode-map}"
(racket--common-variables)
(setq-local comint-prompt-regexp (rx (regexp "^[^>\n]*") "\ufeff> "))
(setq-local comint-use-prompt-regexp t)
(setq-local comint-prompt-read-only nil)
(setq-local mode-line-process nil)
(setq-local comint-input-filter #'racket-repl--input-filter)
(add-hook 'comint-output-filter-functions #'racket-repl--output-filter nil t)
(compilation-setup t)
(setq-local
compilation-error-regexp-alist
'(;; error
("^;?[ ]*\\([^ :]+\\):\\([0-9]+\\)[:.]\\([0-9]+\\)" 1 2 3)
;; contract
("^;?[ ]*at:[ ]+\\([^ :]+\\):\\([0-9]+\\)[.]\\([0-9]+\\)$" 1 2 3)
;; rackunit check-xxx
("#<path:\\([^>]+\\)> \\([0-9]+\\) \\([0-9]+\\)" 1 2 3)
;;rackunit/text-ui test-suite
("^location:[ ]+\\(\\([^:]+\\):\\([0-9]+\\):\\([0-9]+\\)\\)" 2 3 4 2 1)
;; path struct
("#<path:\\([^>]+\\)>" 1 nil nil 0)
))
(setq-local comint-get-old-input #'racket--get-old-input))
(provide 'racket-repl)
;; racket-repl.el ends here

188
elpa/racket-mode-20180609.1253/racket-tests.el Normal file
View File

@@ -0,0 +1,188 @@
;;; racket-tests.el --- Major mode for Racket language.
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'ert)
(require 'racket-mode)
(require 'racket-repl)
(require 'racket-edit)
(require 'edmacro)
(require 'faceup)
(require 'racket-common)
(defconst racket-tests/here-dir (faceup-this-file-directory)
"The directory this file is located in.")
;;; Utility functions for "integration" testing
(defun racket-tests/type (typing)
(let ((blink-matching-paren nil)) ;suppress "Matches " messages
(execute-kbd-macro (string-to-vector typing))
(redisplay)))
(defun racket-tests/press (binding)
(racket-tests/type (edmacro-parse-keys binding)))
(defun racket-tests/type&press (typing binding)
(racket-tests/type typing)
(racket-tests/press binding))
(defun racket-tests/see-rx (rx)
(let ((one-second-attempts (if (getenv "TRAVIS_CI")
(* 15 60)
30)))
;; Although using cl-some like this is weird, cl-loop is weirder IMHO
(cl-some (lambda (_x)
(accept-process-output (racket--get-repl-buffer-process) 1)
(sit-for 0.1)
(looking-back rx (point-min)))
(make-list one-second-attempts nil))))
(defun racket-tests/see (str)
(racket-tests/see-rx (regexp-quote str)))
(defun racket-tests/explain-see (str)
`(actual . ,(buffer-substring-no-properties
(point-min)
(point))))
(put 'racket-tests/see-rx 'ert-explainer #'racket-tests/explain-see)
(put 'racket-tests/see 'ert-explainer #'racket-tests/explain-see)
;;; REPL
(ert-deftest racket-tests/repl ()
"Start REPL. Confirm we get Welcome message and prompt. Exit REPL."
(racket-repl)
(with-racket-repl-buffer
(let ((tab-always-indent 'complete)
(racket--repl-command-connect-timeout (* 15 60))
(racket-command-port 55556)
(racket-command-timeout (* 15 60)))
;; Welcome
(should (racket-tests/see-rx (concat "Welcome to Racket v[0-9.]+\n"
(regexp-quote "\uFEFF> "))))
;; Completion
(racket-tests/type&press "with-inp" "TAB")
(should (racket-tests/see "with-input-from-file"))
(racket-tests/press "RET")
(should (racket-tests/see "#<procedure:with-input-from-file>\n\uFEFF> "))
;; Multiline expression indent
(racket-tests/type&press "(if 1" "RET")
(should (racket-tests/see "(if 1\n "))
(racket-tests/type&press "2" "RET")
(should (racket-tests/see "2\n "))
(racket-tests/type&press "3)" "RET")
(should (racket-tests/see "3)\n2\n\uFEFF> "))
;; Exit
(racket-tests/type&press "(exit)" "RET")
(should (racket-tests/see "Process Racket REPL finished\n")))))
;;; Run
(ert-deftest racket-tests/run ()
(let* ((racket--repl-command-connect-timeout (* 15 60))
(racket-command-port 55556)
(racket-command-timeout (* 15 60))
(pathname (make-temp-file "test" nil ".rkt"))
(name (file-name-nondirectory pathname))
(code "#lang racket/base\n(define x 42)\nx\n"))
(write-region code nil pathname nil 'no-wrote-file-message)
(find-file pathname)
(racket-run)
;; see expected prompt
(with-racket-repl-buffer
(should (racket-tests/see (concat "\n" name "\uFEFF> "))))
;; racket-check-syntax-mode
(when (version<= "6.2" (racket--version))
(let ((racket--check-syntax-start-timeout (if (getenv "TRAVIS_CI")
(* 15 60)
racket--check-syntax-start-timeout)))
(racket-check-syntax-mode 1))
(goto-char (point-min))
(racket-check-syntax-mode-goto-next-def)
(should (looking-at "racket/base"))
(racket-check-syntax-mode-goto-next-use)
(should (looking-at "define"))
(racket-check-syntax-mode 0))
;; Exit
;; (with-racket-repl-buffer
;; (racket-tests/type&press "(exit)" "RET"))
(delete-file pathname)))
;;; Indentation
(defun racket-tests/same-indent (file)
(with-current-buffer (find-file (concat racket-tests/here-dir file))
(indent-region (point-min) (point-max))
(let ((ok (not (buffer-modified-p))))
(revert-buffer t t t) ;revert in case running ERT interactively
ok)))
(ert-deftest racket-tests/indent-rkt ()
"Indentation of example/*.rkt shouldn't change."
(should (racket-tests/same-indent "example/example.rkt"))
(should (racket-tests/same-indent "example/indent.rkt")))
;;; Font-lock
(defun racket-tests/same-faceup (file)
"Test that FILE is fontified as the .faceup file describes.
FILE is interpreted as relative to this source directory."
(let ((font-lock-maximum-decoration t))
(faceup-test-font-lock-file 'racket-mode
(concat racket-tests/here-dir file))))
(faceup-defexplainer racket-tests/same-faceup)
(ert-deftest racket-tests/font-lock ()
"Font-lock of example/*.rkt shouldn't change."
(should (racket-tests/same-faceup "example/indent.rkt"))
(should (racket-tests/same-faceup "example/example.rkt")))
;;; Smart open bracket
(defun racket-tests/brackets (smartp input expected)
(with-temp-buffer
(racket-mode)
(let ((racket-smart-open-bracket-enable smartp)
(blink-matching-paren nil)) ;suppress "Matches " messages
(mapc (lambda (x)
(cond ((eq x ?\[) (racket-smart-open-bracket))
((eq x ?\]) (racket-insert-closing))
(t (racket--self-insert x))))
input)
(equal (buffer-substring-no-properties (point-min) (point-max))
expected))))
(ert-deftest racket-tests/smart-open-bracket ()
"Type a `cond` form with `racket-smart-open-bracket-enable' both t and nil.
Also try with `electric-pair-mode' both on and off.
Currently this is really just a regression test for bug #81. This
could be expanded into a series of exhaustive tests of all the
special forms it handles."
(let ((before "[cond [[f x] #t][else #f]]")
(after "(cond [(f x) #t][else #f])")
(orig-electricp electric-pair-mode))
(electric-pair-mode -1)
(should (racket-tests/brackets nil before before))
(should (racket-tests/brackets t before after))
(electric-pair-mode 1)
(should (racket-tests/brackets nil before before))
(should (racket-tests/brackets t before after))
;; Restore in case running interactively with ERT
(electric-pair-mode (if orig-electricp 1 -1))))
(provide 'racket-tests)
;;; racket-tests.el ends here

224
elpa/racket-mode-20180609.1253/racket-unicode-input-method.el Normal file
View File

@@ -0,0 +1,224 @@
;;; racket-unicode-input-method.el --- Racket Unicode helper functions
;; Copyright (c) 2015-2016 by Greg Hendershott
;; Portions Copyright (c) 2010-2011 by Roel van Dijk
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
;; Following the example of haskell-unicode-input-method.el
(require 'quail)
;;;###autoload
(defun racket-unicode-input-method-enable ()
"Set input method to `racket-unicode`.
The `racket-unicode` input method lets you easily type various
Unicode symbols that might be useful when writing Racket
code.
To automatically enable the `racket-unicode` input method in
`racket-mode` buffers use `M-x customize-variable <RET>
racket-mode-hook` or put the following code in your Emacs init
file:
(add-hook 'racket-mode-hook #'racket-unicode-input-method-enable)
Likewise for `racket-repl-mode` buffers:
(add-hook 'racket-repl-mode-hook #'racket-unicode-input-method-enable)
To temporarily enable this input method for a single buffer you
can use `M-x racket-unicode-input-method-enable`.
Use `C-\\` to toggle the input method.
When the `racket-unicode` input method is active, you can for
example type `All` and it is immediately replaced with `∀`. A few
other examples:
omega ω
x_1 x₁
x^1 x¹
|A| 𝔸
test-->>E test-->>∃ (racket/redex)
To see a table of all key sequences use `M-x
describe-input-method <RET> racket-unicode`.
If you don’t like the highlighting of partially matching tokens you
can turn it off by setting `input-method-highlight-flag' to nil via
`M-x customize-variable`."
(interactive)
(set-input-method "racket-unicode"))
(quail-define-package
"racket-unicode" ;name
"UTF-8" ;language
"λ" ;title (in mode line)
t ;guidance
"Racket Unicode input method." ;docstring
nil ;translation-keys
nil ;forget-last-selection
nil ;deterministic
nil ;kbd-translate
nil ;show-layout
nil ;create-decode-map
nil ;maximum-shortest
nil ;overlay-plist
nil ;update-translation-function
nil ;conversion-keys
t) ;simple
(quail-define-rules
;; Typed Racket
("All" ["∀"])
("Union" ["U"])
("Intersection" ["∩"])
;; These would be nice except no such aliases provided by racket/contract.
;; ("->" ["→"])
;; ("case->" ["case→"])
;; Redex
("test-->>E" ["test-->>∃"])
;; Greek letters
("alpha " ["α"])
("Alpha " ["Α"])
("beta " ["β"])
("Beta " ["Β"])
("gamma " ["γ"])
("Gamma " ["Γ"])
("delta " ["δ"])
("Delta " ["Δ"])
("epsilon " ["ε"])
("Epsilon " ["Ε"])
("zeta " ["ζ"])
("Zeta " ["Ζ"])
("eta " ["η"])
("Eta " ["Η"])
("theta " ["θ"])
("Theta " ["Θ"])
("iota " ["ι"])
("Iota " ["Ι"])
("kappa " ["κ"])
("Kappa " ["Κ"])
("lambda " ["λ"])
("Lambda " ["Λ"])
("lamda " ["λ"])
("Lamda " ["Λ"])
("mu " ["μ"])
("Mu " ["Μ"])
("nu " ["ν"])
("Nu " ["Ν"])
("xi " ["ξ"])
("Xi " ["Ξ"])
("omicron " ["ο"])
("Omicron " ["Ο"])
("pi " ["π"])
("Pi " ["Π"])
("rho " ["ρ"])
("Rho " ["Ρ"])
("sigma " ["σ"])
("Sigma " ["Σ"])
("tau " ["τ"])
("Tau " ["Τ"])
("upsilon " ["υ"])
("Upsilon " ["Υ"])
("phi " ["φ"])
("Phi " ["Φ"])
("chi " ["χ"])
("Chi " ["Χ"])
("psi " ["ψ"])
("Psi " ["Ψ"])
("omega " ["ω"])
("Omega " ["Ω"])
("digamma " ["ϝ"])
("Digamma " ["Ϝ"])
("san " ["ϻ"])
("San " ["Ϻ"])
("qoppa " ["ϙ"])
("Qoppa " ["Ϙ"])
("sampi " ["ϡ"])
("Sampi " ["Ϡ"])
("stigma " ["ϛ"])
("Stigma " ["Ϛ"])
("heta " ["ͱ"])
("Heta " ["Ͱ"])
("sho " ["ϸ"])
("Sho " ["Ϸ"])
;; Double-struck letters
("|A|" ["𝔸"])
("|B|" ["𝔹"])
("|C|" ["ℂ"])
("|D|" ["𝔻"])
("|E|" ["𝔼"])
("|F|" ["𝔽"])
("|G|" ["𝔾"])
("|H|" ["ℍ"])
("|I|" ["𝕀"])
("|J|" ["𝕁"])
("|K|" ["𝕂"])
("|L|" ["𝕃"])
("|M|" ["𝕄"])
("|N|" ["ℕ"])
("|O|" ["𝕆"])
("|P|" ["ℙ"])
("|Q|" ["ℚ"])
("|R|" ["ℝ"])
("|S|" ["𝕊"])
("|T|" ["𝕋"])
("|U|" ["𝕌"])
("|V|" ["𝕍"])
("|W|" ["𝕎"])
("|X|" ["𝕏"])
("|Y|" ["𝕐"])
("|Z|" ["ℤ"])
("|gamma|" ["ℽ"])
("|Gamma|" ["ℾ"])
("|pi|" ["ℼ"])
("|Pi|" ["ℿ"])
;; Quantifiers
("forall" ["∀"])
("exists" ["∃"])
;; Numeric subscripts
("_0 " ["₀"])
("_1 " ["₁"])
("_2 " ["₂"])
("_3 " ["₃"])
("_4 " ["₄"])
("_5 " ["₅"])
("_6 " ["₆"])
("_7 " ["₇"])
("_8 " ["₈"])
("_9 " ["₉"])
;; Numeric superscripts
("^0 " ["⁰"])
("^1 " ["¹"])
("^2 " ["²"])
("^3 " ["³"])
("^4 " ["⁴"])
("^5 " ["⁵"])
("^6 " ["⁶"])
("^7 " ["⁷"])
("^8 " ["⁸"])
("^9 " ["⁹"]))
(provide 'racket-unicode-input-method)
;;; racket-unicode-input-method.el ends here

92
elpa/racket-mode-20180609.1253/racket-util.el Normal file
View File

@@ -0,0 +1,92 @@
;;; racket-util.el
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version. This is distributed in the hope that it will be
;; useful, but without any warranty; without even the implied warranty
;; of merchantability or fitness for a particular purpose. See the GNU
;; General Public License for more details. See
;; http://www.gnu.org/licenses/ for details.
(require 'racket-custom)
(defun racket--easy-keymap-define (spec)
"Make a sparse keymap with the bindings in SPEC.
This is simply a way to DRY many calls to `define-key'.
SPEC is
(list (list key-or-keys fn) ...)
where key-or-keys is either a string given to `kbd', or (for the
case where multiple keys bind to the same command) a list of such
strings."
(let ((m (make-sparse-keymap)))
(mapc (lambda (x)
(let ((keys (if (listp (car x))
(car x)
(list (car x))))
(fn (cadr x)))
(mapc (lambda (key)
(define-key m (kbd key) fn))
keys)))
spec)
m))
(defun racket--buffer-file-name ()
"Like `buffer-file-name' but always a non-propertized string."
(and (buffer-file-name)
(substring-no-properties (buffer-file-name))))
(defun racket--mode-edits-racket-p ()
"Return non-nil if the current major mode is one that edits Racket code.
This is intended to be used with commands that customize their
behavior based on whether they are editing Racket, such as
Paredit bindings, without each of those commands needing to have
a list of all modes in which Racket is edited."
(memq major-mode '(racket-mode racket-repl-mode)))
(defun racket--take-while (xs pred)
(pcase xs
(`() `())
(`(,x . ,xs) (if (funcall pred x)
(cons x (racket--take-while xs pred))
`()))))
;;; trace
(defvar racket--trace-enable nil)
(defun racket--trace (p &optional s retval)
(when racket--trace-enable
(let ((b (get-buffer-create "*Racket Trace*"))
(deactivate-mark deactivate-mark))
(save-excursion
(save-restriction
(with-current-buffer b
(insert p ": " (if (stringp s) s (format "%S" s)) "\n"))))))
retval)
(defun racket--toggle-trace (arg)
(interactive "P")
(setq racket--trace-enable (or arg (not racket--trace-enable)))
(if racket--trace-enable
(message "Racket trace on")
(message "Racket trace off"))
(let ((b (get-buffer-create "*Racket Trace*")))
(pop-to-buffer b t t)
(setq truncate-lines t)))
(provide 'racket-util)
;; racket-util.el ends here

213
elpa/racket-mode-20180609.1253/run.rkt Normal file
View File

@@ -0,0 +1,213 @@
#lang racket/base
(require racket/cmdline
racket/contract/base
racket/contract/region
racket/format
racket/match
racket/runtime-path
racket/pretty
"channel.rkt"
"cmds.rkt"
"error.rkt"
"gui.rkt"
"instrument.rkt"
"logger.rkt"
"mod.rkt"
"namespace.rkt"
"util.rkt")
(module+ main
(match (current-command-line-arguments)
[(vector port) (start-command-server (string->number port))
(start-logger-server (add1 (string->number port)))]
[v (displayln "Expected exactly one argument: command port")
(exit)])
;; 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 rerun-default)))
(define (run rr) ;rerun? -> void?
(match-define (rerun maybe-mod
mem-limit
pretty-print?
context-level
cmd-line-args) 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 (if (instrument-level? context-level)
(make-instrumented-eval-handler (current-eval))
(current-eval))]
[instrumenting-enabled (instrument-level? context-level)]
[profiling-enabled (eq? context-level 'profile)]
[test-coverage-enabled (eq? context-level 'coverage)]
;; 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))
;; 2. If module, require and enter its namespace, etc.
(when (and maybe-mod mod-path)
(parameterize ([current-module-name-resolver repl-module-name-resolver])
;; When exn:fail? during module load, re-run with "empty"
;; module. Note: Unlikely now that we're using
;; dynamic-require/some-namespace.
(with-handlers ([exn? (λ (x)
(display-exn x)
(put/stop (struct-copy rerun rr [maybe-mod #f])))])
(maybe-load-language-info mod-path) ;FIRST: see #281
(current-namespace (dynamic-require/some-namespace maybe-mod))
(maybe-warn-about-submodules mod-path context-level)
(check-top-interaction))))
;; 3. Tell command server to use our namespace and module.
(attach-command-server (current-namespace) maybe-mod)
;; 4. read-eval-print-loop
(parameterize ([current-prompt-read (make-prompt-read maybe-mod)]
[current-module-name-resolver repl-module-name-resolver])
;; 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 msg
(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 main-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 msg
[(? rerun? x) (run x)]
[(? load-gui?) (require-gui) (run rr)]))
(define (maybe-load-language-info path)
;; Load language-info (if any) and do configure-runtime.
;; Important for langs like Typed Racket.
(with-handlers ([exn:fail? void])
(define info (module->language-info path #t))
(when info
(define get-info ((dynamic-require (vector-ref info 0)
(vector-ref info 1))
(vector-ref info 2)))
(define configs (get-info 'configure-runtime '()))
(for ([config (in-list configs)])
((dynamic-require (vector-ref config 0)
(vector-ref config 1))
(vector-ref config 2))))
(define cr-submod `(submod ,@(match path
[(list 'submod sub-paths ...) sub-paths]
[_ (list 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 repl-module-name-resolver
(let ([orig-resolver (current-module-name-resolver)])
(case-lambda
[(rmp ns)
(orig-resolver rmp ns)]
[(mp rmp stx)
(repl-module-name-resolver mp rmp stx #t)]
[(mp rmp stx load?)
(when (and load? (memq mp '(racket/gui/base
racket/gui/dynamic
scheme/gui/base)))
(unless (gui-required?)
(put/stop (load-gui))))
(orig-resolver mp rmp stx load?)])))
;; 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-print-handler pretty-print?)
(cond [pretty-print? pretty-print-handler]
[else (make-plain-print-handler)]))
(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)]))))

176
elpa/racket-mode-20180609.1253/scribble.rkt Normal file
View File

@@ -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)]))

17
elpa/racket-mode-20180609.1253/try-catch.rkt Normal file
View File

@@ -0,0 +1,17 @@
#lang racket/base
(require (for-syntax racket/base
syntax/parse))
(provide try)
;; Some try/catch syntax. Because `with-handlers` can be
;; exceptionally bass-ackwards when nested (pun intended).
(define-syntax (try stx)
(define-splicing-syntax-class catch-clause
(pattern (~seq #:catch pred:expr id:id e:expr ...+)
#:with handler #'[pred (lambda (id) e ...)]))
(syntax-parse stx
[(_ body:expr ...+ catch:catch-clause ...+)
#'(with-handlers (catch.handler ...)
body ...)]))

26
elpa/racket-mode-20180609.1253/util.rkt Normal file
View File

@@ -0,0 +1,26 @@
#lang racket/base
(require (for-syntax racket/base
syntax/parse))
(provide display-commented
with-dynamic-requires
box-swap!)
(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 (box-swap! box f . args)
(let loop ()
(let* ([old (unbox box)]
[new (apply f old args)])
(if (box-cas! box old new)
new
(loop)))))