From aceb30275e3ffc7b0b688d87986e69991c8a7b85 Mon Sep 17 00:00:00 2001 From: Greg Hendershott Date: Mon, 3 Oct 2016 10:03:17 -0400 Subject: [PATCH] Command I/O via sockets Send commands and receive responses via sockets. Fixes #132. Fixes #203. Fixes #228. Uses some code from the old, stale `old-command-socket` branch. Also: - Some commands -- like profiling and test coverage -- need to racket-run, then issue a command to get results about the run. Provide a way for them to see if the REPL is waiting at the Racket prompt. - Make the previous point for racket-check-syntax-mode by simplifying it to supply a path. - Separate find and kill of requires. Wait to kill until we're ready to insert the new requires. This simplifies error recovery. Also it means something like `accept-process-output' won't make a new undo history point, so both our kill and insert will be in a single undo step. --- Reference.md | 35 +++--- channel.rkt | 8 +- cmds.rkt | 281 ++++++++++++++++++++++++++----------------- racket-collection.el | 4 +- racket-complete.el | 13 +- racket-custom.el | 14 +++ racket-edit.el | 192 ++++++++++++----------------- racket-make-doc.el | 5 +- racket-profile.el | 10 +- racket-repl.el | 154 +++++++++++++----------- racket-tests.el | 29 +++-- run.rkt | 11 +- util.rkt | 11 +- 13 files changed, 419 insertions(+), 348 deletions(-) diff --git a/Reference.md b/Reference.md index 32ba8340..2cd9a973 100644 --- a/Reference.md +++ b/Reference.md @@ -666,18 +666,6 @@ Macro expand again the previous expansion done by one of: - [`racket-expand-last-sexp`](#racket-expand-last-sexp) - [`racket-expand-again`](#racket-expand-again) -### racket-gui-macro-stepper -M-x racket-gui-macro-stepper - -Run the DrRacket GUI macro stepper. - -Runs on the active region, if any, else the entire buffer. - -EXPERIMENTAL: May be changed or removed. - -BUGGY: The first-ever invocation might not display a GUI window. -If so, try again. - # Variables > Note: You may also set these via Customize. @@ -687,6 +675,12 @@ If so, try again. ### racket-racket-program Pathname of the racket executable. +### racket-command-port +Port number for Racket REPL command server. + +### racket-command-timeout +Timeout for Racket REPL command server. + ### racket-raco-program Pathname of the raco executable. @@ -727,7 +721,15 @@ 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. -The value must be an unquoted list of strings such as: +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") @@ -736,13 +738,6 @@ but NOT: '("-f" "bar") (list "-f" "bar") -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: - ## REPL diff --git a/channel.rkt b/channel.rkt index 851e9d2b..b157694b 100644 --- a/channel.rkt +++ b/channel.rkt @@ -4,7 +4,7 @@ racket/contract "mod.rkt") -(provide the-channel +(provide main-channel (struct-out msg) (struct-out load-gui) (struct-out rerun) @@ -42,8 +42,8 @@ (define (profile/coverage-level? v) (memq? v profile/coverage-levels)) -;; Messages via a channel from the repl thread to the main thread. -(define the-channel (make-channel)) +;; 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] @@ -63,5 +63,5 @@ ;; 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 the-channel v) + (channel-put main-channel v) (void (sync never-evt))) diff --git a/cmds.rkt b/cmds.rkt index 2a9f2087..9ad348f7 100644 --- a/cmds.rkt +++ b/cmds.rkt @@ -4,14 +4,17 @@ macro-debugger/analysis/check-requires racket/contract/base racket/contract/region + racket/file 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" @@ -24,48 +27,93 @@ "try-catch.rkt" "util.rkt") -(provide make-prompt-read - current-command-output-file +(provide start-command-server + attach-command-server + make-prompt-read display-prompt) (module+ test (require rackunit)) -;; Commands intended for use programmatically by racket-mode may -;; output their results to a file whose name is the value of the -;; current-command-output-file parameter. This avoids mixing with -;; stdout and stderr, which ultimately is not very reliable. How does -;; racket-mode know when the file is ready to be read? 1. racket-mode -;; deletes the file, calls us, and waits for the file to exist. 2. We -;; direct the command's output to a temporary file (on the same fs), -;; then when the command has finished, rename the temp file to -;; current-command-output-file. This way, racket-mode knows that as -;; soon as the file exists again, the command is finished and its -;; output is ready to be read from the file. -(define current-command-output-file (make-parameter #f)) -(define (with-output-to-command-output-file f) - (cond [(current-command-output-file) - (define tmp-file (path-add-suffix (current-command-output-file) ".tmp")) - (with-output-to-file tmp-file #:exists 'replace f) - (rename-file-or-directory tmp-file (current-command-output-file) #t)] - [else (f)])) +;; 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 ((current-read-interaction) (object-name in) in)) + (define stx (dynamic-wind + (λ _ (box-swap! at-prompt add1)) + (λ _ ((current-read-interaction) (object-name in) in)) + (λ _ (box-swap! at-prompt sub1)))) (syntax-case stx () - ;; #,command redirect - [(uq cmd) - (eq? 'unsyntax (syntax-e #'uq)) - (begin (with-output-to-command-output-file - (λ () (handle-command #'cmd m))) - #'(void))] ;avoid Typed Racket printing a type - ;; ,command normal [(uq cmd) (eq? 'unquote (syntax-e #'uq)) - (begin (handle-command #'cmd m) + (begin (handle-command #'cmd m usage) #'(void))] ;avoid Typed Racket printing a type [_ stx])) @@ -74,8 +122,10 @@ (fresh-line) (display str) ;; Use a character unlikely to appear in normal output. Makes it - ;; easier for Emacs comint-regexp-prompt not to match program output - ;; by mistake. + ;; 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) @@ -83,47 +133,48 @@ (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.) + ;; 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) - (-> syntax? (or/c #f mod?) any) +(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))] - [(log) (log-display (map string->symbol (string-split (read-line))))] - [(pwd) (display-commented (~v (current-directory)))] - [(cd) (cd (~a (read)))] - [(exit) (exit)] - [(info) (info)] + [(run) (run-or-top 'run)] + [(top) (run-or-top 'top)] + [(doc) (doc (read-syntax))] + [(exp) (exp1 (read))] + [(exp+) (exp+)] + [(exp!) (exp! (read))] + [(log) (log-display (map string->symbol (string-split (read-line))))] + [(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 (and path (path->string path)))] - [(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))] + [(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 path)] - [else (usage)]))) + [(get-profile) (get-profile)] + [(get-uncovered) (get-uncovered path)] + [(check-syntax) (check-syntax (string->path (read)))] + [else (unknown-command)]))) (define (usage) (display-commented @@ -196,10 +247,10 @@ ['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-args (list->vector (or args (list)))) ;Elisp () = nil => #f (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) @@ -235,8 +286,7 @@ (displayln @~a{Memory Limit: @(current-mem) Pretty Print: @(current-pp?) Error Context: @(current-ctx-lvl) - Command Line: @(current-args) - Command Output: @(current-command-output-file)})) + Command Line: @(current-args)})) ;;; misc other commands @@ -310,7 +360,8 @@ ;; for Typed Racket type or a contract, if any. (define (describe stx) - (display (describe* stx))) + (write (describe* stx)) + (newline)) (define (describe* _stx) (define stx (namespace-syntax-introduce _stx)) @@ -332,6 +383,7 @@ [#t 't] [(? list? xs) (map ->elisp xs)] [(cons x y) (cons (->elisp x) (->elisp y))] + [(? path? v) (path->string v)] [v v])) (module+ test @@ -347,7 +399,9 @@ (λ () (find-help (namespace-syntax-introduce stx)))) [(pregexp "Sending to web browser") #t]) #:catch exn:fail? _ - (search-for (list (~a (syntax->datum stx)))))) + (search-for (list (~a (syntax->datum stx))))) + ;; Need some command response + (elisp-println "Sent to web browser")) (define (cd s) (let ([old-wd (current-directory)]) @@ -725,53 +779,54 @@ ;;; 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? _ (λ _ '()))]) + (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) - ;; Note: Adjust all positions to 1-based Emacs `point' values. - ;; 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))))) + (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)))))) diff --git a/racket-collection.el b/racket-collection.el index ce062f36..8c427c19 100644 --- a/racket-collection.el +++ b/racket-collection.el @@ -50,8 +50,8 @@ See also: `racket-visit-module' and `racket-open-require-path'." (interactive "P") (let ((coll (racket--symbol-at-point-or-prompt prefix "Collection name: "))) (when coll - (let ((paths (racket--repl-cmd/sexpr (format ",find-collection \"%s\"\n" - coll)))) + (let ((paths (racket--repl-command "find-collection \"%s\"" + coll))) (cond ((eq 'find-collection-not-installed paths) ;; FIXME? Offer to run this for them? (error "Run `raco pkg install raco-find-collection'")) diff --git a/racket-complete.el b/racket-complete.el index 55369436..5582143e 100644 --- a/racket-complete.el +++ b/racket-complete.el @@ -44,7 +44,7 @@ See `racket--invalidate-completion-cache' and (unless racket--namespace-symbols (if (racket--in-repl-or-its-file-p) (setq racket--namespace-symbols - (racket--repl-cmd/sexpr ",syms")) + (racket--repl-command "syms")) (error "Completions not available until you `racket-run' this buffer"))) racket--namespace-symbols) @@ -86,7 +86,7 @@ See `racket--invalidate-completion-cache' and (defun racket--get-def-file+line (sym) "Return a value suitable for use as :company-location." - (pcase (racket--repl-cmd/sexpr (format ",def %s\n\n" sym)) + (pcase (racket--repl-command "def %s" sym) (`(,path ,line ,_) (cons path line)) (_ nil))) @@ -108,7 +108,7 @@ See `racket--invalidate-completion-cache' and (v (gethash sym racket--type-cache))) (or v (and (racket--in-repl-or-its-file-p) - (let ((v (racket--repl-cmd/sexpr (concat ",type " str)))) + (let ((v (racket--repl-command (concat "type " str)))) (puthash sym v racket--type-cache) v))))) @@ -237,7 +237,7 @@ added) and nil for the latter. Returns the buffer in which the description was written." (let* ((bufname "*Racket Describe*") - (html (racket--repl-cmd/string (format ",describe %s" sym))) + (html (racket--repl-command "describe %s" sym)) ;; Emacs shr renderer removes leading   from elements ;; -- which messes up the indentation of s-expressions including ;; contracts. So replace   with `spc' in the source HTML, @@ -276,8 +276,9 @@ Returns the buffer in which the description was written." (insert-text-button "Documentation in Browser" 'action `(lambda (_btn) - (racket--repl-cmd/buffer - ,(substring-no-properties (format ",doc %s\n" sym))))) + (racket--repl-command + "doc %s" + ,(substring-no-properties (format "%s" sym))))) (insert " [q]uit")) (read-only-mode 1) (goto-char (point-min)) diff --git a/racket-custom.el b/racket-custom.el index ac484d44..09bc3913 100644 --- a/racket-custom.el +++ b/racket-custom.el @@ -43,6 +43,20 @@ :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 3 + "Timeout for Racket REPL command server." + :tag "Command Timeout" + :type 'integer + :risky t + :group 'racket) + (defcustom racket-raco-program (cond (racket--winp "Raco.exe") (t "raco")) "Pathname of the raco executable." diff --git a/racket-edit.el b/racket-edit.el index 31c236d8..b95b9b15 100644 --- a/racket-edit.el +++ b/racket-edit.el @@ -111,7 +111,15 @@ it can be a menu target." Accessible in your Racket program in the usual way -- the parameter `current-command-line-arguments` and friends. -The value must be an unquoted list of strings such as: +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\") @@ -119,13 +127,6 @@ but NOT: '(\"-f\" \"bar\") (list \"-f\" \"bar\") - -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: ") (defun racket--do-run (context-level &optional what-to-run) @@ -145,12 +146,12 @@ of a file name to a list of submodule symbols. Otherwise, the (remove-overlays (point-min) (point-max) 'racket-uncovered-overlay) (racket--invalidate-completion-cache) (racket--invalidate-type-cache) - (racket--repl-eval (format ",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))) + (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))) @@ -226,10 +227,13 @@ See also: "Running tests...")) (racket--do-run (if coverage 'coverage racket-error-context) (list 'submod (racket--buffer-file-name) 'test)) + (message "Waiting for Racket prompt...") + (while (not (racket--repl-command "prompt")) + (sit-for 0.5)) (if (not coverage) (message "Tests done.") (message "Checking coverage results...") - (let ((xs (racket--repl-cmd/sexpr ",get-uncovered"))) + (let ((xs (racket--repl-command "get-uncovered"))) (dolist (x xs) (let ((beg (car x)) (end (cdr x))) @@ -290,7 +294,7 @@ will tell you so but won't visit the definition site." (defun racket--do-visit-def-or-mod (cmd sym) "CMD must be \"def\" or \"mod\". SYM must be `symbolp`." - (pcase (racket--repl-cmd/sexpr (format ",%s %s\n\n" cmd sym)) + (pcase (racket--repl-command "%s %s" cmd sym) (`(,path ,line ,col) (racket--push-loc) (find-file path) @@ -340,7 +344,7 @@ instead of looking at point." (let ((sym (racket--identifier-at-point-or-prompt prefix "Racket help for: "))) (when sym - (racket--repl-cmd/string (format ",doc %s" sym))))) + (racket--repl-command "doc %s" sym)))) (defvar racket--loc-stack '()) @@ -435,31 +439,6 @@ Otherwise, expands once. You may use `racket-expand-again'." (interactive) (comint-send-string (racket--get-repl-buffer-process) ",exp+\n")) -(defun racket-gui-macro-stepper () - "Run the DrRacket GUI macro stepper. - -Runs on the active region, if any, else the entire buffer. - -EXPERIMENTAL: May be changed or removed. - -BUGGY: The first-ever invocation might not display a GUI window. -If so, try again." - (interactive) - (save-buffer) - (racket--repl-eval - (format "%S\n" - `(begin - (require macro-debugger/stepper racket/port) - ,(if (region-active-p) - `(expand/step - (with-input-from-string ,(buffer-substring-no-properties - (region-beginning) - (region-end)) - read-syntax)) - `(expand-module/step - (string->path - ,(racket--buffer-file-name)))))))) - ;;; requires @@ -489,15 +468,12 @@ file using `#lang`. It does *not* work for `require`s inside See also: `racket-trim-requires' and `racket-base-requires'." (interactive) - (let* ((result (racket--kill-top-level-requires)) - (beg (nth 0 result)) - (reqs (nth 1 result)) - (new (and beg reqs - (racket--repl-cmd/string - (format ",requires/tidy %S" reqs))))) - (when new - (goto-char beg) - (insert (concat (read new) "\n"))))) + (let* ((reqs (racket--top-level-requires 'find)) + (new (and reqs + (racket--repl-command "requires/tidy %S" reqs)))) + (when (not (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. @@ -512,20 +488,16 @@ file using `#lang`. It does *not* work for `require`s inside See also: `racket-base-requires'." (interactive) (when (buffer-modified-p) (save-buffer)) - (let* ((result (racket--kill-top-level-requires)) - (beg (nth 0 result)) - (reqs (nth 1 result)) - (new (and beg reqs - (racket--repl-cmd/string - (format ",requires/trim \"%s\" %S" - (racket--buffer-file-name) - reqs)))) - (new (and new - (condition-case () (read new) - (error (revert-buffer t t t) ;restore original requires - (error "Can't do, source file has error")))))) - (when new - (goto-char beg) + (let* ((reqs (racket--top-level-requires 'find)) + (new (and reqs + (racket--repl-command + "requires/trim \"%s\" %S" + (racket--buffer-file-name) + reqs)))) + (when (not new) + (error "Can't do, source file has error")) + (goto-char (racket--top-level-requires 'kill)) + (when (not (string-equal "" new)) (insert (concat new "\n"))))) (defun racket-base-requires () @@ -557,51 +529,35 @@ such as changing `#lang typed/racket` to `#lang typed/racket/base`." (unless (racket--buffer-start-re "^#lang.*? racket$") (error "File does not use use #lang racket. Cannot change.")) (when (buffer-modified-p) (save-buffer)) - (let* ((result (racket--kill-top-level-requires)) - (beg (or (nth 0 result) - (save-excursion - (goto-char 0) (forward-line 1) (insert "\n") (point)))) - (reqs (nth 1 result)) - (new (racket--repl-cmd/string - (format ",requires/base \"%s\" %S" - (racket--buffer-file-name) - reqs))) - (new (and new - (condition-case () (read new) - (error (revert-buffer t t t) ;restore original requires - (error "Can't do, source file has error")))))) - (when new - (goto-char beg) - (insert (concat new "\n"))) + (let* ((reqs (racket--top-level-requires 'find)) + (new (racket--repl-command + "requires/base \"%s\" %S" + (racket--buffer-file-name) + reqs))) + (when (not new) + (error "Source file has error")) (goto-char (point-min)) (re-search-forward "^#lang.*? racket$") - (insert "/base"))) + (insert "/base") + (goto-char (or (racket--top-level-requires 'kill) + (progn (insert "\n") (point)))) + (when (not (string= "" new)) + (insert (concat new "\n"))))) (defun racket--buffer-start-re (re) (save-excursion - (condition-case () - (progn - (goto-char (point-min)) - (re-search-forward re) - t) - (error nil)))) - -(defun racket--kill-top-level-requires () - "Delete all top-level `require`s. Return list with two results: + (ignore-errors + (goto-char (point-min)) + (re-search-forward re) + t))) -The first element is point where the first require was found, or -nil. +(defun racket--top-level-requires (what) + "Identify all top-level requires and do WHAT. -The second element is a list of require s-expressions found. +When WHAT is 'find, returns the top-level require forms. -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: It might work better to shift this work into Racket code, -and have it return a list of file offsets and replacements. Doing -so would make it easier to match require forms syntactically -instead of textually, and handle module and submodule 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) @@ -613,9 +569,10 @@ instead of textually, and handle module and submodule forms." (sexpr (read str))) (unless first-beg (setq first-beg beg)) (setq requires (cons sexpr requires)) - (kill-sexp -1) - (delete-blank-lines))) - (list first-beg requires)))) + (when (eq 'kill what) + (kill-sexp -1) + (delete-blank-lines)))) + (if (eq 'kill what) first-beg requires)))) ;;; racket-check-syntax @@ -775,26 +732,33 @@ special commands to navigate among the definition and its uses. " :lighter " CheckSyntax" :keymap (racket--easy-keymap-define - '(("q" racket-check-syntax-mode-quit) - ("h" racket-check-syntax-mode-help) + '(("q" racket-check-syntax-mode-quit) + ("h" racket-check-syntax-mode-help) (("j" "TAB") racket-check-syntax-mode-goto-next-def) (("k" "") 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))) + ("." 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) - (error "racket-check-syntax-mode only works with racket-mode")) + (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 () - (racket-run) ;ensure REPL is evaluating this buffer (message "Analyzing...") - (let ((xs (racket--repl-cmd/sexpr (format ",check-syntax\n\n") 30))) + (let ((xs (let ((racket-command-timeout racket--check-syntax-start-timeout)) + (racket--repl-command "check-syntax \"%s\"" + (buffer-file-name))))) (unless xs + (racket-check-syntax-mode 0) + (user-error "No bindings found")) + (unless (listp xs) + (racket-check-syntax-mode 0) (error "Requires a newer version of Racket.")) (with-silent-modifications (dolist (x xs) diff --git a/racket-make-doc.el b/racket-make-doc.el index 9522a0cd..18972d85 100644 --- a/racket-make-doc.el +++ b/racket-make-doc.el @@ -89,8 +89,7 @@ racket-expand-region racket-expand-definition racket-expand-last-sexp - racket-expand-again - racket-gui-macro-stepper) + racket-expand-again) "Commands to include in the Reference.") (defun racket-make-doc/commands () @@ -139,6 +138,8 @@ (defconst racket-make-doc/variables '("General" racket-racket-program + racket-command-port + racket-command-timeout racket-raco-program racket-memory-limit racket-error-context diff --git a/racket-profile.el b/racket-profile.el index 72ae7daa..025dca45 100644 --- a/racket-profile.el +++ b/racket-profile.el @@ -42,9 +42,13 @@ 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 and getting results...") + (message "Running with profiling instrumentation...") (racket--do-run 'profile) - (setq racket--profile-results (racket--repl-cmd/sexpr ",get-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) @@ -54,7 +58,7 @@ delete compiled/*.zo files." (defun racket--profile-refresh () (interactive) - (setq racket--profile-results (racket--repl-cmd/sexpr ",get-profile")) + (setq racket--profile-results (racket--repl-command "get-profile")) (racket--profile-draw)) (defun racket--profile-draw () diff --git a/racket-repl.el b/racket-repl.el index 19b5f569..ab396b53 100644 --- a/racket-repl.el +++ b/racket-repl.el @@ -108,10 +108,6 @@ be able to load at all.") (racket--buffer-file-name)))) "Path to run.rkt") -(defvar racket--repl-command-output-file - (make-temp-file "racket-mode-command-ouput-file-") - "File used to collect output from commands used by racket-mode.") - (defun racket--repl-live-p () "Does the Racket REPL buffer exist and have a live Racket process?" (comint-check-proc racket--repl-buffer-name)) @@ -130,11 +126,12 @@ Never changes selected window." (display-buffer racket--repl-buffer-name)) (racket--require-version racket--minimum-required-version) (with-current-buffer - (make-comint racket--repl-buffer-name/raw ;w/o *stars* - racket-racket-program - nil - racket--run.rkt - racket--repl-command-output-file) + (with-temp-message "Starting Racket process..." + (make-comint racket--repl-buffer-name/raw ;w/o *stars* + racket-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))) @@ -143,18 +140,20 @@ Never changes selected window." ;; 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-mode) + (racket--repl-command-connect)))) (defun racket--version () "Get the `racket-racket-program' version as a string." - (with-temp-buffer - (call-process racket-racket-program - nil ;infile: none - t ;destination: current-buffer - nil ;redisplay: no - "-e" - "(version)") - (eval (read (buffer-substring (point-min) (point-max)))))) + (with-temp-message "Checking Racket version..." + (with-temp-buffer + (call-process racket-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." @@ -164,13 +163,75 @@ Never changes selected window." 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 server. +If already connected, disconnects then connects again." + (racket--repl-command-disconnect) + (with-temp-message "Connecting to command server..." + ;; 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 server")) + (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 server. " + (when racket--repl-command-process + (with-temp-message "Deleting existing connection to command server..." + (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 server 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 server 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 + (goto-char (point-min)) + (forward-list 1) + 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." (when (comint-check-proc racket--repl-buffer-name) - (racket--repl-cmd/sexpr ",path"))) + (racket--repl-command "path"))) (defun racket--in-repl-or-its-file-p () "Is current-buffer `racket-repl-mode' or buffer for file active in it?" @@ -203,63 +264,16 @@ most recent `racket-mode' buffer, if any." (and (eq major-mode 'racket-mode) b))) (buffer-list))) -(defun racket--repl-eval (expression) - "Eval EXPRESSION in the *Racket REPL* buffer. +(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) expression) + (comint-send-string (racket--get-repl-buffer-process) + (apply #'format (cons fmt vs))) (racket--repl-show-and-move-to-end)) -(defconst racket--repl-command-timeout 10 - "Default timeout when none supplied to `racket--repl-cmd/buffer' and friends.") - -(defun racket--repl-cmd/buffer (command &optional timeout) - "Send COMMAND capturing its input in the returned buffer. - -Expects COMMAND to already include the comma/unquote prefix: `,command`. - -Prepends a `#` to make it `#,command`. This causes output to be -redirected to `racket--repl-command-output-file'. When that file -comes into existence, the command has completed and we read its -contents into a buffer." - (let* ((deadline (+ (float-time) (or timeout racket--repl-command-timeout))) - (update-interval 0.5) - (pr (make-progress-reporter "Waiting for Racket..." - nil nil nil nil update-interval))) - (progress-reporter-update pr) - (racket--repl-ensure-buffer-and-process) - (progress-reporter-update pr) - (when (file-exists-p racket--repl-command-output-file) - (delete-file racket--repl-command-output-file)) - (comint-send-string (racket--get-repl-buffer-process) - (concat "#" command "\n")) ;e.g. #,command - (while (and (not (file-exists-p racket--repl-command-output-file)) - (< (float-time) deadline)) - (progress-reporter-update pr) - (accept-process-output (get-buffer-process racket--repl-buffer-name) - update-interval) - (sit-for 0)) ;let REPL output be drawn - (unless (file-exists-p racket--repl-command-output-file) - (error "Racket did not respond in time")) - (let ((buf (get-buffer-create " *Racket Command Output*"))) - (with-current-buffer buf - (progress-reporter-update pr) - (erase-buffer) - (insert-file-contents racket--repl-command-output-file) - (progress-reporter-update pr) - (delete-file racket--repl-command-output-file) - (message "")) ;instead of (progress-reporter-done pr) - buf))) - -(defun racket--repl-cmd/string (command &optional timeout) - (with-current-buffer (racket--repl-cmd/buffer command timeout) - (buffer-substring (point-min) (point-max)))) - -(defun racket--repl-cmd/sexpr (command &optional timeout) - (eval (read (racket--repl-cmd/string command timeout)))) - ;;; send to REPL (defun racket--send-region-to-repl (start end) diff --git a/racket-tests.el b/racket-tests.el index c077035c..5f228184 100644 --- a/racket-tests.el +++ b/racket-tests.el @@ -15,6 +15,7 @@ (require 'ert) (require 'racket-mode) (require 'racket-repl) +(require 'racket-edit) (require 'edmacro) (require 'faceup) (require 'racket-common) @@ -63,7 +64,10 @@ "Start REPL. Confirm we get Welcome message and prompt. Exit REPL." (racket-repl) (with-racket-repl-buffer - (let ((tab-always-indent 'complete)) + (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> ")))) @@ -86,7 +90,10 @@ ;;; Run (ert-deftest racket-tests/run () - (let* ((pathname (make-temp-file "test" nil ".rkt")) + (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) @@ -96,13 +103,17 @@ (with-racket-repl-buffer (should (racket-tests/see (concat "\n" name "\uFEFF> ")))) ;; racket-check-syntax-mode - (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) + (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")) diff --git a/run.rkt b/run.rkt index 469aa944..bdf99069 100644 --- a/run.rkt +++ b/run.rkt @@ -18,8 +18,9 @@ (module+ main (match (current-command-line-arguments) - [(vector file) (current-command-output-file file)] - [v (error "Expected exactly one command-line argument for command output file\ngiven:" v)]) + [(vector port) (start-command-server (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)) @@ -97,7 +98,9 @@ (dynamic-require mod-path #f) (current-namespace (module->namespace mod-path)) (check-top-interaction)))) - ;; 4. read-eval-print-loop + ;; 4. Tell command server to use our namespace and module. + (attach-command-server (current-namespace) maybe-mod) + ;; 5. 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 @@ -120,7 +123,7 @@ [(and (or (? exn:break:terminate?) (? exn:break:hang-up?)) e) e] [(exn:break msg marks continue) (break-thread repl-thread) (continue)] [e e]) - (λ () (sync the-channel)))) + (λ () (sync main-channel)))) (match context-level ['profile (clear-profile-info!)] ['coverage (clear-test-coverage-info!)] diff --git a/util.rkt b/util.rkt index a3462faa..eb9dae18 100644 --- a/util.rkt +++ b/util.rkt @@ -4,7 +4,8 @@ syntax/parse)) (provide display-commented - with-dynamic-requires) + with-dynamic-requires + box-swap!) (define (display-commented str) (eprintf "; ~a\n" @@ -15,3 +16,11 @@ [(_ ([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)))))