Update packages
This commit is contained in:
Mateus Pinto Rodrigues
81
elpa/racket-mode-20181004.309/racket-bug-report.el
Normal file
81
elpa/racket-mode-20181004.309/racket-bug-report.el
Normal file
@@ -0,0 +1,81 @@
|
||||
;;; 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)
|
||||
|
||||
;;;###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--el-source-dir
|
||||
racket--rkt-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
|
||||
320
elpa/racket-mode-20181004.309/racket-collection.el
Normal file
320
elpa/racket-mode-20181004.309/racket-collection.el
Normal file
@@ -0,0 +1,320 @@
|
||||
;;; 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--cmd/await `(find-collection ,coll))
|
||||
(`()
|
||||
(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))))
|
||||
|
||||
(defun racket--orp/begin ()
|
||||
(let ((proc (start-process "racket-find-module-path-completions-process"
|
||||
"*racket-find-module-path-completions*"
|
||||
racket-program
|
||||
(expand-file-name "find-module-path-completions.rkt"
|
||||
racket--rkt-source-dir))))
|
||||
(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
|
||||
778
elpa/racket-mode-20181004.309/racket-common.el
Normal file
778
elpa/racket-mode-20181004.309/racket-common.el
Normal file
@@ -0,0 +1,778 @@
|
||||
;;; 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))))
|
||||
|
||||
|
||||
;;; racket--what-to-run
|
||||
|
||||
(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 (point-min))
|
||||
(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")
|
||||
" "))))
|
||||
|
||||
;;; 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
|
||||
308
elpa/racket-mode-20181004.309/racket-complete.el
Normal file
308
elpa/racket-mode-20181004.309/racket-complete.el
Normal file
@@ -0,0 +1,308 @@
|
||||
;;; racket-complete.el -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (c) 2013-2018 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 'racket-keywords-and-builtins)
|
||||
(require 'shr)
|
||||
(require 's)
|
||||
(declare-function racket--do-visit-def-or-mod "racket-edit.el")
|
||||
|
||||
;;; namespace symbols i.e. completion candidates
|
||||
|
||||
(defvar-local 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.
|
||||
|
||||
`racket-run' should call `racket--invalidate-completion-cache'.
|
||||
|
||||
See `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)))
|
||||
|
||||
(add-hook 'racket--repl-before-run-hook #'racket--invalidate-completion-cache)
|
||||
|
||||
(defun racket--completion-candidates ()
|
||||
"Completion candidates, as a list of list of strings.
|
||||
Gets from the cache, or if nil from the Racket process, or if
|
||||
that's not running from the `defconst' lists of strings we use
|
||||
for font-lock. To support the last case -- while avoiding
|
||||
`append' and allocation of such large lists of strings -- is why
|
||||
we always return a list of list of strings."
|
||||
(unless racket--namespace-symbols
|
||||
(when (racket--in-repl-or-its-file-p)
|
||||
(setq racket--namespace-symbols
|
||||
(list (racket--cmd/await '(syms))))))
|
||||
(or racket--namespace-symbols
|
||||
(list racket-type-list
|
||||
racket-keywords
|
||||
racket-builtins-1-of-2
|
||||
racket-builtins-2-of-2)))
|
||||
|
||||
(defun racket--completion-candidates-for-prefix (prefix)
|
||||
(cl-reduce (lambda (results strs)
|
||||
(append results (all-completions prefix strs)))
|
||||
(racket--completion-candidates)
|
||||
:initial-value ()))
|
||||
|
||||
(defun racket-complete-at-point (&optional _predicate)
|
||||
"Default value for the variable `completion-at-point-functions'.
|
||||
|
||||
Completion candidates are drawn from the namespace symbols
|
||||
resulting from the most recent `racket-run' of each .rkt file. If
|
||||
a file has never been run, candidates default to values also used
|
||||
for font-lock -- an assortment of symbols from common Racket
|
||||
modules such as `racket`, `typed/racket`, and `syntax/parse`.
|
||||
|
||||
Returns extra :company-doc-buffer and :company-location
|
||||
properties for use by the `company-mode' backend `company-capf'
|
||||
-- but not :company-docsig, because it is frequently impossible
|
||||
to supply this quickly enough or at all."
|
||||
(let ((beg (save-excursion (skip-syntax-backward "^-()>") (point))))
|
||||
(unless (or (eq beg (point-max))
|
||||
(member (char-syntax (char-after beg)) '(?\" ?\( ?\))))
|
||||
(condition-case nil
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(forward-sexp 1)
|
||||
(let ((end (point)))
|
||||
(and
|
||||
(<= (+ beg 2) end) ;prefix at least 2 chars
|
||||
(list beg
|
||||
end
|
||||
(completion-table-dynamic
|
||||
#'racket--completion-candidates-for-prefix)
|
||||
:predicate #'identity
|
||||
;; racket--get-type is too slow for :company-docsig
|
||||
:company-doc-buffer #'racket--do-describe
|
||||
:company-location #'racket--get-def-file+line))))
|
||||
(scan-error nil)))))
|
||||
|
||||
(defun racket--get-def-file+line (sym)
|
||||
"Return a value suitable for use as :company-location."
|
||||
(pcase (racket--cmd/await `(def ,sym))
|
||||
(`(,path ,line ,_) (cons path line))
|
||||
(_ nil)))
|
||||
|
||||
;;; "types" (i.e. TR types, contracts, and/or function signatures)
|
||||
|
||||
(defvar-local racket--type-cache (make-hash-table :test #'eq)
|
||||
"Memoize \",type\" commands in Racket REPL.
|
||||
|
||||
This var is local to each buffer, including the REPL buffer.
|
||||
|
||||
`racket-run' should call `racket-invalidate-type-cache'.")
|
||||
|
||||
(defun racket--invalidate-type-cache ()
|
||||
"Both current `racket-mode' buffer and `racket-repl-mode' buffer (if any)."
|
||||
(setq racket--type-cache (make-hash-table :test #'eq))
|
||||
(with-racket-repl-buffer
|
||||
(setq racket--type-cache (make-hash-table :test #'eq))))
|
||||
|
||||
(add-hook 'racket--repl-before-run-hook #'racket--invalidate-type-cache)
|
||||
|
||||
(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--cmd/await `(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'. Returns `stringp' not
|
||||
`symbolp' to simplify using the result in a sexpr that can be
|
||||
passed to Racket backend. Likewise text properties are stripped."
|
||||
(let ((sap (racket--thing-at-point 'symbol t)))
|
||||
(if (or force-prompt-p (not sap))
|
||||
(let ((s (read-from-minibuffer prompt sap)))
|
||||
(if (equal "" (s-trim s))
|
||||
nil
|
||||
s))
|
||||
sap)))
|
||||
|
||||
;;; 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 contract or a Typed Racket type, 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")
|
||||
(pcase (racket--symbol-at-point-or-prompt prefix "Describe: ")
|
||||
(`nil nil)
|
||||
(str (racket--do-describe str t))))
|
||||
|
||||
(defun racket--do-describe (str &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--cmd/await `(describe ,str)))
|
||||
;; Emacs shr renderer removes leading from <td> elements
|
||||
;; -- which messes up the indentation of s-expressions including
|
||||
;; contracts. So replace   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 " " 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 "\n")
|
||||
(insert-text-button "Definition"
|
||||
'action
|
||||
(lambda (_btn)
|
||||
(racket--do-visit-def-or-mod 'def str)))
|
||||
(insert " ")
|
||||
(insert-text-button "Documentation in Browser"
|
||||
'action
|
||||
(lambda (_btn)
|
||||
(racket--cmd/await `(doc ,str))))
|
||||
(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
|
||||
359
elpa/racket-mode-20181004.309/racket-custom.el
Normal file
359
elpa/racket-mode-20181004.309/racket-custom.el
Normal file
@@ -0,0 +1,359 @@
|
||||
;;; racket-custom.el
|
||||
|
||||
;; Copyright (c) 2013-2018 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)
|
||||
|
||||
(defcustom racket-use-repl-submit-predicate nil
|
||||
"Should `racket-repl-submit' use a drracket:submit-predicate? A
|
||||
language can provide such a predicate, for example when the
|
||||
language syntax is not s-expressions. When t `racket-repl-submit'
|
||||
will use this to decide whether to submit your input, yet."
|
||||
:tag "Use REPL Submit Predicate"
|
||||
: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")
|
||||
|
||||
(defface-racket racket-debug-break-face
|
||||
'((t (:background "red")))
|
||||
"Face for `racket-debug-mode' break position."
|
||||
"Racket Debug Break Face")
|
||||
|
||||
(defface-racket racket-debug-locals-face
|
||||
'((t (:inherit racket-selfeval-face :box (:line-width -1) :slant italic)))
|
||||
"Face for `racket-debug-mode' local variables."
|
||||
"Racket Debug Locals Face")
|
||||
|
||||
(defface-racket racket-debug-result-face
|
||||
'((t (:inherit racket-selfeval-face :box (:line-width -1) :slant italic :weight bold)))
|
||||
"Face for `racket-debug-mode' result values."
|
||||
"Racket Debug Result Face")
|
||||
|
||||
(provide 'racket-custom)
|
||||
|
||||
;; racket-custom.el ends here
|
||||
319
elpa/racket-mode-20181004.309/racket-debug.el
Normal file
319
elpa/racket-mode-20181004.309/racket-debug.el
Normal file
@@ -0,0 +1,319 @@
|
||||
;;; racket-debug.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (c) 2018 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 'racket-repl)
|
||||
(require 'easymenu)
|
||||
(require 'cl-lib)
|
||||
(require 'rx)
|
||||
|
||||
(defun racket-project-files (file-to-run)
|
||||
"A suitable value for the variable `racket-debuggable-files'.
|
||||
When projectile is installed and we're in a project, return all
|
||||
its Racket files. Else return all Racket files in the same
|
||||
directory as `file-to-run'. In all cases, include `file-to-run'.
|
||||
In all cases, return absolute path names."
|
||||
(cons
|
||||
file-to-run
|
||||
(or
|
||||
(ignore-errors
|
||||
(require 'projectile)
|
||||
(when (and (fboundp 'projectile-project-root)
|
||||
(fboundp 'projectile-dir-files))
|
||||
(let ((root (projectile-project-root)))
|
||||
(mapcar (lambda (v)
|
||||
(expand-file-name v root))
|
||||
(cl-remove-if-not (lambda (v)
|
||||
(and (member (file-name-extension v)
|
||||
'("rkt" "ss" "scm" "scrbl"))
|
||||
v))
|
||||
(projectile-dir-files root))))))
|
||||
(directory-files (file-name-directory file-to-run)
|
||||
t
|
||||
(rx "." (or "rkt" "ss" "scm" "scrbl") eos)))))
|
||||
|
||||
(defvar racket-debuggable-files #'racket-project-files
|
||||
"Used to tell `racket-run' what files may be instrumented for debugging.
|
||||
Must be a list of strings that are pathnames, such as from
|
||||
`racket--buffer-file-name', -or-, a function that returns such a
|
||||
list given the pathname of the file being run. If any path
|
||||
strings are relative, they are made absolute using
|
||||
`expand-file-name' with the directory of the file being run. The
|
||||
symbol 'run-file may be supplied in the list; it will be replaced
|
||||
with the pathname of the file being run. Safe to set as a
|
||||
file-local variable.")
|
||||
|
||||
(defun racket--debuggable-files (file-to-run)
|
||||
"Do the work described in doc str for variable `racket-debuggable-files'."
|
||||
(cl-labels ((err (&rest args)
|
||||
(user-error (concat "racket-debuggable-files: must be "
|
||||
(apply #'format args)))))
|
||||
(let* ((dir (file-name-directory file-to-run))
|
||||
(xs (if (functionp racket-debuggable-files)
|
||||
(funcall racket-debuggable-files file-to-run)
|
||||
racket-debuggable-files))
|
||||
(xs (if (listp xs) xs (err "a list but is `%S'" xs)))
|
||||
(xs (mapcar
|
||||
(lambda (v)
|
||||
(pcase v
|
||||
(`run-file file-to-run)
|
||||
((pred stringp) (expand-file-name v dir))
|
||||
(_ (err "string or 'run-file but is `%S' in `%S'"
|
||||
v xs))))
|
||||
xs)))
|
||||
xs)))
|
||||
|
||||
(defvar racket--debug-break-positions nil)
|
||||
(defvar racket--debug-break-locals nil)
|
||||
(defvar racket--debug-break-info nil)
|
||||
;; (U nil (cons break-id
|
||||
;; (U (list 'before)
|
||||
;; (list 'after string-of-racket-write-values))))
|
||||
|
||||
;;;###autoload
|
||||
(defun racket--debug-send-definition (beg end)
|
||||
(racket--cmd/async
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(list 'debug-eval
|
||||
(racket--buffer-file-name)
|
||||
(line-number-at-pos)
|
||||
(current-column)
|
||||
(point)
|
||||
(buffer-substring-no-properties (point) end)))
|
||||
(lambda (_)
|
||||
;; TODO: Also set fringe, and/or set marker on function
|
||||
;; name to show it's debuggable.
|
||||
(message "Now you can call the function in the REPL to step debug it."))) )
|
||||
|
||||
;;;###autoload
|
||||
(defun racket--debug-on-break (response)
|
||||
(pcase response
|
||||
(`((,src . ,pos) ,positions ,locals ,vals)
|
||||
(pcase (find-buffer-visiting src)
|
||||
(`nil (other-window 1) (find-file src))
|
||||
(buf (pop-to-buffer buf)))
|
||||
(goto-char pos)
|
||||
(pcase vals
|
||||
(`(,_id before) (message "Break before expression"))
|
||||
(`(,_id after ,s) (message "Break after expression: (values %s" (substring s 1))))
|
||||
(setq racket--debug-break-positions positions)
|
||||
(setq racket--debug-break-locals locals)
|
||||
(setq racket--debug-break-info vals)
|
||||
(racket-debug-mode 1))))
|
||||
|
||||
(defun racket--debug-resume (next-break value-prompt-p)
|
||||
(unless racket--debug-break-info (user-error "Not debugging"))
|
||||
(let ((info (if value-prompt-p
|
||||
(racket--debug-prompt-for-new-values)
|
||||
racket--debug-break-info)))
|
||||
(racket--cmd/async `(debug-resume (,next-break ,info))))
|
||||
(racket-debug-mode -1)
|
||||
(setq racket--debug-break-positions nil)
|
||||
(setq racket--debug-break-locals nil)
|
||||
(setq racket--debug-break-info nil))
|
||||
|
||||
(defun racket--debug-prompt-for-new-values ()
|
||||
(pcase racket--debug-break-info
|
||||
(`(,id before)
|
||||
(pcase (read-from-minibuffer "Skip step, substituting values: " "()")
|
||||
((or `nil "" "()") `(,id before))
|
||||
(str `(,id before ,str))))
|
||||
(`(,id after ,orig)
|
||||
(pcase (read-from-minibuffer "Step, replacing result values: " orig)
|
||||
((or `nil "" "()") `(,id after ,orig))
|
||||
(new `(,id after ,new))))))
|
||||
|
||||
(defun racket-debug-step (&optional prefix)
|
||||
"Resume to next breakable position. With prefix, substitute values."
|
||||
(interactive "P")
|
||||
(racket--debug-resume 'all prefix))
|
||||
|
||||
(defun racket-debug-step-over (&optional prefix)
|
||||
"Resume over next expression. With prefix, substitute values."
|
||||
(interactive "P")
|
||||
(racket--debug-resume 'over prefix))
|
||||
|
||||
(defun racket-debug-step-out (&optional prefix)
|
||||
"Resume out. With prefix, substitute values."
|
||||
(interactive "P")
|
||||
(racket--debug-resume 'out prefix))
|
||||
|
||||
(defun racket-debug-continue (&optional prefix)
|
||||
"Resume; don't break anymore. With prefix, substitute values."
|
||||
(interactive "P")
|
||||
(racket--debug-resume 'none prefix))
|
||||
|
||||
(defun racket-debug-run-to-here (&optional prefix)
|
||||
"Resume until point (if possible). With prefix, substitute values."
|
||||
(interactive)
|
||||
(racket--debug-resume (cons (racket--buffer-file-name) (point)) prefix))
|
||||
|
||||
(defun racket-debug-next-breakable ()
|
||||
"Move point to next breakable position."
|
||||
(interactive)
|
||||
(racket--debug-goto-breakable t))
|
||||
|
||||
(defun racket-debug-prev-breakable ()
|
||||
"Move point to previous breakable position."
|
||||
(interactive)
|
||||
(racket--debug-goto-breakable nil))
|
||||
|
||||
(defun racket--debug-goto-breakable (forwardp)
|
||||
(pcase (assoc (racket--buffer-file-name) racket--debug-break-positions)
|
||||
(`(,_src . ,ps)
|
||||
(let ((ps (if forwardp ps (reverse ps)))
|
||||
(pred (apply-partially (if forwardp #'< #'>) (point))))
|
||||
(goto-char (pcase (cl-find-if pred ps)
|
||||
(`nil (car ps))
|
||||
(v v)))))
|
||||
(_ (user-error "No breakable positions in this buffer"))))
|
||||
|
||||
(defun racket-debug-disable ()
|
||||
(interactive)
|
||||
(racket--cmd/async `(debug-disable))
|
||||
(racket-debug-mode -1)
|
||||
(setq racket--debug-break-positions nil)
|
||||
(setq racket--debug-break-locals nil)
|
||||
(setq racket--debug-break-info nil))
|
||||
|
||||
(add-hook 'racket--repl-before-run-hook #'racket-debug-disable)
|
||||
|
||||
(defun racket-debug-help ()
|
||||
(interactive)
|
||||
(describe-function 'racket-debug-mode))
|
||||
|
||||
(defvar racket--debug-overlays nil)
|
||||
|
||||
(define-minor-mode racket-debug-mode
|
||||
"Minor mode for debug breaks.
|
||||
|
||||
> This feature is **EXPERIMENTAL**!!! It is likely to have
|
||||
> significant limitations and bugs. You are welcome to open an
|
||||
> issue to provide feedback. Please understand that this feature
|
||||
> might never be improved -- it might even be removed someday if
|
||||
> it turns out to have too little value and/or too much cost.
|
||||
|
||||
How to debug:
|
||||
|
||||
1. \"Instrument\" code for step debugging. You can instrument
|
||||
entire files, and also individual functions.
|
||||
|
||||
a. Entire Files
|
||||
|
||||
Choose `racket-run' with two prefixes -- C-u C-u C-c C-c. The
|
||||
file will be instrumented for step debugging before it is run.
|
||||
Also instrumented are files determined by the variable
|
||||
`racket-debuggable-files'.
|
||||
|
||||
The run will break at the first breakable position.
|
||||
|
||||
Tip: After you run to completion and return to a normal
|
||||
REPL prompt, the code remains instrumented. You may enter
|
||||
expressions that evaluate instrumented code and it will
|
||||
break so you can step debug again.
|
||||
|
||||
b. Function Definitions
|
||||
|
||||
Put point in a function `define` form and C-u C-M-x to
|
||||
\"instrument\" the function for step debugging. Then in the
|
||||
REPL, enter an expression that causes the instrumented
|
||||
function to be run, directly or indirectly.
|
||||
|
||||
You can instrument any number of functions.
|
||||
|
||||
You can even instrument while stopped at a break. For
|
||||
example, to instrument a function you are about to call, so
|
||||
you can \"step into\" it:
|
||||
|
||||
- M-. a.k.a. `racket-visit-definition'.
|
||||
- C-u C-M-x to instrument the definition.
|
||||
- M-, a.k.a. `racket-unvisit'.
|
||||
- Continue stepping.
|
||||
|
||||
Limitation: Instrumenting a function `require`d from
|
||||
another module won't redefine that function. Instead, it
|
||||
attempts to define an instrumented function of the same
|
||||
name, in the module the REPL is inside. The define will
|
||||
fail if it needs definitions visible only in that other
|
||||
module. In that case you'll probably need to use
|
||||
entire-file instrumentation as described above.
|
||||
|
||||
2. When a break occurs, the `racket-repl-mode' prompt changes. In
|
||||
this debug REPL, local variables are available for you to use
|
||||
and even to `set!`.
|
||||
|
||||
Also, in the `racket-mode' buffer where the break is located,
|
||||
`racket-debug-mode' is enabled. This minor mode makes the
|
||||
buffer read-only, provides visual feedback -- about the break
|
||||
position, local variable values, and result values -- and
|
||||
provides shortcut keys:
|
||||
|
||||
```
|
||||
\\{racket-debug-mode-map}
|
||||
```
|
||||
"
|
||||
:lighter " RacketDebug"
|
||||
:keymap (racket--easy-keymap-define
|
||||
'(("SPC" racket-debug-step)
|
||||
("o" racket-debug-step-over)
|
||||
("u" racket-debug-step-out)
|
||||
("c" racket-debug-continue)
|
||||
("n" racket-debug-next-breakable)
|
||||
("p" racket-debug-prev-breakable)
|
||||
("h" racket-debug-run-to-here)
|
||||
("?" racket-debug-help)))
|
||||
(unless (eq major-mode 'racket-mode)
|
||||
(setq racket-debug-mode nil)
|
||||
(user-error "racket-debug-mode only works with racket-mode"))
|
||||
(cond
|
||||
(racket-debug-mode
|
||||
(racket--debug-make-overlay
|
||||
(point) (1+ (point))
|
||||
'face racket-debug-break-face
|
||||
'priority 99)
|
||||
(dolist (local racket--debug-break-locals)
|
||||
(pcase-let ((`(,_src ,pos ,span ,_name ,val) local))
|
||||
(racket--debug-make-overlay
|
||||
pos (+ pos span)
|
||||
'after-string (propertize val 'face racket-debug-locals-face))))
|
||||
(pcase racket--debug-break-info
|
||||
(`(,_id after ,str)
|
||||
(let ((eol (line-end-position)))
|
||||
(racket--debug-make-overlay
|
||||
(1- eol) eol
|
||||
'after-string (propertize (concat "⇒ (values " (substring str 1))
|
||||
'face racket-debug-result-face)))))
|
||||
(read-only-mode 1))
|
||||
(t
|
||||
(read-only-mode -1)
|
||||
(dolist (o racket--debug-overlays)
|
||||
(delete-overlay o))
|
||||
(setq racket--debug-overlays nil))))
|
||||
|
||||
(defun racket--debug-make-overlay (beg end &rest props)
|
||||
(let ((o (make-overlay beg end)))
|
||||
(push o racket--debug-overlays)
|
||||
(overlay-put o 'name 'racket-debug-overlay)
|
||||
(overlay-put o 'priority 100)
|
||||
(while props
|
||||
(overlay-put o (pop props) (pop props)))
|
||||
o))
|
||||
|
||||
(provide 'racket-debug)
|
||||
|
||||
;; racket-debug.el ends here
|
||||
|
||||
835
elpa/racket-mode-20181004.309/racket-edit.el
Normal file
835
elpa/racket-mode-20181004.309/racket-edit.el
Normal file
@@ -0,0 +1,835 @@
|
||||
;;; racket-edit.el -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (c) 2013-2018 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 prefix)
|
||||
"Save and evaluate the buffer in REPL.
|
||||
|
||||
With one C-u prefix, uses errortrace for improved stack traces.
|
||||
Otherwise follows the `racket-error-context' setting.
|
||||
|
||||
With two C-u prefixes, instruments code for step debugging. See
|
||||
`racket-debug-mode' and the variable `racket-debuggable-files'.
|
||||
|
||||
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."
|
||||
(interactive "P")
|
||||
(racket--repl-run (racket--what-to-run)
|
||||
(pcase prefix
|
||||
(`(4) 'high)
|
||||
(`(16) 'debug)
|
||||
(_ racket-error-context))
|
||||
nil))
|
||||
|
||||
(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 '(4)))
|
||||
|
||||
(defun racket-run-with-debugging ()
|
||||
"Run with `racket-error-context' temporarily set to 'debug.
|
||||
This is just `racket-run' with a double C-u prefix. Defined as a
|
||||
function so it can be a menu target."
|
||||
(interactive)
|
||||
(racket-run '(16)))
|
||||
|
||||
(defun racket-run-and-switch-to-repl (&optional prefix)
|
||||
"This is `racket-run' followed by `racket-switch-to-repl'."
|
||||
(interactive "P")
|
||||
(racket-run prefix)
|
||||
(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")
|
||||
(let ((mod-path (list 'submod (racket--buffer-file-name) 'test))
|
||||
(buf (current-buffer)))
|
||||
(if (not coverage)
|
||||
(racket--repl-run mod-path)
|
||||
(message "Running test submodule with coverage instrumentation...")
|
||||
(racket--repl-run
|
||||
mod-path
|
||||
'coverage
|
||||
(lambda (_what)
|
||||
(message "Getting coverage results...")
|
||||
(racket--cmd/async
|
||||
`(get-uncovered)
|
||||
(lambda (xs)
|
||||
(pcase xs
|
||||
(`() (message "Full coverage."))
|
||||
((and xs `((,beg0 . ,_) . ,_))
|
||||
(message "Missing coverage in %s place(s)." (length xs))
|
||||
(with-current-buffer buf
|
||||
(dolist (x xs)
|
||||
(let ((o (make-overlay (car x) (cdr x) buf)))
|
||||
(overlay-put o 'name 'racket-uncovered-overlay)
|
||||
(overlay-put o 'priority 100)
|
||||
(overlay-put o 'face font-lock-warning-face)))
|
||||
(goto-char beg0)))))))))))
|
||||
|
||||
(add-hook 'racket--repl-before-run-hook #'racket--remove-coverage-overlays)
|
||||
|
||||
(defun racket--remove-coverage-overlays ()
|
||||
(remove-overlays (point-min) (point-max) 'name 'racket-uncovered-overlay))
|
||||
|
||||
(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)
|
||||
(racket--save-if-changed)
|
||||
(let ((w (selected-window)))
|
||||
(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.
|
||||
|
||||
Please keep in mind the following limitations:
|
||||
|
||||
- Only finds symbols defined in the current namespace. You may
|
||||
need to `racket-run' the current buffer, first.
|
||||
|
||||
- Only visits the definition of module-level identifiers --
|
||||
things for which Racket's `identifier-binding` function returns
|
||||
information. This does _not_ include things such as
|
||||
local (nested) function definitions or `racket/class` member
|
||||
functions. To find those in the same file, you'll need to use a
|
||||
normal Emacs text search function like `isearch-forward'.
|
||||
|
||||
- If the definition is found in Racket's `#%kernel` module, it
|
||||
will tell you so but won't visit the definition site."
|
||||
(interactive "P")
|
||||
(pcase (racket--symbol-at-point-or-prompt prefix "Visit definition of: ")
|
||||
(`nil nil)
|
||||
(str (racket--do-visit-def-or-mod 'def str))))
|
||||
|
||||
(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 (racket--thing-at-point 'filename t)) ;matches both net/url and "file.rkt"
|
||||
(v (if (or prefix (not v))
|
||||
(read-from-minibuffer "Visit module: " (or v ""))
|
||||
v)))
|
||||
(racket--do-visit-def-or-mod 'mod v)))
|
||||
|
||||
(defun racket--do-visit-def-or-mod (cmd str)
|
||||
"CMD must be 'def or 'mod. STR must be `stringp`."
|
||||
(if (and (eq major-mode 'racket-mode)
|
||||
(not (equal (racket--cmd/await `(path+md5))
|
||||
(cons (racket--buffer-file-name) (md5 (current-buffer)))))
|
||||
(y-or-n-p "Run current buffer first? "))
|
||||
(racket--repl-run nil nil
|
||||
(lambda (_what)
|
||||
(racket--do-visit-def-or-mod cmd str)))
|
||||
(cl-case major-mode
|
||||
(racket-mode
|
||||
t)
|
||||
((racket-repl-mode racket-describe-mode)
|
||||
(racket--repl-ensure-buffer-and-process))
|
||||
(otherwise
|
||||
(user-error "Requires racket-mode or racket-repl-mode")))
|
||||
(pcase (racket--cmd/await (list cmd str))
|
||||
(`(,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." str))
|
||||
(_
|
||||
(message "Not found.")))))
|
||||
|
||||
(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")
|
||||
(pcase (racket--symbol-at-point-or-prompt prefix "Racket help for: ")
|
||||
(`nil nil)
|
||||
(str (racket--cmd/async `(doc ,str)))))
|
||||
|
||||
(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))
|
||||
|
||||
|
||||
;;; 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)
|
||||
(unless (eq major-mode 'racket-mode)
|
||||
(user-error "Current buffer is not a racket-mode buffer"))
|
||||
(pcase (racket--top-level-requires 'find)
|
||||
(`nil (user-error "The file module has no requires; nothing to do"))
|
||||
(reqs (pcase (racket--cmd/await `(requires/tidy ,reqs))
|
||||
("" nil)
|
||||
(new (goto-char (racket--top-level-requires 'kill))
|
||||
(insert (concat new "\n")))))))
|
||||
|
||||
(defun racket-trim-requires ()
|
||||
"Like `racket-tidy-requires' but also deletes unnecessary requires.
|
||||
|
||||
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. Furthermore, it is not smart about `module+` or
|
||||
`module*` forms -- it may delete top level requires that are
|
||||
actually needed by such submodules.
|
||||
|
||||
See also: `racket-base-requires'."
|
||||
(interactive)
|
||||
(unless (eq major-mode 'racket-mode)
|
||||
(user-error "Current buffer is not a racket-mode buffer"))
|
||||
(when (racket--ok-with-module+*)
|
||||
(racket--save-if-changed)
|
||||
(pcase (racket--top-level-requires 'find)
|
||||
(`nil (user-error "The file module has no requires; nothing to do"))
|
||||
(reqs (pcase (racket--cmd/await `(requires/trim
|
||||
,(racket--buffer-file-name)
|
||||
,reqs))
|
||||
(`nil (user-error "Syntax error in source file"))
|
||||
("" (goto-char (racket--top-level-requires 'kill)))
|
||||
(new (goto-char (racket--top-level-requires 'kill))
|
||||
(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. Furthermore, it is not smart about `module+` or
|
||||
`module*` forms -- it may delete top level requires that are
|
||||
actually needed by such submodules.
|
||||
|
||||
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)
|
||||
(unless (eq major-mode 'racket-mode)
|
||||
(user-error "Current buffer is not a racket-mode buffer"))
|
||||
(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 (racket--ok-with-module+*)
|
||||
(racket--save-if-changed)
|
||||
(let ((reqs (racket--top-level-requires 'find)))
|
||||
(pcase (racket--cmd/await `(requires/base
|
||||
,(racket--buffer-file-name)
|
||||
,reqs))
|
||||
(`nil (user-error "Syntax error in source file"))
|
||||
(new (goto-char (point-min))
|
||||
(re-search-forward "^#lang.*? racket$")
|
||||
(insert "/base")
|
||||
(goto-char (or (racket--top-level-requires 'kill)
|
||||
(progn (insert "\n\n") (point))))
|
||||
(unless (string= "" new)
|
||||
(insert (concat new "\n"))))))))
|
||||
|
||||
(defun racket--ok-with-module+* ()
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(or (not (re-search-forward (rx ?\( "module" (or "+" "*")) nil t))
|
||||
(prog1
|
||||
(y-or-n-p "Analysis will be unreliable due to module+ or module* forms -- proceed anyway? ")
|
||||
(message "")))))
|
||||
|
||||
(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)))
|
||||
|
||||
(defun racket--check-syntax-start ()
|
||||
(let ((buf (current-buffer)))
|
||||
(message "Running check-syntax analysis...")
|
||||
(racket--cmd/async-raw
|
||||
`(check-syntax ,(racket--buffer-file-name))
|
||||
(lambda (response)
|
||||
(with-current-buffer buf
|
||||
(pcase response
|
||||
(`(error ,m)
|
||||
(racket-check-syntax-mode -1)
|
||||
(error m))
|
||||
(`(ok ())
|
||||
(racket-check-syntax-mode -1)
|
||||
(user-error "No bindings found"))
|
||||
(`(ok ,xs)
|
||||
(message "Marking up buffer...")
|
||||
(racket--check-syntax-insert xs)
|
||||
(message ""))))))))
|
||||
|
||||
(defun racket--check-syntax-insert (xs)
|
||||
(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-20181004.309/racket-font-lock.el
Normal file
351
elpa/racket-mode-20181004.309/racket-font-lock.el
Normal file
@@ -0,0 +1,351 @@
|
||||
;;; racket-font-lock.el
|
||||
|
||||
;; Copyright (c) 2013-2018 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-20181004.309/racket-imenu.el
Normal file
89
elpa/racket-mode-20181004.309/racket-imenu.el
Normal 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-20181004.309/racket-indent.el
Normal file
530
elpa/racket-mode-20181004.309/racket-indent.el
Normal 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-20181004.309/racket-keywords-and-builtins.el
Normal file
2819
elpa/racket-mode-20181004.309/racket-keywords-and-builtins.el
Normal file
File diff suppressed because it is too large
Load Diff
264
elpa/racket-mode-20181004.309/racket-logger.el
Normal file
264
elpa/racket-mode-20181004.309/racket-logger.el
Normal file
@@ -0,0 +1,264 @@
|
||||
;;; racket-logger.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 '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]))
|
||||
|
||||
(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))))
|
||||
|
||||
(defconst racket-logger--print-config-prefix
|
||||
"racket-logger-config:\n")
|
||||
|
||||
(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))))
|
||||
|
||||
(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))
|
||||
|
||||
(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)))))
|
||||
(process-send-string racket-logger--process racket--cmd-auth)
|
||||
(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))))
|
||||
|
||||
(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
|
||||
265
elpa/racket-mode-20181004.309/racket-make-doc.el
Normal file
265
elpa/racket-mode-20181004.309/racket-make-doc.el
Normal file
@@ -0,0 +1,265 @@
|
||||
;;; racket-make-doc.el --- Major mode for Racket language.
|
||||
|
||||
;; Copyright (c) 2013-2018 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-debug)
|
||||
(require 'racket-profile)
|
||||
(require 'racket-edit)
|
||||
(require 'racket-util)
|
||||
(require 'racket-unicode-input-method)
|
||||
(require 'cl-lib)
|
||||
(require 's)
|
||||
|
||||
;;; Top
|
||||
|
||||
(defun racket-make-doc/write-reference-file ()
|
||||
(interactive)
|
||||
(with-temp-buffer
|
||||
(insert (racket-make-doc/reference))
|
||||
(write-region nil nil
|
||||
(expand-file-name "Reference.md" racket--el-source-dir)
|
||||
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
|
||||
racket-debug-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
|
||||
racket-complete-at-point
|
||||
"Macro expand"
|
||||
racket-stepper-mode
|
||||
racket-expand-file
|
||||
racket-expand-region
|
||||
racket-expand-definition
|
||||
racket-expand-last-sexp
|
||||
"Other"
|
||||
racket-mode-start-faster)
|
||||
"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)
|
||||
(and (interactive-form 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 '(("&" . "&")
|
||||
("<" . "<")
|
||||
(">" . ">")))
|
||||
(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
|
||||
"Experimental debugger"
|
||||
racket-debuggable-files)
|
||||
"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
|
||||
273
elpa/racket-mode-20181004.309/racket-mode-autoloads.el
Normal file
273
elpa/racket-mode-20181004.309/racket-mode-autoloads.el
Normal file
@@ -0,0 +1,273 @@
|
||||
;;; 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)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (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-debug" "racket-debug.el" (0 0 0 0))
|
||||
;;; Generated autoloads from racket-debug.el
|
||||
|
||||
(autoload 'racket--debug-send-definition "racket-debug" "\
|
||||
|
||||
|
||||
\(fn BEG END)" nil nil)
|
||||
|
||||
(autoload 'racket--debug-on-break "racket-debug" "\
|
||||
|
||||
|
||||
\(fn RESPONSE)" nil nil)
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-debug" '("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))
|
||||
|
||||
(autoload 'racket-mode-start-faster "racket-mode" "\
|
||||
Compile racket-mode's .rkt files for faster startup.
|
||||
|
||||
racket-mode is implemented as an Emacs Lisp \"front end\" that
|
||||
talks to a Racket process \"back end\". Because racket-mode is
|
||||
delivered as an Emacs package instead of a Racket package,
|
||||
installing it does _not_ do the `raco setup` that is normally
|
||||
done for Racket packages.
|
||||
|
||||
This command will do a `raco make` of racket-mode's .rkt files,
|
||||
creating bytecode files in `compiled/` subdirectories. As a
|
||||
result, when a `racket-run' or `racket-repl' command must start
|
||||
the Racket process, it will start faster.
|
||||
|
||||
If you run this command, _ever_, you should run it _again_ after:
|
||||
|
||||
- Installing an updated version of racket-mode. Otherwise, you
|
||||
might lose some of the speed-up.
|
||||
|
||||
- Installing a new version of Racket and/or changing the value of
|
||||
the variable `racket-program'. Otherwise, you might get an
|
||||
error message due to the bytecode being different versions.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(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-stepper" "racket-stepper.el" (0 0 0
|
||||
;;;;;; 0))
|
||||
;;; Generated autoloads from racket-stepper.el
|
||||
|
||||
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "racket-stepper" '("racket-")))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (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
|
||||
12
elpa/racket-mode-20181004.309/racket-mode-pkg.el
Normal file
12
elpa/racket-mode-20181004.309/racket-mode-pkg.el
Normal file
@@ -0,0 +1,12 @@
|
||||
(define-package "racket-mode" "20181004.309" "Major mode for Racket language."
|
||||
'((emacs "24.3")
|
||||
(faceup "0.0.2")
|
||||
(s "1.9.0"))
|
||||
:authors
|
||||
'(("Greg Hendershott"))
|
||||
:maintainer
|
||||
'("Greg Hendershott")
|
||||
:url "https://github.com/greghendershott/racket-mode")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
188
elpa/racket-mode-20181004.309/racket-mode.el
Normal file
188
elpa/racket-mode-20181004.309/racket-mode.el
Normal file
@@ -0,0 +1,188 @@
|
||||
;;; racket-mode.el --- Major mode for Racket language.
|
||||
|
||||
;; Copyright (c) 2013-2018 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 lang.
|
||||
;; - Follow DrRacket concepts where applicable.
|
||||
;; - Thorough font-lock and indent.
|
||||
;; - Compatible with Emacs 24.3+ and Racket 6.0+.
|
||||
;;
|
||||
;; Details: https://github.com/greghendershott/racket-mode
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'racket-edit)
|
||||
(require 'racket-imenu)
|
||||
(require 'racket-profile)
|
||||
(require 'racket-logger)
|
||||
(require 'racket-stepper)
|
||||
(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 f" racket-expand-file)
|
||||
("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-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"
|
||||
["File" racket-expand-file]
|
||||
["Region" racket-expand-region :active (region-active-p)]
|
||||
["Definition" racket-expand-definition]
|
||||
["Last S-Expression" racket-expand-last-sexp])
|
||||
["Switch to REPL" racket-repl]
|
||||
("Tools"
|
||||
["Profile" racket-profile]
|
||||
["Check Syntax" racket-check-syntax-mode]
|
||||
["Error Trace" racket-run-with-errortrace]
|
||||
["Step Debug" racket-run-with-debugging])
|
||||
"---"
|
||||
["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]
|
||||
["Start Faster" racket-mode-optimize-startup]
|
||||
["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)))
|
||||
|
||||
;;;###autoload
|
||||
(defun racket-mode-start-faster ()
|
||||
"Compile racket-mode's .rkt files for faster startup.
|
||||
|
||||
racket-mode is implemented as an Emacs Lisp \"front end\" that
|
||||
talks to a Racket process \"back end\". Because racket-mode is
|
||||
delivered as an Emacs package instead of a Racket package,
|
||||
installing it does _not_ do the `raco setup` that is normally
|
||||
done for Racket packages.
|
||||
|
||||
This command will do a `raco make` of racket-mode's .rkt files,
|
||||
creating bytecode files in `compiled/` subdirectories. As a
|
||||
result, when a `racket-run' or `racket-repl' command must start
|
||||
the Racket process, it will start faster.
|
||||
|
||||
If you run this command, _ever_, you should run it _again_ after:
|
||||
|
||||
- Installing an updated version of racket-mode. Otherwise, you
|
||||
might lose some of the speed-up.
|
||||
|
||||
- Installing a new version of Racket and/or changing the value of
|
||||
the variable `racket-program'. Otherwise, you might get an
|
||||
error message due to the bytecode being different versions."
|
||||
(interactive)
|
||||
(dolist (dir (list racket--rkt-source-dir
|
||||
(concat racket--rkt-source-dir "/commands/")))
|
||||
(let* ((command (format "%s -l raco make -v %s"
|
||||
racket-program
|
||||
(expand-file-name "*.rkt" dir)))
|
||||
(prompt (format "Do `%s` " command)))
|
||||
(when (y-or-n-p prompt)
|
||||
(async-shell-command command)))))
|
||||
|
||||
(provide 'racket-mode)
|
||||
|
||||
;;; racket-mode.el ends here
|
||||
79
elpa/racket-mode-20181004.309/racket-ppss.el
Normal file
79
elpa/racket-mode-20181004.309/racket-ppss.el
Normal 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
|
||||
175
elpa/racket-mode-20181004.309/racket-profile.el
Normal file
175
elpa/racket-mode-20181004.309/racket-profile.el
Normal file
@@ -0,0 +1,175 @@
|
||||
;;; racket-profile.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 '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)
|
||||
(unless (eq major-mode 'racket-mode)
|
||||
(user-error "Works only in a racket-mode buffer"))
|
||||
(message "Running with profiling instrumentation...")
|
||||
(racket--repl-run
|
||||
nil
|
||||
'profile
|
||||
(lambda (_what)
|
||||
(message "Getting profile results...")
|
||||
(racket--cmd/async
|
||||
`(get-profile)
|
||||
(lambda (results)
|
||||
(message "")
|
||||
(setq racket--profile-results results)
|
||||
(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))))))))
|
||||
|
||||
(defun racket--profile-refresh ()
|
||||
(interactive)
|
||||
(setq racket--profile-results (racket--cmd/await `(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
|
||||
746
elpa/racket-mode-20181004.309/racket-repl.el
Normal file
746
elpa/racket-mode-20181004.309/racket-repl.el
Normal file
@@ -0,0 +1,746 @@
|
||||
;;; racket-repl.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (c) 2013-2018 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)
|
||||
(require 'cl-lib)
|
||||
|
||||
;; Don't (require 'racket-debug). Mutual dependency. Instead:
|
||||
(declare-function racket--debug-send-definition "racket-debug" (beg end))
|
||||
(autoload 'racket--debug-send-definition "racket-debug")
|
||||
(declare-function racket--debug-on-break "racket-debug" (response))
|
||||
(autoload 'racket--debug-on-break "racket-debug")
|
||||
(declare-function racket--debuggable-files "racket-debug" (file-to-run))
|
||||
(autoload 'racket--debuggable-files "racket-debug")
|
||||
|
||||
(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-repl--input-filter (str)
|
||||
"Don't save anything matching `racket-history-filter-regexp'."
|
||||
(not (string-match racket-history-filter-regexp str)))
|
||||
|
||||
(defalias 'racket-repl-eval-or-newline-and-indent #'racket-repl-submit)
|
||||
|
||||
(defun racket-repl-submit (&optional prefix)
|
||||
"Submit your input to the Racket REPL.
|
||||
|
||||
If the REPL is running a Racket lang whose language-info has a
|
||||
'drracket:submit-predicate, that is first called to see if the
|
||||
input is valid to be submitted.
|
||||
|
||||
With a prefix: After sending your input and a newline, also calls
|
||||
`process-send-eof' -- because some langs require EOF to mark the
|
||||
end of an interactive expression/statement."
|
||||
(interactive "P")
|
||||
(let* ((proc (get-buffer-process (current-buffer)))
|
||||
(_ (unless proc (user-error "Current buffer has no process")))
|
||||
(text (substring-no-properties (funcall comint-get-old-input))))
|
||||
(cl-case (if racket-use-repl-submit-predicate
|
||||
(racket--cmd/await `(repl-submit? ,text t))
|
||||
'default)
|
||||
((nil)
|
||||
(user-error "Not a complete expression, according to the current lang's submit-predicate."))
|
||||
((t default)
|
||||
(comint-send-input)
|
||||
(remove-text-properties comint-last-input-start
|
||||
comint-last-input-end
|
||||
'(font-lock-face comint-highlight-input))
|
||||
;; Hack for datalog/lang
|
||||
(when prefix (process-send-eof proc))))))
|
||||
|
||||
(defun racket-repl-exit (&optional quitp)
|
||||
"End the Racket REPL process.
|
||||
|
||||
Effectively the same as entering `(exit)` at the prompt, but
|
||||
works even when the module language doesn't provide any binding
|
||||
for `exit`.
|
||||
|
||||
With a prefix, uses `comint-quit-subjob' to send a quit signal."
|
||||
(interactive "P")
|
||||
(if quitp
|
||||
(comint-quit-subjob)
|
||||
(newline)
|
||||
(racket--cmd/async `(exit))))
|
||||
|
||||
;;;###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" racket--rkt-source-dir)
|
||||
"Pathname of run.rkt")
|
||||
|
||||
(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--repl-live-p ()
|
||||
"Does the Racket REPL buffer exist and have a live Racket process?"
|
||||
(comint-check-proc racket--repl-buffer-name))
|
||||
|
||||
(defvar racket--repl-before-run-hook nil
|
||||
"Thunks to do before each `racket--repl-run' -- except an initial run.")
|
||||
|
||||
(defun racket--repl-run (&optional what-to-run context-level callback)
|
||||
"Do an initial or subsequent run.
|
||||
|
||||
WHAT-TO-RUN should be a cons of a file name to a list of
|
||||
submodule symbols. Or if nil, defaults to `racket--what-to-run'.
|
||||
|
||||
CONTEXT-LEVEL should be a valid value for the variable
|
||||
`racket-error-context', 'coverage, or 'profile. Or if nil,
|
||||
defaults to the variable `racket-error-context'.
|
||||
|
||||
CALLBACK is supplied to `racket--repl-run' and is used as the
|
||||
callback for `racket--cmd/async'; it may be nil which is
|
||||
equivalent to #'ignore.
|
||||
|
||||
- If the REPL is _not_ live, start our backend run.rkt passing
|
||||
the file to run as a command-line argument. The Emacs UI will
|
||||
_not_ be blocked during this.
|
||||
|
||||
- If the REPL _is_ live, send a run command to the backend's TCP
|
||||
server. If the server isn't live yet -- e.g. if Racket run.rkt
|
||||
are still starting up -- this _will_ block the Emacs UI."
|
||||
(let ((cmd (racket--repl-make-run-command (or what-to-run (racket--what-to-run))
|
||||
(or context-level racket-error-context))))
|
||||
(cond ((racket--repl-live-p)
|
||||
(run-hook-with-args 'racket--repl-before-run-hook)
|
||||
(racket--cmd/async cmd callback)
|
||||
(racket--repl-show-and-move-to-end))
|
||||
(t
|
||||
(when callback
|
||||
;; Not sure how to do a callback, here, unless maybe
|
||||
;; issuing a ``prompt` command?
|
||||
(message "Warning: run command callback ignored for startup run"))
|
||||
(racket--repl-ensure-buffer-and-process t cmd)))))
|
||||
|
||||
(defun racket--repl-make-run-command (what-to-run &optional context-level)
|
||||
"Form a `run` command sexpr for the backend.
|
||||
WHAT-TO-RUN may be nil, meaning just a `racket/base` namespace."
|
||||
(let ((context-level (or context-level racket-error-context)))
|
||||
(list 'run
|
||||
what-to-run
|
||||
racket-memory-limit
|
||||
racket-pretty-print
|
||||
context-level
|
||||
racket-user-command-line-arguments
|
||||
(when (and what-to-run (eq context-level 'debug))
|
||||
(racket--debuggable-files (car what-to-run))))))
|
||||
|
||||
(defvar racket--cmd-auth nil
|
||||
"A value we give the Racket back-end when we launch it and when we connect.
|
||||
See issue #327.")
|
||||
|
||||
(defun racket--repl-ensure-buffer-and-process (&optional display run-command)
|
||||
"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'.
|
||||
|
||||
Non-nil RUN-COMMAND is supplied as the second command-line
|
||||
argument to `racket--run.rkt' so the process can start by
|
||||
immediately running a desired file.
|
||||
|
||||
Never changes selected window."
|
||||
(if (racket--repl-live-p)
|
||||
(when display
|
||||
(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-program
|
||||
nil
|
||||
racket--run.rkt
|
||||
(number-to-string racket-command-port)
|
||||
(setq racket--cmd-auth (format "%S\n" `(auth ,(random))))
|
||||
(format "%S" (or run-command
|
||||
(racket--repl-make-run-command nil))))
|
||||
(let ((proc (get-buffer-process racket--repl-buffer-name)))
|
||||
;; Display now so users see startup and banner sooner.
|
||||
(when display
|
||||
(display-buffer (current-buffer)))
|
||||
(message "Starting %s to run %s ..." racket-program racket--run.rkt)
|
||||
;; Ensure command server connection closed when racket process dies.
|
||||
(set-process-sentinel proc
|
||||
(lambda (_proc event)
|
||||
(with-racket-repl-buffer
|
||||
(insert (concat "Process Racket REPL " event)))
|
||||
(racket--cmd-disconnect)))
|
||||
(set-process-coding-system proc 'utf-8 'utf-8) ;for e.g. λ
|
||||
(racket-repl-mode))))
|
||||
(unless (racket--cmd-connected-or-connecting-p)
|
||||
(racket--cmd-connect-start)))
|
||||
|
||||
(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 t nil "--version")
|
||||
(goto-char (point-min))
|
||||
;; Welcome to Racket v6.12.
|
||||
;; Welcome to Racket v7.0.0.6.
|
||||
(save-match-data
|
||||
(re-search-forward "[0-9]+\\(?:\\.[0-9]+\\)*")
|
||||
(match-string 0)))))
|
||||
|
||||
(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))
|
||||
|
||||
;;; Connection to command process
|
||||
|
||||
(defvar racket--cmd-proc nil
|
||||
"Process when connection to the command server is established.")
|
||||
(defvar racket--cmd-buf nil
|
||||
"Process buffer when connection to the command server is established.")
|
||||
(defvar racket--cmd-connecting-p nil)
|
||||
|
||||
(defvar racket--cmd-nonce->callback (make-hash-table :test 'eq)
|
||||
"A hash from nonce to callback function.")
|
||||
(defvar racket--cmd-nonce 0
|
||||
"Increments for each command request we send.")
|
||||
|
||||
(defvar racket--cmd-connect-attempts 15)
|
||||
(defvar racket--cmd-connect-timeout 15)
|
||||
|
||||
(defun racket--cmd-connected-or-connecting-p ()
|
||||
(and (or racket--cmd-proc racket--cmd-connecting-p) t))
|
||||
|
||||
(defun racket--cmd-connect-start (&optional attempt)
|
||||
"Start to connect to the Racket command process.
|
||||
|
||||
If already connected, disconnects first.
|
||||
|
||||
The command server may might not be ready to accept connections,
|
||||
because Racket itself and our backend are still starting up.
|
||||
After calling this, call `racket--cmd-connect-finish' to
|
||||
wait for the connection to be established."
|
||||
(unless (featurep 'make-network-process '(:nowait t))
|
||||
(error "racket-mode needs Emacs to support the :nowait feature"))
|
||||
(let ((attempt (or attempt 1)))
|
||||
(when (= attempt 1)
|
||||
(racket--cmd-disconnect)
|
||||
(setq racket--cmd-connecting-p t))
|
||||
(make-network-process
|
||||
:name "racket-command"
|
||||
:host "127.0.0.1"
|
||||
:service racket-command-port
|
||||
:nowait t
|
||||
:sentinel
|
||||
(lambda (proc event)
|
||||
;;(message "sentinel process %S event %S attempt %s" proc event attempt)
|
||||
(cond
|
||||
((string-match-p "^open" event)
|
||||
(setq racket--cmd-proc proc)
|
||||
(setq racket--cmd-buf (generate-new-buffer
|
||||
(concat " " (process-name proc))))
|
||||
(buffer-disable-undo racket--cmd-buf)
|
||||
(set-process-filter proc #'racket--cmd-process-filter)
|
||||
(process-send-string proc racket--cmd-auth)
|
||||
(message "Connected to %s process on port %s after %s attempt(s)"
|
||||
proc racket-command-port attempt))
|
||||
((string-match-p "^failed" event)
|
||||
(delete-process proc)
|
||||
(when (<= attempt racket--cmd-connect-attempts)
|
||||
(run-at-time 1.0 nil
|
||||
#'racket--cmd-connect-start
|
||||
(1+ attempt))))
|
||||
(t (racket--cmd-disconnect)))))))
|
||||
|
||||
(defun racket--cmd-connect-finish ()
|
||||
(with-timeout (racket--cmd-connect-timeout
|
||||
(setq racket--cmd-connecting-p nil)
|
||||
(error "Could not connect to racket-command process on port %s"
|
||||
racket-command-port))
|
||||
(while (not racket--cmd-proc)
|
||||
(message "Still trying to connect to racket-command process on port %s ..."
|
||||
racket-command-port)
|
||||
(sit-for 0.2))
|
||||
(setq racket--cmd-connecting-p nil)))
|
||||
|
||||
(defun racket--cmd-disconnect ()
|
||||
"Disconnect from the Racket command process."
|
||||
(when racket--cmd-proc
|
||||
;; Sentinel calls us for "deleted" event, which we ourselves will
|
||||
;; trigger with the `delete-process' below. So set
|
||||
;; racket--cmd-proc nil before calling `delete-process'.
|
||||
(let ((proc (prog1 racket--cmd-proc (setq racket--cmd-proc nil)))
|
||||
(buf (prog1 racket--cmd-buf (setq racket--cmd-buf nil))))
|
||||
(delete-process proc)
|
||||
(kill-buffer buf)
|
||||
(clrhash racket--cmd-nonce->callback)
|
||||
(setq racket--cmd-connecting-p nil))))
|
||||
|
||||
(defun racket--cmd-process-filter (_proc string)
|
||||
(let ((buffer racket--cmd-buf))
|
||||
(when (buffer-live-p buffer)
|
||||
(with-current-buffer buffer
|
||||
(goto-char (point-max))
|
||||
(insert string)
|
||||
(goto-char (point-min))
|
||||
(while
|
||||
(condition-case ()
|
||||
(progn
|
||||
(forward-sexp 1)
|
||||
(let ((sexp (buffer-substring (point-min) (point))))
|
||||
(delete-region (point-min) (point))
|
||||
(ignore-errors
|
||||
(racket--cmd-dispatch-response (read sexp))
|
||||
t)))
|
||||
(scan-error nil)))))))
|
||||
|
||||
(defun racket--cmd-dispatch-response (response)
|
||||
(pcase response
|
||||
(`(debug-break . ,response)
|
||||
(run-at-time 0.001 nil #'racket--debug-on-break response))
|
||||
(`(,nonce . ,response)
|
||||
(let ((callback (gethash nonce racket--cmd-nonce->callback)))
|
||||
(when callback
|
||||
(remhash nonce racket--cmd-nonce->callback)
|
||||
(run-at-time 0.001 nil callback response))))
|
||||
(_ nil)))
|
||||
|
||||
(defun racket--cmd/async-raw (command-sexpr &optional callback)
|
||||
"Send COMMAND-SEXPR and return. Later call CALLBACK with the response sexp.
|
||||
|
||||
If CALLBACK is not supplied or nil, defaults to `ignore'.
|
||||
|
||||
Otherwise CALLBACK is called after the command server returns a
|
||||
response. Because command responses are obtained from the dynamic
|
||||
extent of a `set-process-filter' proc -- which may have
|
||||
limitations on what it can or should do -- CALLBACK is not called
|
||||
immediately but instead using `run-at-time' with a very small
|
||||
delay.
|
||||
|
||||
Important: Do not assume that `current-buffer' is the same when
|
||||
CALLBACK is called, as it was when the command was sent. If you
|
||||
need to do something to do that original buffer, save the
|
||||
`current-buffer' in a `let' and use it in a `with-current-buffer'
|
||||
form."
|
||||
(racket--repl-ensure-buffer-and-process nil)
|
||||
(racket--cmd-connect-finish)
|
||||
(cl-incf racket--cmd-nonce)
|
||||
(when (and callback
|
||||
(not (equal callback #'ignore)))
|
||||
(puthash racket--cmd-nonce callback racket--cmd-nonce->callback))
|
||||
(process-send-string racket--cmd-proc
|
||||
(format "%S\n" (cons racket--cmd-nonce
|
||||
command-sexpr))))
|
||||
|
||||
(defun racket--cmd/async (command-sexpr &optional callback)
|
||||
"You probably want to use this instead of `racket--cmd/async-raw'.
|
||||
|
||||
CALLBACK is only called for 'ok responses, with (ok v ...)
|
||||
unwrapped to (v ...).
|
||||
|
||||
'error responses are handled here. Note: We use `message' not
|
||||
`error' here because:
|
||||
|
||||
1. It would show \"error running timer:\" which, although true,
|
||||
is confusing or at best N/A for end users.
|
||||
|
||||
2. More simply, we don't need to escape any call stack, we only
|
||||
need to ... not call the callback!
|
||||
|
||||
The original value of `current-buffer' is temporarily restored
|
||||
during CALLBACK, because neglecting to do so is a likely
|
||||
mistake."
|
||||
(let ((buf (current-buffer)))
|
||||
(racket--cmd/async-raw
|
||||
command-sexpr
|
||||
(if callback
|
||||
(lambda (response)
|
||||
(pcase response
|
||||
(`(ok ,v) (with-current-buffer buf (funcall callback v)))
|
||||
(`(error ,m) (message "%s" m))
|
||||
(v (message "Unknown command response: %S" v))))
|
||||
#'ignore))))
|
||||
|
||||
(defun racket--cmd/await (command-sexpr)
|
||||
"Send COMMAND-SEXPR. Await and return an 'ok response value, or raise `error'."
|
||||
(let* ((awaiting 'RACKET-REPL-AWAITING)
|
||||
(response awaiting))
|
||||
(racket--cmd/async-raw command-sexpr
|
||||
(lambda (v) (setq response v)))
|
||||
(with-timeout (racket-command-timeout
|
||||
(error "racket-command process timeout"))
|
||||
(while (eq response awaiting)
|
||||
(accept-process-output nil 0.001))
|
||||
(pcase response
|
||||
(`(ok ,v) v)
|
||||
(`(error ,m) (error "%s" m))
|
||||
(v (error "Unknown command response: %S" v))))))
|
||||
|
||||
;;; Misc
|
||||
|
||||
(defun racket-repl-file-name ()
|
||||
"Return the file running in the REPL, 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)
|
||||
(pcase (racket--cmd/await `(path+md5))
|
||||
(`(,(and (pred stringp) path) . ,_md5)
|
||||
(cl-case system-type
|
||||
(windows-nt (subst-char-in-string ?\\ ?/ path))
|
||||
(otherwise path)))
|
||||
(_ nil))))
|
||||
|
||||
(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)
|
||||
(pcase (racket-repl-file-name)
|
||||
(`() (let ((buffer (racket--most-recent-racket-mode-buffer)))
|
||||
(unless buffer
|
||||
(user-error "There are no racket-mode buffers"))
|
||||
(pop-to-buffer buffer t)))
|
||||
(path (let ((buffer (find-buffer-visiting path)))
|
||||
(if buffer
|
||||
(pop-to-buffer buffer t)
|
||||
(other-window 1)
|
||||
(find-file path))))))
|
||||
|
||||
(defun racket--most-recent-racket-mode-buffer ()
|
||||
(cl-some (lambda (b)
|
||||
(with-current-buffer b
|
||||
(and (eq major-mode 'racket-mode) b)))
|
||||
(buffer-list)))
|
||||
|
||||
;;; 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, calls `racket-repl' and
|
||||
`racket--repl-forget-errors'. Also inserts 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 (get-buffer-process racket--repl-buffer-name)))
|
||||
(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 (&optional prefix)
|
||||
"Send the current definition to the Racket REPL."
|
||||
(interactive "P")
|
||||
(save-excursion
|
||||
(end-of-defun)
|
||||
(let ((end (point)))
|
||||
(beginning-of-defun)
|
||||
(if prefix
|
||||
(racket--debug-send-definition (point) end)
|
||||
(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 (racket--repl-last-sexp-start)
|
||||
(point)))
|
||||
|
||||
(defun racket-eval-last-sexp ()
|
||||
"Eval the previous sexp asynchronously and `message' the result."
|
||||
(interactive)
|
||||
(racket--cmd/async
|
||||
`(eval
|
||||
,(buffer-substring-no-properties (racket--repl-last-sexp-start)
|
||||
(point)))
|
||||
(lambda (v)
|
||||
(message "%s" v))))
|
||||
|
||||
(defun racket--repl-last-sexp-start ()
|
||||
(save-excursion
|
||||
(condition-case ()
|
||||
(progn
|
||||
(backward-sexp)
|
||||
(if (save-match-data (looking-at "#;"))
|
||||
(+ (point) 2)
|
||||
(point)))
|
||||
(scan-error (user-error "There isn't a complete s-expression before 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))))
|
||||
|
||||
(add-hook 'racket--repl-before-run-hook #'racket--repl-forget-errors)
|
||||
|
||||
(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
|
||||
'(("C-m" racket-repl-submit)
|
||||
("C-j" newline-and-indent)
|
||||
("TAB" indent-for-tab-command)
|
||||
("C-M-u" racket-backward-up-list)
|
||||
("C-M-q" prog-indent-sexp)
|
||||
("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 f" racket-expand-file)
|
||||
("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)
|
||||
("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)
|
||||
("C-c C-\\" racket-repl-exit)))
|
||||
"Keymap for Racket REPL mode.")
|
||||
|
||||
(easy-menu-define racket-repl-mode-menu racket-repl-mode-map
|
||||
"Menu for Racket REPL mode."
|
||||
'("Racket"
|
||||
["Break" comint-interrupt-subjob]
|
||||
["Exit" racket-repl-exit]
|
||||
"---"
|
||||
["Insert Lambda" racket-insert-lambda] ;λ in string breaks menu
|
||||
["Indent Region" indent-region]
|
||||
["Cycle Paren Shapes" racket-cycle-paren-shapes]
|
||||
("Macro Expand"
|
||||
["File" racket-expand-file]
|
||||
["Region" racket-expand-region :active (region-active-p)]
|
||||
["Definition" racket-expand-definition]
|
||||
["Last S-Expression" racket-expand-last-sexp])
|
||||
"---"
|
||||
["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-use-prompt-regexp nil)
|
||||
(setq-local comint-prompt-read-only t)
|
||||
(setq-local comint-scroll-show-maximum-output nil) ;t slow for big outputs
|
||||
(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))))
|
||||
|
||||
(provide 'racket-repl)
|
||||
|
||||
;; racket-repl.el ends here
|
||||
202
elpa/racket-mode-20181004.309/racket-stepper.el
Normal file
202
elpa/racket-mode-20181004.309/racket-stepper.el
Normal file
@@ -0,0 +1,202 @@
|
||||
;;; racket-stepper.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (c) 2018 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-common)
|
||||
(require 'racket-custom)
|
||||
(require 'racket-repl)
|
||||
(require 'racket-util)
|
||||
|
||||
;; Need to define this before racket-stepper-mode
|
||||
(defvar racket-stepper-mode-map
|
||||
(racket--easy-keymap-define
|
||||
'((("C-m") racket-stepper-step)
|
||||
(("n" "j") racket-stepper-next-item)
|
||||
(("p" "k") racket-stepper-previous-item))))
|
||||
|
||||
(easy-menu-define racket-stepper-mode-menu racket-stepper-mode-map
|
||||
"Menu for Racket stepper mode."
|
||||
'("Racket"
|
||||
["Step" racket-stepper-step]
|
||||
["Next" racket-stepper-next-item]
|
||||
["Previous" racket-stepper-previous-item]))
|
||||
|
||||
(defconst racket-stepper-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx bol "! " (zero-or-more any) eol) . font-lock-warning-face)
|
||||
(,(rx bol alphanumeric (zero-or-more any) eol) . font-lock-function-name-face)
|
||||
(,(rx bol "@@" (zero-or-more any) "@@" eol) . font-lock-comment-face)
|
||||
(,(rx bol "-" (zero-or-more any) eol) . 'diff-removed)
|
||||
(,(rx bol "+" (zero-or-more any) eol) . 'diff-added))))
|
||||
|
||||
(define-derived-mode racket-stepper-mode special-mode "Racket-Stepper"
|
||||
"Major mode for Racket stepper output.
|
||||
|
||||
Used by the commands `racket-expand-file',
|
||||
`racket-expand-definition', `racket-expand-region', and
|
||||
`racket-expand-last-sexp'.
|
||||
|
||||
\\<racket-stepper-mode-map>
|
||||
|
||||
```
|
||||
\\{racket-stepper-mode-map}
|
||||
```
|
||||
"
|
||||
(setq header-line-format
|
||||
"Press RET to step. C-h m to see help.")
|
||||
(setq-local font-lock-defaults
|
||||
(list racket-stepper-font-lock-keywords
|
||||
t))) ;keywords only -- not strings/comments
|
||||
|
||||
(defvar racket-stepper--buffer-name "*Racket Stepper*")
|
||||
|
||||
;;; commands
|
||||
|
||||
(defun racket-expand-file (&optional into-base)
|
||||
"Expand the `racket-mode' buffer's file in `racket-stepper-mode'.
|
||||
|
||||
Uses the `macro-debugger` package to do the expansion.
|
||||
|
||||
You do _not_ need to `racket-run' the file first; the namespace
|
||||
active in the REPL is not used.
|
||||
|
||||
If the file is non-trivial and/or is not compiled to a .zo
|
||||
bytecode file, then it might take many seconds before the
|
||||
original form is displayed and you can start stepping.
|
||||
|
||||
With a prefix, also expands syntax from racket/base -- which can
|
||||
result in very many expansion steps."
|
||||
(interactive "P")
|
||||
(unless (eq major-mode 'racket-mode)
|
||||
(user-error "Only works in racket-mode buffer"))
|
||||
(racket--save-if-changed)
|
||||
(racket-stepper--start 'file (racket--buffer-file-name) into-base))
|
||||
|
||||
(defun racket-expand-region (start end &optional into-base)
|
||||
"Expand the active region using `racket-stepper-mode'.
|
||||
|
||||
Uses Racket's `expand-once` in the namespace from the most recent
|
||||
`racket-run'."
|
||||
(interactive "rP")
|
||||
(unless (region-active-p)
|
||||
(user-error "No region"))
|
||||
(racket-stepper--expand-text into-base
|
||||
(lambda ()
|
||||
(cons start end))))
|
||||
|
||||
(defun racket-expand-definition (&optional into-base)
|
||||
"Expand the definition around point using `racket-stepper-mode'.
|
||||
|
||||
Uses Racket's `expand-once` in the namespace from the most recent
|
||||
`racket-run'."
|
||||
(interactive "P")
|
||||
(racket-stepper--expand-text into-base
|
||||
(lambda ()
|
||||
(save-excursion
|
||||
(cons (progn (beginning-of-defun) (point))
|
||||
(progn (end-of-defun) (point)))))))
|
||||
|
||||
(defun racket-expand-last-sexp (&optional into-base)
|
||||
"Expand the sexp before point using `racket-stepper-mode'.
|
||||
|
||||
Uses Racket's `expand-once` in the namespace from the most recent
|
||||
`racket-run'."
|
||||
(interactive "P")
|
||||
(racket-stepper--expand-text into-base
|
||||
(lambda ()
|
||||
(save-excursion
|
||||
(cons (progn (backward-sexp) (point))
|
||||
(progn (forward-sexp) (point)))))))
|
||||
|
||||
(defun racket-stepper--expand-text (prefix get-region)
|
||||
(pcase (funcall get-region)
|
||||
(`(,beg . ,end)
|
||||
(racket-stepper--start 'expr
|
||||
(buffer-substring-no-properties beg end)
|
||||
prefix))))
|
||||
|
||||
(defun racket-stepper--start (which str into-base)
|
||||
"Ensure buffer and issue initial command.
|
||||
WHICH should be 'expr or 'file.
|
||||
STR should be the expression or pathname.
|
||||
INTO-BASE is treated as a raw prefix arg and converted to boolp."
|
||||
;; Create buffer if necessary
|
||||
(unless (get-buffer racket-stepper--buffer-name)
|
||||
(with-current-buffer (get-buffer-create racket-stepper--buffer-name)
|
||||
(racket-stepper-mode)))
|
||||
;; Give it a window if necessary
|
||||
(unless (get-buffer-window racket-stepper--buffer-name)
|
||||
(pop-to-buffer (get-buffer racket-stepper--buffer-name)))
|
||||
;; Select the stepper window and insert
|
||||
(select-window (get-buffer-window racket-stepper--buffer-name))
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region (point-min) (point-max))
|
||||
(insert "Starting macro expansion stepper... please wait...\n"))
|
||||
(racket--cmd/async `(macro-stepper (,which . ,str)
|
||||
,(and into-base t))
|
||||
#'racket-stepper--insert))
|
||||
|
||||
(defun racket-stepper--insert (step)
|
||||
(with-current-buffer racket-stepper--buffer-name
|
||||
(let ((inhibit-read-only t))
|
||||
(goto-char (point-max))
|
||||
(pcase step
|
||||
(`(original . ,text)
|
||||
(delete-region (point-min) (point-max))
|
||||
(insert "Original\n" text "\n" "\n"))
|
||||
(`(final . ,text) (insert "Final\n" text "\n"))
|
||||
(`(,label . ,diff) (insert label "\n" diff "\n")))
|
||||
(racket-stepper-previous-item)
|
||||
(when (equal (selected-window) (get-buffer-window (current-buffer)))
|
||||
(recenter)))))
|
||||
|
||||
(defun racket-stepper-step ()
|
||||
(interactive)
|
||||
(racket--cmd/async `(macro-stepper/next)
|
||||
#'racket-stepper--insert))
|
||||
|
||||
(defconst racket-stepper--item-rx
|
||||
(rx bol alphanumeric (zero-or-more any) eol))
|
||||
|
||||
(defun racket-stepper-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-stepper--item-rx nil t count)
|
||||
(beginning-of-line)
|
||||
(backward-char 1)))
|
||||
|
||||
(defun racket-stepper-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-stepper--item-rx nil t count))
|
||||
|
||||
(provide 'racket-stepper)
|
||||
|
||||
;;; racket-stepper.el ends here
|
||||
224
elpa/racket-mode-20181004.309/racket-unicode-input-method.el
Normal file
224
elpa/racket-mode-20181004.309/racket-unicode-input-method.el
Normal 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
|
||||
123
elpa/racket-mode-20181004.309/racket-util.el
Normal file
123
elpa/racket-mode-20181004.309/racket-util.el
Normal file
@@ -0,0 +1,123 @@
|
||||
;;; 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--save-if-changed ()
|
||||
(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)))
|
||||
|
||||
(add-hook 'racket--repl-before-run-hook #'racket--save-if-changed)
|
||||
|
||||
(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))
|
||||
`()))))
|
||||
|
||||
(defun racket--thing-at-point (thing &optional no-properties)
|
||||
"Like `thing-at-point' in Emacs 25+: Optional arg NO-PROPERTIES.
|
||||
Someday when we no longer support Emacs 24, we could delete this
|
||||
and callers just use `thing-at-point'."
|
||||
(pcase (thing-at-point thing)
|
||||
((and (guard no-properties)
|
||||
(pred stringp)
|
||||
str)
|
||||
(substring-no-properties str))
|
||||
(v v)))
|
||||
|
||||
(defconst racket--el-source-dir
|
||||
(file-name-directory (or load-file-name (racket--buffer-file-name)))
|
||||
"Path to dir of our Emacs Lisp source files.
|
||||
When installed as a package, this can be found from the variable
|
||||
`load-file-name'. When developing interactively, get it from the
|
||||
.el buffer file name.")
|
||||
|
||||
(defconst racket--rkt-source-dir
|
||||
(expand-file-name "./racket/" racket--el-source-dir)
|
||||
"Path to dir of our Racket source files. ")
|
||||
|
||||
;;; 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
|
||||
72
elpa/racket-mode-20181004.309/racket/channel.rkt
Normal file
72
elpa/racket-mode-20181004.309/racket/channel.rkt
Normal file
@@ -0,0 +1,72 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/contract
|
||||
racket/match
|
||||
racket/set
|
||||
"mod.rkt")
|
||||
|
||||
(provide message-to-main-thread-channel
|
||||
(struct-out message-to-main-thread)
|
||||
(struct-out load-gui)
|
||||
(struct-out rerun)
|
||||
rerun-default
|
||||
context-level?
|
||||
instrument-level?
|
||||
profile/coverage-level?
|
||||
debug-level?)
|
||||
|
||||
|
||||
;;; Definitions for the context-level member of rerun
|
||||
|
||||
(define profile/coverage-levels
|
||||
;; "sibling" levels that need instrument plus...
|
||||
'(profile ;profiling-enabled
|
||||
coverage)) ;execute-counts-enabled
|
||||
|
||||
(define instrument-levels
|
||||
`(high ;compile-context-preservation-enabled #t + instrument
|
||||
,@profile/coverage-levels))
|
||||
|
||||
(define context-levels
|
||||
`(low ;compile-context-preservation-enabled #f
|
||||
medium ;compile-context-preservation-enabled #t
|
||||
,@instrument-levels
|
||||
debug))
|
||||
|
||||
(define-syntax-rule (memq? x xs)
|
||||
(and (memq x xs) #t))
|
||||
|
||||
(define (context-level? v) (memq? v context-levels))
|
||||
(define (instrument-level? v) (memq? v instrument-levels))
|
||||
(define (profile/coverage-level? v) (memq? v profile/coverage-levels))
|
||||
(define (debug-level? v) (eq? v 'debug))
|
||||
|
||||
;;; Messages to the main thread via a channel
|
||||
|
||||
(define message-to-main-thread-channel (make-channel))
|
||||
|
||||
(define-struct/contract message-to-main-thread ())
|
||||
|
||||
(define-struct/contract (load-gui message-to-main-thread)
|
||||
([in-repl? boolean?]))
|
||||
|
||||
(define-struct/contract (rerun message-to-main-thread)
|
||||
([maybe-mod (or/c #f mod?)]
|
||||
[memory-limit exact-nonnegative-integer?] ;0 = no limit
|
||||
[pretty-print? boolean?]
|
||||
[context-level context-level?]
|
||||
;; The following contract is the weaker `vector?` instead of
|
||||
;; `(vectorof string?)` because latter fails under Racket 6.0 and
|
||||
;; 6.1 when the value is accessed from the struct and passed to
|
||||
;; `current-command-line-arguments`. WAT.
|
||||
[cmd-line-args vector?]
|
||||
[debug-files (set/c path?)]
|
||||
[ready-thunk (-> any/c)]))
|
||||
|
||||
(define rerun-default (rerun #f
|
||||
0
|
||||
#f
|
||||
'low
|
||||
#()
|
||||
(set)
|
||||
void))
|
||||
232
elpa/racket-mode-20181004.309/racket/command-server.rkt
Normal file
232
elpa/racket-mode-20181004.309/racket/command-server.rkt
Normal file
@@ -0,0 +1,232 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/contract
|
||||
racket/format
|
||||
racket/function
|
||||
racket/lazy-require
|
||||
racket/match
|
||||
racket/set
|
||||
racket/tcp
|
||||
"channel.rkt"
|
||||
"debug.rkt"
|
||||
"elisp.rkt"
|
||||
"interactions.rkt"
|
||||
"md5.rkt"
|
||||
"mod.rkt"
|
||||
"util.rkt")
|
||||
|
||||
(lazy-require
|
||||
["commands/check-syntax.rkt" (check-syntax)]
|
||||
["commands/coverage.rkt" (get-uncovered)]
|
||||
["commands/describe.rkt" (describe type)]
|
||||
["commands/find-module.rkt" (find-module)]
|
||||
["commands/help.rkt" (doc)]
|
||||
["commands/macro.rkt" (macro-stepper macro-stepper/next)]
|
||||
["commands/profile.rkt" (get-profile)]
|
||||
["commands/requires.rkt" (requires/tidy requires/trim requires/base)]
|
||||
["find.rkt" (find-definition)])
|
||||
|
||||
(provide start-command-server
|
||||
attach-command-server
|
||||
make-prompt-read)
|
||||
|
||||
(define drracket:submit-predicate/c (-> input-port? boolean? boolean?))
|
||||
|
||||
(define-struct/contract context
|
||||
([ns namespace?]
|
||||
[maybe-mod (or/c #f mod?)]
|
||||
[md5 string?]
|
||||
[submit-pred (or/c #f drracket:submit-predicate/c)]))
|
||||
|
||||
(define command-server-context (context (make-base-namespace) #f "" #f))
|
||||
|
||||
(define/contract (attach-command-server ns maybe-mod)
|
||||
(-> namespace? (or/c #f mod?) any)
|
||||
(set-debug-repl-namespace! ns)
|
||||
(set! command-server-context
|
||||
(context ns
|
||||
maybe-mod
|
||||
(maybe-mod->md5 maybe-mod)
|
||||
(get-repl-submit-predicate maybe-mod))))
|
||||
|
||||
(define (maybe-mod->md5 m)
|
||||
(define-values (dir file _) (maybe-mod->dir/file/rmp m))
|
||||
(if (and dir file)
|
||||
(file->md5 (build-path dir file))
|
||||
""))
|
||||
|
||||
;; <https://docs.racket-lang.org/tools/lang-languages-customization.html#(part._.R.E.P.L_.Submit_.Predicate)>
|
||||
(define/contract (get-repl-submit-predicate m)
|
||||
(-> (or/c #f mod?) (or/c #f drracket:submit-predicate/c))
|
||||
(define-values (dir file rmp) (maybe-mod->dir/file/rmp m))
|
||||
(define path (and dir file (build-path dir file)))
|
||||
(and path rmp
|
||||
(or (with-handlers ([exn:fail? (λ _ #f)])
|
||||
(match (with-input-from-file (build-path dir file) read-language)
|
||||
[(? procedure? get-info)
|
||||
(match (get-info 'drracket:submit-predicate #f)
|
||||
[#f #f]
|
||||
[v v])]
|
||||
[_ #f]))
|
||||
(with-handlers ([exn:fail? (λ _ #f)])
|
||||
(match (module->language-info rmp #t)
|
||||
[(vector mp name val)
|
||||
(define get-info ((dynamic-require mp name) val))
|
||||
(get-info 'drracket:submit-predicate #f)]
|
||||
[_ #f])))))
|
||||
|
||||
;; The command server accepts a single TCP connection at a time.
|
||||
;;
|
||||
;; Immediately after connecting, the client must send us exactly the
|
||||
;; same '(accept ,random-value) value that it gave us as a command
|
||||
;; line argument when it started us. Else we exit. See issue #327.
|
||||
;;
|
||||
;; Normally Emacs will make only one connection to us, ever. If the
|
||||
;; user exits the REPL, then our entire Racket process exits. (Just in
|
||||
;; case, we have an accept-a-connection loop below. It handles any
|
||||
;; exns -- like exn:network -- not handled during command processing.
|
||||
;; It uses a custodian to clean up.)
|
||||
;;
|
||||
;; Command requests and responses "on the wire" are a subset of valid
|
||||
;; Emacs Lisp s-expressions: See elisp-read and elisp-write.
|
||||
;;
|
||||
;; Command requests are (nonce command param ...).
|
||||
;;
|
||||
;; A thread is spun off to handle each request, so that a long-running
|
||||
;; command won't block others. The nonce supplied with the request is
|
||||
;; returned with the response, so that the client can match the
|
||||
;; response with the request. The nonce needn't be random, just
|
||||
;; unique; an increasing integer is fine.
|
||||
;;
|
||||
;; Command responses are either (nonce 'ok sexp ...+) or (nonce 'error
|
||||
;; "message"). The latter normally can and should be displayed to the
|
||||
;; user in Emacs via error or message. We handle exn:fail? up here;
|
||||
;; generally we're fine letting Racket exceptions percolate up and be
|
||||
;; shown to the user
|
||||
(define (start-command-server port launch-token)
|
||||
(thread
|
||||
(thunk
|
||||
(define listener (tcp-listen port 4 #t "127.0.0.1"))
|
||||
(let accept-a-connection ()
|
||||
(define custodian (make-custodian))
|
||||
(parameterize ([current-custodian custodian])
|
||||
(with-handlers ([exn:fail? void]) ;just disconnect; see #327
|
||||
(define-values (in out) (tcp-accept listener))
|
||||
(unless (or (not launch-token)
|
||||
(equal? launch-token (elisp-read in)))
|
||||
(display-commented "Authorization failed; exiting")
|
||||
(exit 1)) ;see #327
|
||||
(define response-channel (make-channel))
|
||||
(define ((do-command/put-response nonce sexp))
|
||||
(channel-put
|
||||
response-channel
|
||||
(cons
|
||||
nonce
|
||||
(with-handlers ([exn:fail? (λ (e) `(error ,(exn-message e)))])
|
||||
(parameterize ([current-namespace
|
||||
(context-ns command-server-context)])
|
||||
`(ok ,(command sexp command-server-context)))))))
|
||||
(define (get/write-response)
|
||||
(elisp-writeln (sync response-channel
|
||||
debug-notify-channel)
|
||||
out)
|
||||
(flush-output out)
|
||||
(get/write-response))
|
||||
;; With all the pieces defined, let's go:
|
||||
(thread get/write-response)
|
||||
(let read-a-command ()
|
||||
(match (elisp-read in)
|
||||
[(cons nonce sexp) (thread (do-command/put-response nonce sexp))
|
||||
(read-a-command)]
|
||||
[(? eof-object?) (void)])))
|
||||
(custodian-shutdown-all custodian))
|
||||
(accept-a-connection))))
|
||||
(void))
|
||||
|
||||
(define/contract ((make-prompt-read m))
|
||||
(-> (or/c #f mod?) (-> any))
|
||||
(begin0 (get-interaction (maybe-mod->prompt-string m))
|
||||
(next-break 'all))) ;let debug-instrumented code break again
|
||||
|
||||
(define/contract (command sexpr the-context)
|
||||
(-> pair? context? any/c)
|
||||
(match-define (context _ns maybe-mod md5 submit-pred) the-context)
|
||||
(define-values (dir file mod-path) (maybe-mod->dir/file/rmp maybe-mod))
|
||||
(define path (and dir file (build-path dir file)))
|
||||
;; Note: Intentionally no "else" match clause -- let caller handle
|
||||
;; exn and supply a consistent exn response format.
|
||||
(match sexpr
|
||||
[`(run ,what ,mem ,pp? ,ctx ,args ,dbg) (run what mem pp? ctx args dbg)]
|
||||
[`(path+md5) (cons (or path 'top) md5)]
|
||||
[`(syms) (syms)]
|
||||
[`(def ,str) (find-definition str)]
|
||||
[`(mod ,sym) (find-module sym maybe-mod)]
|
||||
[`(describe ,str) (describe str)]
|
||||
[`(doc ,str) (doc str)]
|
||||
[`(type ,v) (type v)]
|
||||
[`(macro-stepper ,str ,into-base?) (macro-stepper str into-base?)]
|
||||
[`(macro-stepper/next) (macro-stepper/next)]
|
||||
[`(requires/tidy ,reqs) (requires/tidy reqs)]
|
||||
[`(requires/trim ,path-str ,reqs) (requires/trim path-str reqs)]
|
||||
[`(requires/base ,path-str ,reqs) (requires/base path-str reqs)]
|
||||
[`(find-collection ,str) (find-collection str)]
|
||||
[`(get-profile) (get-profile)]
|
||||
[`(get-uncovered) (get-uncovered path)]
|
||||
[`(check-syntax ,path-str) (check-syntax path-str)]
|
||||
[`(eval ,v) (eval-command v)]
|
||||
[`(repl-submit? ,str ,eos?) (repl-submit? submit-pred str eos?)]
|
||||
[`(debug-eval ,src ,l ,c ,p ,code) (debug-eval src l c p code)]
|
||||
[`(debug-resume ,v) (debug-resume v)]
|
||||
[`(debug-disable) (debug-disable)]
|
||||
[`(exit) (exit)]))
|
||||
|
||||
;;; A few commands defined here
|
||||
|
||||
(define/contract (run what mem pp ctx args dbgs)
|
||||
(-> list? number? elisp-bool/c context-level? list? (listof path-string?)
|
||||
list?)
|
||||
(define ready-channel (make-channel))
|
||||
(channel-put message-to-main-thread-channel
|
||||
(rerun (->mod/existing what)
|
||||
mem
|
||||
(as-racket-bool pp)
|
||||
ctx
|
||||
(list->vector args)
|
||||
(list->set (map string->path dbgs))
|
||||
(λ () (channel-put ready-channel what))))
|
||||
;; Waiting for this allows the command response to be used as the
|
||||
;; all-clear for additional commands that need the module load to be
|
||||
;; done and entering a REPL for that module. For example, to compose
|
||||
;; run with get-profile or get-uncovered.
|
||||
(sync ready-channel))
|
||||
|
||||
(define/contract (repl-submit? submit-pred text eos)
|
||||
(-> (or/c #f drracket:submit-predicate/c) string? elisp-bool/c (or/c 'default #t #f))
|
||||
(if submit-pred
|
||||
(submit-pred (open-input-string text) (as-racket-bool eos))
|
||||
'default))
|
||||
|
||||
(define (syms)
|
||||
(sort (map symbol->string (namespace-mapped-symbols))
|
||||
string<?))
|
||||
|
||||
;;; eval-commmand
|
||||
|
||||
(define/contract (eval-command str)
|
||||
(-> string? string?)
|
||||
(define results
|
||||
(call-with-values (λ ()
|
||||
((current-eval) (string->namespace-syntax str)))
|
||||
list))
|
||||
(~a (map ~v results) "\n"))
|
||||
|
||||
;;; find-collection
|
||||
|
||||
(define/contract (find-collection str)
|
||||
(-> path-string? (or/c 'find-collection-not-installed #f (listof string?)))
|
||||
(define fcd (with-handlers ([exn:fail:filesystem:missing-module?
|
||||
(λ _ (error 'find-collection
|
||||
"For this to work, you need to `raco pkg install raco-find-collection`."))])
|
||||
(dynamic-require 'find-collection/find-collection
|
||||
'find-collection-dir)))
|
||||
(map path->string (fcd str)))
|
||||
@@ -0,0 +1,61 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/list
|
||||
racket/match
|
||||
racket/path
|
||||
racket/set)
|
||||
|
||||
(provide check-syntax)
|
||||
|
||||
(define check-syntax
|
||||
(let ([show-content
|
||||
(with-handlers ([exn:fail? (λ _ 'not-supported)])
|
||||
(let ([f (dynamic-require 'drracket/check-syntax 'show-content)])
|
||||
;; Ensure correct position info for Unicode like λ.
|
||||
;; show-content probably ought to do this itself, but
|
||||
;; work around that.
|
||||
(λ (path)
|
||||
(parameterize ([port-count-lines-enabled #t])
|
||||
(f path)))))])
|
||||
;; Note: Adjust all positions to 1-based Emacs `point' values.
|
||||
(λ (path-str)
|
||||
(define path (string->path path-str))
|
||||
(parameterize ([current-load-relative-directory (path-only path)])
|
||||
;; Get all the data.
|
||||
(define xs (remove-duplicates (show-content path)))
|
||||
;; Extract the add-mouse-over-status items into a list.
|
||||
(define infos
|
||||
(remove-duplicates
|
||||
(filter values
|
||||
(for/list ([x (in-list xs)])
|
||||
(match x
|
||||
[(vector 'syncheck:add-mouse-over-status beg end str)
|
||||
(list 'info (add1 beg) (add1 end) str)]
|
||||
[_ #f])))))
|
||||
;; Consolidate the add-arrow/name-dup items into a hash table
|
||||
;; with one item per definition. The key is the definition
|
||||
;; position. The value is the set of its uses.
|
||||
(define ht-defs/uses (make-hash))
|
||||
(for ([x (in-list xs)])
|
||||
(match x
|
||||
[(or (vector 'syncheck:add-arrow/name-dup
|
||||
def-beg def-end
|
||||
use-beg use-end
|
||||
_ _ _ _)
|
||||
(vector 'syncheck:add-arrow/name-dup/pxpy
|
||||
def-beg def-end _ _
|
||||
use-beg use-end _ _
|
||||
_ _ _ _))
|
||||
(hash-update! ht-defs/uses
|
||||
(list (add1 def-beg) (add1 def-end))
|
||||
(λ (v) (set-add v (list (add1 use-beg) (add1 use-end))))
|
||||
(set))]
|
||||
[_ #f]))
|
||||
;; Convert the hash table into a list, sorting the usage positions.
|
||||
(define defs/uses
|
||||
(for/list ([(def uses) (in-hash ht-defs/uses)])
|
||||
(match-define (list def-beg def-end) def)
|
||||
(define tweaked-uses (sort (set->list uses) < #:key car))
|
||||
(list 'def/uses def-beg def-end tweaked-uses)))
|
||||
;; Append both lists and print as Elisp values.
|
||||
(append infos defs/uses)))))
|
||||
50
elpa/racket-mode-20181004.309/racket/commands/coverage.rkt
Normal file
50
elpa/racket-mode-20181004.309/racket/commands/coverage.rkt
Normal file
@@ -0,0 +1,50 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/list
|
||||
racket/match
|
||||
(only-in "../instrument.rkt" get-test-coverage-info))
|
||||
|
||||
(provide get-uncovered)
|
||||
|
||||
(define (get-uncovered file)
|
||||
(consolidate-coverage-ranges
|
||||
(for*/list ([x (in-list (get-test-coverage-info))]
|
||||
[covered? (in-value (first x))]
|
||||
#:when (not covered?)
|
||||
[src (in-value (second x))]
|
||||
#:when (equal? file src)
|
||||
[pos (in-value (third x))]
|
||||
[span (in-value (fourth x))])
|
||||
(cons pos (+ pos span)))))
|
||||
|
||||
(define (consolidate-coverage-ranges xs)
|
||||
(remove-duplicates (sort xs < #:key car)
|
||||
same?))
|
||||
|
||||
(define (same? x y)
|
||||
;; Is x a subset of y or vice versa?
|
||||
(match-define (cons x/beg x/end) x)
|
||||
(match-define (cons y/beg y/end) y)
|
||||
(or (and (<= x/beg y/beg) (<= y/end x/end))
|
||||
(and (<= y/beg x/beg) (<= x/end y/end))))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
(check-true (same? '(0 . 9) '(0 . 9)))
|
||||
(check-true (same? '(0 . 9) '(4 . 5)))
|
||||
(check-true (same? '(4 . 5) '(0 . 9)))
|
||||
(check-false (same? '(0 . 1) '(1 . 2)))
|
||||
(check-equal? (consolidate-coverage-ranges
|
||||
'((10 . 20) (10 . 11) (19 . 20) (10 . 20)
|
||||
(20 . 30) (20 . 21) (29 . 30) (20 . 30)))
|
||||
'((10 . 20)
|
||||
(20 . 30)))
|
||||
;; This is a test of actual coverage data I got from one example,
|
||||
;; where the maximal subsets were (164 . 197) and (214. 247).
|
||||
(check-equal?
|
||||
(consolidate-coverage-ranges
|
||||
'((164 . 197) (164 . 197) (164 . 197)
|
||||
(173 . 180) (173 . 180) (173 . 180) (173 . 180) (173 . 180) (187 . 196)
|
||||
(214 . 247) (214 . 247) (214 . 247)
|
||||
(223 . 230) (223 . 230) (223 . 230) (223 . 230) (223 . 230) (237 . 246)))
|
||||
'((164 . 197) (214 . 247))))
|
||||
73
elpa/racket-mode-20181004.309/racket/commands/describe.rkt
Normal file
73
elpa/racket-mode-20181004.309/racket/commands/describe.rkt
Normal file
@@ -0,0 +1,73 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/contract
|
||||
racket/format
|
||||
racket/match
|
||||
racket/port
|
||||
(only-in xml xexpr->string)
|
||||
(only-in "../find.rkt" find-signature)
|
||||
"../scribble.rkt")
|
||||
|
||||
(provide type
|
||||
describe)
|
||||
|
||||
(define (type v)
|
||||
(type-or-sig v))
|
||||
|
||||
(define (type-or-sig v)
|
||||
(or (type-or-contract v)
|
||||
(sig v)
|
||||
""))
|
||||
|
||||
(define (sig v) ;any/c -> (or/c #f string?)
|
||||
(and (symbol? v)
|
||||
(match (find-signature (symbol->string v))
|
||||
[#f #f]
|
||||
[x (~a x)])))
|
||||
|
||||
(define (type-or-contract v) ;any/c -> (or/c #f string?)
|
||||
(or
|
||||
;; 1. Try using Typed Racket's REPL simplified type.
|
||||
(with-handlers ([exn:fail? (λ _ #f)])
|
||||
(match (with-output-to-string
|
||||
(λ ()
|
||||
((current-eval)
|
||||
(cons '#%top-interaction v))))
|
||||
[(pregexp "^- : (.*) \\.\\.\\..*\n" (list _ t)) t]
|
||||
[(pregexp "^- : (.*)\n$" (list _ t)) t]))
|
||||
;; 2. Try to find a contract.
|
||||
(with-handlers ([exn:fail? (λ _ #f)])
|
||||
(parameterize ([error-display-handler (λ _ (void))])
|
||||
((current-eval)
|
||||
(cons '#%top-interaction
|
||||
`(if (has-contract? ,v)
|
||||
(~a (contract-name (value-contract ,v)))
|
||||
(error ""))))))))
|
||||
|
||||
(define (sig-and/or-type stx)
|
||||
(define dat (syntax->datum stx))
|
||||
(define s (sig dat))
|
||||
(define t (type-or-contract stx))
|
||||
(xexpr->string
|
||||
`(div ()
|
||||
(h1 () ,(or s (~a dat)))
|
||||
,(cond [(not (or s t))
|
||||
`(p ()
|
||||
(em () "(Found no documentation, signature, type, or contract.)"))]
|
||||
[t `(pre () ,t)]
|
||||
[else ""])
|
||||
(br ()))))
|
||||
|
||||
;;; describe
|
||||
|
||||
;; If a symbol has installed documentation, display it.
|
||||
;;
|
||||
;; Otherwise, walk the source to find the signature of its definition
|
||||
;; (because the argument names have explanatory value), and also look
|
||||
;; for Typed Racket type or a contract, if any.
|
||||
|
||||
(define/contract (describe str)
|
||||
(-> string? string?)
|
||||
(define stx (namespace-symbol->identifier (string->symbol str)))
|
||||
(or (scribble-doc/html stx)
|
||||
(sig-and/or-type stx)))
|
||||
@@ -0,0 +1,46 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/contract
|
||||
racket/match
|
||||
syntax/modresolve
|
||||
"../mod.rkt")
|
||||
|
||||
(provide find-module)
|
||||
|
||||
(define/contract (find-module str maybe-mod)
|
||||
(-> string? (or/c #f mod?)
|
||||
(or/c #f (list/c path-string? number? number?)))
|
||||
(define-values (dir _file maybe-rmp) (maybe-mod->dir/file/rmp maybe-mod))
|
||||
(parameterize ([current-load-relative-directory dir])
|
||||
(or (mod-loc str maybe-rmp)
|
||||
(mod-loc (string->symbol str) maybe-rmp))))
|
||||
|
||||
(define (mod-loc v maybe-rmp)
|
||||
(match (with-handlers ([exn:fail? (λ _ #f)])
|
||||
(resolve-module-path v maybe-rmp))
|
||||
[(? path-string? path)
|
||||
#:when (file-exists? path)
|
||||
(list (path->string path) 1 0)]
|
||||
[_ #f]))
|
||||
|
||||
(module+ test
|
||||
(require rackunit
|
||||
racket/runtime-path)
|
||||
(define-runtime-path here ".")
|
||||
(let* ([here (simplify-path here)] ;nuke trailing dot
|
||||
;; Examples of finding relative and absolute:
|
||||
[requires.rkt (path->string (build-path here "requires.rkt"))]
|
||||
[pe-racket/string (pregexp "collects/racket/string.rkt$")])
|
||||
;; Examples of having no current module (i.e. plain racket/base
|
||||
;; REPL) and having one ("coverage.rkt").
|
||||
(let ([mod #f])
|
||||
(parameterize ([current-directory here])
|
||||
(check-match (find-module "requires.rkt" mod)
|
||||
(list (== requires.rkt) 1 0))
|
||||
(check-match (find-module "racket/string" mod)
|
||||
(list pe-racket/string 1 0))))
|
||||
(let ([mod (->mod/existing (build-path here "coverage.rkt"))])
|
||||
(check-match (find-module "requires.rkt" mod)
|
||||
(list (== requires.rkt) 1 0))
|
||||
(check-match (find-module "racket/string" mod)
|
||||
(list pe-racket/string 1 0)))))
|
||||
120
elpa/racket-mode-20181004.309/racket/commands/help.rkt
Normal file
120
elpa/racket-mode-20181004.309/racket/commands/help.rkt
Normal file
@@ -0,0 +1,120 @@
|
||||
#lang at-exp racket/base
|
||||
|
||||
(require (only-in help/help-utils find-help)
|
||||
(only-in help/search perform-search)
|
||||
net/url
|
||||
racket/contract
|
||||
racket/match
|
||||
racket/port
|
||||
(only-in "../scribble.rkt" binding->path+anchor))
|
||||
|
||||
(provide doc)
|
||||
|
||||
(define/contract (doc str)
|
||||
(-> string? any)
|
||||
(or (identifier-help (namespace-symbol->identifier (string->symbol str)))
|
||||
(perform-search str)))
|
||||
|
||||
;; It is 2017 therefore it is hard to activate a web browser and show
|
||||
;; an anchor link within a local HTML file.
|
||||
;;
|
||||
;; 1. On macOS `find-help` suffers from the fact that `send-url/file`
|
||||
;; doesn't supply a `browser` arg to `send-url/mac`. This causes it
|
||||
;; to give an "open location" command to osascript. This causes
|
||||
;; macOS to ignore #anchor fragments in the URL. Although the
|
||||
;; correct page will open, it won't be scrolled to the item of
|
||||
;; interest.
|
||||
;;
|
||||
;; 2. Furthermore, `send-url/mac` doesn't use an "activate" command to
|
||||
;; show the browser window (it might be hidden behind Emacs).
|
||||
;;
|
||||
;; Let's pretend it's 2020. If we we're on mac and can determine the
|
||||
;; default browser (from plist files^1), do the equivalent of
|
||||
;; `send-url/mac` but with both desired behaviors.
|
||||
;;
|
||||
;; ^1: This is kludgy because the plist has "bundle IDs" like
|
||||
;; "com.google.chrome" but osascript wants strings like "chrome".
|
||||
|
||||
(module mac-default-browser racket/base
|
||||
(require json
|
||||
racket/match
|
||||
racket/file
|
||||
racket/system)
|
||||
(provide mac-default-browser)
|
||||
|
||||
(define launch-plists
|
||||
'("Library/Preferences/com.apple.LaunchServices/com.apple.launchservices.secure.plist"
|
||||
"Library/Preferences/com.apple.LaunchServices.plist"))
|
||||
|
||||
(define (mac-default-browser)
|
||||
(and (equal? (system-type) 'macosx)
|
||||
(for/or ([plist launch-plists])
|
||||
(match (mac-http-handler (build-path (find-system-path 'home-dir) plist))
|
||||
[#f #f]
|
||||
[(pregexp "^.+\\.(.+?)$" ;after final dot
|
||||
(list _ s)) s]))))
|
||||
|
||||
(define (mac-http-handler plist-path) ;; path? -> (or/c string? #f)
|
||||
(for/or ([h (in-list (hash-ref (read-bplist plist-path) 'LSHandlers '()))])
|
||||
(and (equal? (hash-ref h 'LSHandlerURLScheme #f) "http")
|
||||
(hash-ref h 'LSHandlerRoleAll #f))))
|
||||
|
||||
(define plutil (find-executable-path "plutil" #f))
|
||||
|
||||
(define (read-bplist plist-path) ;path? -> json?
|
||||
(define out-path (make-temporary-file))
|
||||
(begin0
|
||||
(if (system* plutil
|
||||
"-convert" "json"
|
||||
"-o" out-path
|
||||
plist-path)
|
||||
(with-input-from-file out-path read-json)
|
||||
(make-hash))
|
||||
(delete-file out-path))))
|
||||
|
||||
(module browse-file-url/mac racket/base
|
||||
(provide browse-file-url/mac)
|
||||
(require racket/format
|
||||
racket/system)
|
||||
|
||||
(define osascript (find-executable-path "osascript" #f))
|
||||
|
||||
(define (browse-file-url/mac file-url browser)
|
||||
;; Note: Unlike `send-url/mac`, we also do an "activate" to show
|
||||
;; the browser window.
|
||||
(system*
|
||||
osascript
|
||||
"-e"
|
||||
@~a{tell application "@browser" to open location "@file-url" activate})))
|
||||
|
||||
(require 'mac-default-browser
|
||||
'browse-file-url/mac)
|
||||
|
||||
|
||||
(define/contract (identifier-help stx)
|
||||
(-> identifier? boolean?)
|
||||
((if (mac-default-browser)
|
||||
identifier-help/mac
|
||||
identifier-help/other)
|
||||
stx))
|
||||
|
||||
(define/contract (identifier-help/other stx)
|
||||
(-> identifier? boolean?)
|
||||
;; Like `find-help` but returns whether help was found and shown.
|
||||
;; That way, if this returns #f caller knows it could next call
|
||||
;; `perform-search` as Plan B.
|
||||
(with-handlers ([exn:fail? (λ _ #f)])
|
||||
(match (with-output-to-string (λ () (find-help stx)))
|
||||
[(pregexp "Sending to web browser") #t]
|
||||
[_ #f])))
|
||||
|
||||
(define/contract (identifier-help/mac stx)
|
||||
(-> identifier? boolean?)
|
||||
(define-values (path anchor) (binding->path+anchor stx))
|
||||
(and path
|
||||
anchor
|
||||
(let ([path-url (path->url (path->complete-path path))])
|
||||
(browse-file-url/mac
|
||||
(url->string (struct-copy url path-url [fragment anchor]))
|
||||
(mac-default-browser)))
|
||||
#t))
|
||||
125
elpa/racket-mode-20181004.309/racket/commands/macro.rkt
Normal file
125
elpa/racket-mode-20181004.309/racket/commands/macro.rkt
Normal file
@@ -0,0 +1,125 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/contract
|
||||
racket/file
|
||||
racket/format
|
||||
racket/match
|
||||
racket/pretty
|
||||
racket/system
|
||||
"../elisp.rkt"
|
||||
"../syntax.rkt"
|
||||
"../util.rkt")
|
||||
|
||||
(provide macro-stepper
|
||||
macro-stepper/next)
|
||||
|
||||
(define step-thunk/c (-> (cons/c (or/c 'original string? 'final) string?)))
|
||||
(define step-thunk #f)
|
||||
|
||||
(define/contract (make-expr-stepper str)
|
||||
(-> string? step-thunk/c)
|
||||
(define step-num #f)
|
||||
(define last-stx (string->namespace-syntax str))
|
||||
(define (step)
|
||||
(cond [(not step-num)
|
||||
(set! step-num 0)
|
||||
(cons 'original (pretty-format-syntax last-stx))]
|
||||
[else
|
||||
(define this-stx (expand-once last-stx))
|
||||
(cond [(not (equal? (syntax->datum last-stx)
|
||||
(syntax->datum this-stx)))
|
||||
(begin0
|
||||
(cons (~a step-num ": expand-once")
|
||||
(diff-text (pretty-format-syntax last-stx)
|
||||
(pretty-format-syntax this-stx)
|
||||
#:unified 3))
|
||||
(set! last-stx this-stx))]
|
||||
[else
|
||||
(cons 'final (pretty-format-syntax this-stx))])]))
|
||||
step)
|
||||
|
||||
(define/contract (make-file-stepper path into-base?)
|
||||
(-> (and/c path-string? absolute-path?) boolean? step-thunk/c)
|
||||
;; If the dynamic-require fails, just let it bubble up.
|
||||
(define stepper-text (dynamic-require 'macro-debugger/stepper-text 'stepper-text))
|
||||
(define stx (file->syntax path))
|
||||
(define-values (dir _name _dir) (split-path path))
|
||||
(define raw-step (parameterize ([current-load-relative-directory dir])
|
||||
(stepper-text stx
|
||||
(if into-base? (λ _ #t) (not-in-base)))))
|
||||
(define step-num #f)
|
||||
(define step-last-after "")
|
||||
(define/contract (step) step-thunk/c
|
||||
(cond [(not step-num)
|
||||
(set! step-num 0)
|
||||
(cons 'original
|
||||
(pretty-format-syntax stx))]
|
||||
[else
|
||||
(define out (open-output-string))
|
||||
(parameterize ([current-output-port out])
|
||||
(cond [(raw-step 'next)
|
||||
(set! step-num (add1 step-num))
|
||||
(match-define (list title before after)
|
||||
(step-parts (get-output-string out)))
|
||||
(set! step-last-after after)
|
||||
(cons (~a step-num ": " title)
|
||||
(diff-text before after #:unified 3))]
|
||||
[else
|
||||
(cons 'final step-last-after)]))]))
|
||||
step)
|
||||
|
||||
(define/contract (macro-stepper what into-base?)
|
||||
(-> (or/c (cons/c 'expr string?) (cons/c 'file path-string?)) elisp-bool/c
|
||||
(cons/c 'original string?))
|
||||
(set! step-thunk
|
||||
(match what
|
||||
[(cons 'expr str) (make-expr-stepper str)]
|
||||
[(cons 'file path) (make-file-stepper path (as-racket-bool into-base?))]))
|
||||
(macro-stepper/next))
|
||||
|
||||
(define/contract (macro-stepper/next)
|
||||
(-> (cons/c (or/c 'original 'final string?) string?))
|
||||
(unless step-thunk
|
||||
(error 'macro-stepper "Nothing to expand"))
|
||||
(define v (step-thunk))
|
||||
(when (eq? 'final (car v))
|
||||
(set! step-thunk #f))
|
||||
v)
|
||||
|
||||
;; Borrowed from xrepl.
|
||||
(define not-in-base
|
||||
(λ () (let ([base-stxs #f])
|
||||
(unless base-stxs
|
||||
(set! base-stxs ; all ids that are bound to a syntax in racket/base
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(let-values ([(vals stxs) (module->exports 'racket/base)])
|
||||
(map (λ (s) (namespace-symbol->identifier (car s)))
|
||||
(cdr (assq 0 stxs)))))))
|
||||
(λ (id) (not (ormap (λ (s) (free-identifier=? id s)) base-stxs))))))
|
||||
|
||||
(define (step-parts str)
|
||||
(match str
|
||||
[(pregexp "^(.+?)\n(.+?)\n +==>\n(.+?)\n+$"
|
||||
(list _ title before after))
|
||||
(list title before after)]))
|
||||
|
||||
(define (diff-text before-text after-text #:unified [-U 3])
|
||||
(define template "racket-mode-syntax-diff-~a")
|
||||
(define (make-temporary-file-with-text str)
|
||||
(define file (make-temporary-file template))
|
||||
(with-output-to-file file #:mode 'text #:exists 'replace
|
||||
(λ () (displayln str)))
|
||||
file)
|
||||
(define before-file (make-temporary-file-with-text before-text))
|
||||
(define after-file (make-temporary-file-with-text after-text))
|
||||
(define out (open-output-string))
|
||||
(begin0 (parameterize ([current-output-port out])
|
||||
(system (format "diff -U ~a ~a ~a" -U before-file after-file))
|
||||
(match (get-output-string out)
|
||||
["" " <empty diff>\n"]
|
||||
[(pregexp "\n(@@.+@@\n.+)$" (list _ v)) v]))
|
||||
(delete-file before-file)
|
||||
(delete-file after-file)))
|
||||
|
||||
(define (pretty-format-syntax stx)
|
||||
(pretty-format #:mode 'write (syntax->datum stx)))
|
||||
19
elpa/racket-mode-20181004.309/racket/commands/profile.rkt
Normal file
19
elpa/racket-mode-20181004.309/racket/commands/profile.rkt
Normal file
@@ -0,0 +1,19 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/match
|
||||
(only-in "../instrument.rkt" get-profile-info))
|
||||
|
||||
(provide get-profile)
|
||||
|
||||
(define (get-profile)
|
||||
;; TODO: Filter files from racket-mode itself, b/c just noise?
|
||||
(for/list ([x (in-list (get-profile-info))])
|
||||
(match-define (list count msec name stx _ ...) x)
|
||||
(list count
|
||||
msec
|
||||
(and name (symbol->string name))
|
||||
(and (syntax-source stx) (path? (syntax-source stx))
|
||||
(path->string (syntax-source stx)))
|
||||
(syntax-position stx)
|
||||
(and (syntax-position stx) (syntax-span stx)
|
||||
(+ (syntax-position stx) (syntax-span stx))))))
|
||||
276
elpa/racket-mode-20181004.309/racket/commands/requires.rkt
Normal file
276
elpa/racket-mode-20181004.309/racket/commands/requires.rkt
Normal file
@@ -0,0 +1,276 @@
|
||||
#lang at-exp racket/base
|
||||
|
||||
(require (only-in macro-debugger/analysis/check-requires show-requires)
|
||||
racket/format
|
||||
racket/function
|
||||
racket/list
|
||||
racket/match
|
||||
racket/set)
|
||||
|
||||
(provide requires/tidy
|
||||
requires/trim
|
||||
requires/base)
|
||||
|
||||
(module+ test
|
||||
(require rackunit))
|
||||
|
||||
;; requires/tidy : (listof require-sexpr) -> require-sexpr
|
||||
(define (requires/tidy reqs)
|
||||
(let* ([reqs (combine-requires reqs)]
|
||||
[reqs (group-requires reqs)])
|
||||
(require-pretty-format reqs)))
|
||||
|
||||
;; requires/trim : path-string? (listof require-sexpr) -> require-sexpr
|
||||
;;
|
||||
;; Note: Why pass in a list of the existing require forms -- why not
|
||||
;; just use the "keep" list from show-requires? Because the keep list
|
||||
;; only states the module name, not the original form. Therefore if
|
||||
;; the original require has a subform like `(only-in mod f)` (or
|
||||
;; rename-in, except-in, &c), we won't know how to preserve that
|
||||
;; unless we're given it. That's why our strategy must be to look for
|
||||
;; things to drop, as opposed to things to keep.
|
||||
(define (requires/trim path-str reqs)
|
||||
(let* ([reqs (combine-requires reqs)]
|
||||
[sr (show-requires* path-str)]
|
||||
[drops (filter-map (λ (x)
|
||||
(match x
|
||||
[(list 'drop mod lvl) (list mod lvl)]
|
||||
[_ #f]))
|
||||
sr)]
|
||||
[reqs (filter-map (λ (req)
|
||||
(cond [(member req drops) #f]
|
||||
[else req]))
|
||||
reqs)]
|
||||
[reqs (group-requires reqs)])
|
||||
(require-pretty-format reqs)))
|
||||
|
||||
;; Use `bypass` to help convert from `#lang racket` to `#lang
|
||||
;; racket/base` plus explicit requires.
|
||||
;;
|
||||
;; Note: Currently this is hardcoded to `#lang racket`, only.
|
||||
(define (requires/base path-str reqs)
|
||||
(let* ([reqs (combine-requires reqs)]
|
||||
[sr (show-requires* path-str)]
|
||||
[drops (filter-map (λ (x)
|
||||
(match x
|
||||
[(list 'drop mod lvl) (list mod lvl)]
|
||||
[_ #f]))
|
||||
sr)]
|
||||
[adds (append*
|
||||
(filter-map (λ (x)
|
||||
(match x
|
||||
[(list 'bypass 'racket 0
|
||||
(list (list mod lvl _) ...))
|
||||
(filter (λ (x)
|
||||
(match x
|
||||
[(list 'racket/base 0) #f]
|
||||
[_ #t]))
|
||||
(map list mod lvl))]
|
||||
[_ #f]))
|
||||
sr))]
|
||||
[reqs (filter-map (λ (req)
|
||||
(cond [(member req drops) #f]
|
||||
[else req]))
|
||||
reqs)]
|
||||
[reqs (append reqs adds)]
|
||||
[reqs (group-requires reqs)])
|
||||
(require-pretty-format reqs)))
|
||||
|
||||
;; show-requires* : Like show-requires but accepts a path-string? that
|
||||
;; need not already be a module path.
|
||||
(define (show-requires* path-str)
|
||||
(define-values (base name _) (split-path (string->path path-str)))
|
||||
(parameterize ([current-load-relative-directory base]
|
||||
[current-directory base])
|
||||
(show-requires name)))
|
||||
|
||||
(define (combine-requires reqs)
|
||||
(remove-duplicates
|
||||
(append* (for/list ([req reqs])
|
||||
(match req
|
||||
[(list* 'require vs)
|
||||
(append*
|
||||
(for/list ([v vs])
|
||||
;; Use (list mod level), like `show-requires` uses.
|
||||
(match v
|
||||
[(list* 'for-meta level vs) (map (curryr list level) vs)]
|
||||
[(list* 'for-syntax vs) (map (curryr list 1) vs)]
|
||||
[(list* 'for-template vs) (map (curryr list -1) vs)]
|
||||
[(list* 'for-label vs) (map (curryr list #f) vs)]
|
||||
[v (list (list v 0))])))])))))
|
||||
|
||||
(module+ test
|
||||
(check-equal?
|
||||
(combine-requires '((require a b c)
|
||||
(require d e)
|
||||
(require a f)
|
||||
(require (for-syntax s t u) (for-label l0 l1 l2))
|
||||
(require (for-meta 1 m1a m1b)
|
||||
(for-meta 2 m2a m2b))))
|
||||
'((a 0) (b 0) (c 0) (d 0) (e 0) (f 0)
|
||||
(s 1) (t 1) (u 1)
|
||||
(l0 #f) (l1 #f) (l2 #f)
|
||||
(m1a 1) (m1b 1) (m2a 2) (m2b 2))))
|
||||
|
||||
;; Given a list of requires -- each in the (list module level) form
|
||||
;; used by `show-requires` -- group them by level and convert them to
|
||||
;; a Racket `require` form. Also, sort the subforms by phase level:
|
||||
;; for-syntax, for-template, for-label, for-meta, and plain (0).
|
||||
;; Within each such group, sort them first by module paths then
|
||||
;; relative requires. Within each such group, sort alphabetically.
|
||||
(define (group-requires reqs)
|
||||
;; Put the requires into a hash of sets.
|
||||
(define ht (make-hasheq)) ;(hash/c <level> (set <mod>))
|
||||
(for ([req reqs]) (match req
|
||||
[(list mod lvl) (hash-update! ht lvl
|
||||
(lambda (s) (set-add s mod))
|
||||
(set mod))]))
|
||||
(define (mod-set->mod-list mod-set)
|
||||
(sort (set->list mod-set) mod<?))
|
||||
(define (for-level level k)
|
||||
(define mods (hash-ref ht level #f))
|
||||
(cond [mods (k (mod-set->mod-list mods))]
|
||||
[else '()]))
|
||||
(define (preface . pres)
|
||||
(λ (mods) `((,@pres ,@mods))))
|
||||
(define (meta-levels)
|
||||
(sort (for/list ([x (hash-keys ht)] #:when (not (member x '(-1 0 1 #f)))) x)
|
||||
<))
|
||||
`(require
|
||||
,@(for-level 1 (preface 'for-syntax))
|
||||
,@(for-level -1 (preface 'for-template))
|
||||
,@(for-level #f (preface 'for-label))
|
||||
,@(append* (for/list ([level (in-list (meta-levels))])
|
||||
(for-level level (preface 'for-meta level))))
|
||||
,@(for-level 0 values)))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (group-requires
|
||||
(combine-requires
|
||||
'((require z c b a)
|
||||
(require (for-meta 4 m41 m40))
|
||||
(require (for-meta -4 m-41 m-40))
|
||||
(require (for-label l1 l0))
|
||||
(require (for-template t1 t0))
|
||||
(require (for-syntax s1 s0))
|
||||
(require "a.rkt" "b.rkt" "c.rkt" "z.rkt"
|
||||
(only-in "mod.rkt" oi)
|
||||
(only-in mod oi)))))
|
||||
'(require
|
||||
(for-syntax s0 s1)
|
||||
(for-template t0 t1)
|
||||
(for-label l0 l1)
|
||||
(for-meta -4 m-40 m-41)
|
||||
(for-meta 4 m40 m41)
|
||||
a b c (only-in mod oi) z
|
||||
"a.rkt" "b.rkt" "c.rkt" (only-in "mod.rkt" oi) "z.rkt")))
|
||||
|
||||
(define (mod<? a b)
|
||||
(define (key x)
|
||||
(match x
|
||||
[(list 'only-in m _ ...) (key m)]
|
||||
[(list 'except-in m _ ...) (key m)]
|
||||
[(list 'prefix-in _ m) (key m)]
|
||||
[(list 'relative-in _ m _ ...) (key m)]
|
||||
[m m]))
|
||||
(let ([a (key a)]
|
||||
[b (key b)])
|
||||
(or (and (symbol? a) (not (symbol? b)))
|
||||
(and (list? a) (not (list? b)))
|
||||
(and (not (string? a)) (string? a))
|
||||
(and (string? a) (string? b)
|
||||
(string<? a b))
|
||||
(and (symbol? a) (symbol? b)
|
||||
(string<? (symbol->string a) (symbol->string b))))))
|
||||
|
||||
(module+ test
|
||||
(check-true (mod<? 'a 'b))
|
||||
(check-false (mod<? 'b 'a))
|
||||
(check-true (mod<? 'a '(only-in b)))
|
||||
(check-true (mod<? '(only-in a) 'b))
|
||||
(check-true (mod<? 'a '(except-in b)))
|
||||
(check-true (mod<? '(except-in a) 'b))
|
||||
(check-true (mod<? 'a '(prefix-in p 'b)))
|
||||
(check-true (mod<? '(prefix-in p 'a) 'b))
|
||||
(check-true (mod<? 'a '(relative-in p 'b)))
|
||||
(check-true (mod<? '(relative-in p 'a) 'b))
|
||||
(check-true (mod<? 'a '(prefix-in p (only-in b))))
|
||||
(check-true (mod<? '(prefix-in p (only-in a)) 'b)))
|
||||
|
||||
;; require-pretty-format : list? -> string?
|
||||
(define (require-pretty-format x)
|
||||
(define out (open-output-string))
|
||||
(parameterize ([current-output-port out])
|
||||
(require-pretty-print x))
|
||||
(get-output-string out))
|
||||
|
||||
(module+ test
|
||||
(check-equal? (require-pretty-format
|
||||
'(require a))
|
||||
@~a{(require a)
|
||||
|
||||
})
|
||||
(check-equal? (require-pretty-format
|
||||
'(require a b))
|
||||
@~a{(require a
|
||||
b)
|
||||
|
||||
})
|
||||
(check-equal? (require-pretty-format
|
||||
'(require (for-syntax a b) (for-meta 2 c d) e f))
|
||||
@~a{(require (for-syntax a
|
||||
b)
|
||||
(for-meta 2 c
|
||||
d)
|
||||
e
|
||||
f)
|
||||
|
||||
})
|
||||
(check-equal? (require-pretty-format
|
||||
`(require (only-in m a b) (except-in m a b)))
|
||||
@~a{(require (only-in m
|
||||
a
|
||||
b)
|
||||
(except-in m
|
||||
a
|
||||
b))
|
||||
|
||||
}))
|
||||
|
||||
;; Pretty print a require form with one module per line and with
|
||||
;; indentation for the `for-X` subforms. Example:
|
||||
;;
|
||||
;; (require (for-syntax racket/base
|
||||
;; syntax/parse)
|
||||
;; (for-meta 3 racket/a
|
||||
;; racket/b)
|
||||
;; racket/format
|
||||
;; racket/string
|
||||
;; "a.rkt"
|
||||
;; "b.rkt")
|
||||
(define (require-pretty-print x)
|
||||
(define (prn x first? indent)
|
||||
(define (indent-string)
|
||||
(if first? "" (make-string indent #\space)))
|
||||
(define (prn-form pre this more)
|
||||
(define new-indent (+ indent (+ 2 (string-length pre))))
|
||||
(printf "~a(~a " (indent-string) pre)
|
||||
(prn this #t new-indent)
|
||||
(for ([x more])
|
||||
(newline)
|
||||
(prn x #f new-indent))
|
||||
(display ")"))
|
||||
(match x
|
||||
[(list 'require)
|
||||
(void)]
|
||||
[(list* (and pre (or 'require 'for-syntax 'for-template 'for-label
|
||||
'only-in 'except-in))
|
||||
this more)
|
||||
(prn-form (format "~s" pre) this more)
|
||||
(when (eq? pre 'require)
|
||||
(newline))]
|
||||
[(list* 'for-meta level this more)
|
||||
(prn-form (format "for-meta ~a" level) this more)]
|
||||
[this
|
||||
(printf "~a~s" (indent-string) this)]))
|
||||
(prn x #t 0))
|
||||
381
elpa/racket-mode-20181004.309/racket/debug-annotator.rkt
Normal file
381
elpa/racket-mode-20181004.309/racket/debug-annotator.rkt
Normal file
@@ -0,0 +1,381 @@
|
||||
#lang racket/base
|
||||
|
||||
(require (for-syntax racket/base)
|
||||
gui-debugger/marks
|
||||
(only-in mzscheme [apply plain-apply])
|
||||
(prefix-in kernel: syntax/kerncase))
|
||||
|
||||
;; This is like gui-debugger/annotate except:
|
||||
;;
|
||||
;; 0. Our annotate-stx does NOT add breaks to syntax sources not
|
||||
;; matching the syntax it is given. See
|
||||
;; https://github.com/racket/drracket/issues/230 and below.
|
||||
;;
|
||||
;; 1. Our module-annotate disarms/rearms module level expressions. See
|
||||
;; https://github.com/racket/drracket/issues/231 and below.
|
||||
;;
|
||||
;; 2. "Modernize": Use racket/base not racket/scheme. Don't need
|
||||
;; opt-lambda.
|
||||
;;
|
||||
;; 3. We remove the record-bound-id and record-top-level-id callbacks
|
||||
;; that we don't use, from annotate-for-single-stepping (but leave
|
||||
;; them for now in annotate-stx).
|
||||
;;
|
||||
;; 4. We remove the source arg that is completely unused (I'm guessing
|
||||
;; historical).
|
||||
|
||||
(provide annotate-for-single-stepping)
|
||||
|
||||
(define (annotate-for-single-stepping stx break? break-before break-after)
|
||||
(define (break-wrap debug-info annotated raw is-tail?)
|
||||
(let* ([start (syntax-position raw)]
|
||||
[end (+ start (syntax-span raw) -1)]
|
||||
[break? (break? (syntax-source raw))])
|
||||
(if is-tail?
|
||||
#`(let-values ([(value-list) #f])
|
||||
(if (#%plain-app #,break? #,start)
|
||||
(set! value-list (#%plain-app
|
||||
#,break-before
|
||||
#,debug-info
|
||||
(#%plain-app current-continuation-marks)))
|
||||
(#%plain-app void))
|
||||
(if (#%plain-app not value-list)
|
||||
#,annotated
|
||||
(#%plain-app plain-apply values value-list)))
|
||||
#`(let-values ([(value-list) #f])
|
||||
(if (#%plain-app #,break? #,start)
|
||||
(set! value-list (#%plain-app
|
||||
#,break-before
|
||||
#,debug-info
|
||||
(#%plain-app current-continuation-marks)))
|
||||
(#%plain-app void))
|
||||
(if (#%plain-app not value-list)
|
||||
(#%plain-app
|
||||
call-with-values
|
||||
(#%plain-lambda () #,annotated)
|
||||
(case-lambda
|
||||
[(val) (if (#%plain-app #,break? #,end)
|
||||
(#%plain-app
|
||||
#,break-after
|
||||
#,debug-info
|
||||
(#%plain-app current-continuation-marks)
|
||||
val)
|
||||
val)]
|
||||
[vals (if (#%plain-app
|
||||
#,break? #,end)
|
||||
(#%plain-app
|
||||
plain-apply
|
||||
#,break-after
|
||||
#,debug-info
|
||||
(#%plain-app current-continuation-marks)
|
||||
vals)
|
||||
(#%plain-app plain-apply values vals))]))
|
||||
(if (#%plain-app #,break? #,end)
|
||||
(#%plain-app
|
||||
plain-apply #,break-after
|
||||
#,debug-info
|
||||
(#%plain-app current-continuation-marks)
|
||||
value-list)
|
||||
(#%plain-app plain-apply values value-list)))))))
|
||||
(annotate-stx stx break-wrap))
|
||||
|
||||
(define (annotate-stx stx break-wrap [record-bound-id void] [record-top-level-id void])
|
||||
(define breakpoints (make-hasheq))
|
||||
|
||||
(define (previous-bindings bound-vars)
|
||||
(if (null? bound-vars)
|
||||
#'null
|
||||
#'(#%plain-app debugger-local-bindings)))
|
||||
|
||||
(define (top-level-annotate stx)
|
||||
(kernel:kernel-syntax-case/phase
|
||||
stx (namespace-base-phase)
|
||||
[(module identifier name mb)
|
||||
(module-annotate stx)]
|
||||
[else-stx
|
||||
(general-top-level-expr-iterator stx #f)]))
|
||||
|
||||
(define (module-annotate stx)
|
||||
(syntax-case stx ()
|
||||
[(_ identifier name mb)
|
||||
(syntax-case (disarm #'mb) ()
|
||||
[(plain-module-begin . module-level-exprs)
|
||||
(with-syntax ([(module . _) stx])
|
||||
(quasisyntax/loc stx
|
||||
(module identifier name
|
||||
#,(rearm
|
||||
#'mb
|
||||
#`(plain-module-begin
|
||||
#,@(map (lambda (e)
|
||||
;; https://github.com/racket/drracket/issues/231
|
||||
(rearm
|
||||
e
|
||||
(module-level-expr-iterator
|
||||
(disarm e)
|
||||
(list (syntax-e #'identifier)
|
||||
(syntax-source #'identifier)))))
|
||||
(syntax->list #'module-level-exprs)))))))])]))
|
||||
|
||||
(define (module-level-expr-iterator stx module-name)
|
||||
(kernel:kernel-syntax-case
|
||||
stx #f
|
||||
[(#%provide . provide-specs)
|
||||
stx]
|
||||
[(#%declare . declare-specs)
|
||||
stx]
|
||||
[else-stx
|
||||
(general-top-level-expr-iterator stx module-name)]))
|
||||
|
||||
(define (general-top-level-expr-iterator stx module-name)
|
||||
(kernel:kernel-syntax-case
|
||||
stx #f
|
||||
[(define-values (var ...) expr)
|
||||
(begin
|
||||
(for-each (lambda (v) (record-bound-id 'bind v v))
|
||||
(syntax->list #'(var ...)))
|
||||
(quasisyntax/loc stx
|
||||
(begin
|
||||
(define-values (var ...) #,(annotate #`expr '() #t module-name))
|
||||
#,(if (syntax-source stx)
|
||||
#`(begin (#%plain-app
|
||||
#,record-top-level-id '#,module-name #'var
|
||||
(case-lambda
|
||||
[() var]
|
||||
[(v) (set! var v)])) ...)
|
||||
#'(#%plain-app void))
|
||||
(#%plain-app void))))]
|
||||
[(define-syntaxes (var ...) expr)
|
||||
stx]
|
||||
[(begin-for-syntax . exprs)
|
||||
;; compile time, so treat it like define-syntaxes
|
||||
stx]
|
||||
[(begin . top-level-exprs)
|
||||
(quasisyntax/loc stx
|
||||
(begin #,@(map (lambda (expr)
|
||||
(module-level-expr-iterator expr module-name))
|
||||
(syntax->list #'top-level-exprs))))]
|
||||
[(#%require . require-specs)
|
||||
stx]
|
||||
[(module . _)
|
||||
;; a submodule:
|
||||
(module-annotate stx)]
|
||||
[(module* . _)
|
||||
;; a submodule:
|
||||
(module-annotate stx)]
|
||||
[else
|
||||
(annotate stx '() #f module-name)]))
|
||||
|
||||
(define (annotate expr bound-vars is-tail? module-name)
|
||||
|
||||
(define annotate-break?
|
||||
(let ([pos (syntax-position expr)]
|
||||
[src (syntax-source expr)])
|
||||
(and src pos
|
||||
;; https://github.com/racket/drracket/issues/230
|
||||
(equal? src (syntax-source stx))
|
||||
(hash-ref breakpoints pos (lambda () #t))
|
||||
(kernel:kernel-syntax-case
|
||||
expr #f
|
||||
[(if test then else) #t]
|
||||
[(begin . bodies) #t]
|
||||
[(begin0 . bodies) #t]
|
||||
[(let-values . clause) #t]
|
||||
[(letrec-values . clause) #t]
|
||||
[(set! var val) #t]
|
||||
[(with-continuation-mark key mark body) #t]
|
||||
[(#%plain-app . exprs) #t]
|
||||
[_ #f])
|
||||
(begin
|
||||
(hash-set! breakpoints pos #f)
|
||||
(when (not is-tail?)
|
||||
(hash-set! breakpoints (+ pos (syntax-span expr) -1) #f))
|
||||
#t))))
|
||||
|
||||
(define (let/rec-values-annotator letrec?)
|
||||
(kernel:kernel-syntax-case
|
||||
(disarm expr) #f
|
||||
[(label (((var ...) rhs) ...) . bodies)
|
||||
(let* ([new-bindings (apply append
|
||||
(map syntax->list
|
||||
(syntax->list #`((var ...) ...))))]
|
||||
[all-bindings (append new-bindings bound-vars)]
|
||||
[new-rhs (map (lambda (expr)
|
||||
(annotate expr
|
||||
(if letrec? all-bindings bound-vars)
|
||||
#f module-name))
|
||||
(syntax->list #'(rhs ...)))]
|
||||
[last-body (car (reverse (syntax->list #'bodies)))]
|
||||
[all-but-last-body (reverse (cdr (reverse (syntax->list #'bodies))))]
|
||||
[bodies (append (map (lambda (expr)
|
||||
(annotate expr all-bindings #f module-name))
|
||||
all-but-last-body)
|
||||
(list (annotate
|
||||
last-body
|
||||
all-bindings
|
||||
is-tail? module-name)))]
|
||||
[local-debug-info (assemble-debug-info new-bindings new-bindings 'normal #f)]
|
||||
[previous-bindings (previous-bindings bound-vars)])
|
||||
(for-each (lambda (id) (record-bound-id 'bind id id)) new-bindings)
|
||||
(with-syntax ([(new-rhs/trans ...) new-rhs]
|
||||
[previous-bindings previous-bindings])
|
||||
(if letrec?
|
||||
(quasisyntax/loc expr
|
||||
(let ([old-bindings previous-bindings])
|
||||
(label (((debugger-local-bindings)
|
||||
(#%plain-lambda ()
|
||||
(#%plain-app
|
||||
list*
|
||||
#,@local-debug-info
|
||||
old-bindings)))
|
||||
((var ...) new-rhs/trans) ...)
|
||||
#,@bodies)))
|
||||
(quasisyntax/loc expr
|
||||
(label (((var ...) new-rhs/trans) ...)
|
||||
(let ([debugger-local-bindings
|
||||
(#%plain-lambda ()
|
||||
(#%plain-app
|
||||
list*
|
||||
#,@local-debug-info
|
||||
previous-bindings))])
|
||||
#,@bodies))))))]))
|
||||
|
||||
(define (lambda-clause-annotator clause)
|
||||
(kernel:kernel-syntax-case
|
||||
clause #f
|
||||
[(arg-list . bodies)
|
||||
(let* ([new-bound-vars (arglist-bindings #'arg-list)]
|
||||
[all-bound-vars (append new-bound-vars bound-vars)]
|
||||
[new-bodies (let loop ([bodies (syntax->list #'bodies)])
|
||||
(if (equal? '() (cdr bodies))
|
||||
(list (annotate (car bodies) all-bound-vars #t module-name))
|
||||
(cons (annotate (car bodies) all-bound-vars #f module-name)
|
||||
(loop (cdr bodies)))))])
|
||||
(for-each (lambda (id) (record-bound-id 'bind id id)) new-bound-vars)
|
||||
(quasisyntax/loc clause
|
||||
(arg-list
|
||||
(let ([debugger-local-bindings
|
||||
(#%plain-lambda ()
|
||||
(#%plain-app
|
||||
list*
|
||||
#,@(assemble-debug-info new-bound-vars new-bound-vars 'normal #f)
|
||||
#,(previous-bindings bound-vars)))])
|
||||
#,@new-bodies))))]))
|
||||
|
||||
(define annotated
|
||||
(rearm
|
||||
expr
|
||||
(kernel:kernel-syntax-case
|
||||
(disarm expr) #f
|
||||
[var-stx (identifier? (syntax var-stx))
|
||||
(let ([binder (and (syntax-original? expr)
|
||||
(member expr bound-vars free-identifier=?))])
|
||||
(if binder
|
||||
(record-bound-id 'ref expr (car binder))
|
||||
(record-bound-id 'top-level expr expr))
|
||||
expr)]
|
||||
|
||||
[(#%plain-lambda . clause)
|
||||
(quasisyntax/loc expr
|
||||
(#%plain-lambda #,@(lambda-clause-annotator #'clause)))]
|
||||
|
||||
[(case-lambda . clauses)
|
||||
(quasisyntax/loc expr
|
||||
(case-lambda #,@(map lambda-clause-annotator (syntax->list #'clauses))))]
|
||||
|
||||
[(if test then else)
|
||||
(quasisyntax/loc expr
|
||||
(if #,(annotate #'test bound-vars #f module-name)
|
||||
#,(annotate #'then bound-vars is-tail? module-name)
|
||||
#,(annotate #'else bound-vars is-tail? module-name)))]
|
||||
|
||||
[(begin . bodies)
|
||||
(letrec ([traverse
|
||||
(lambda (lst)
|
||||
(if (and (pair? lst) (equal? '() (cdr lst)))
|
||||
`(,(annotate (car lst) bound-vars is-tail? module-name))
|
||||
(cons (annotate (car lst) bound-vars #f module-name)
|
||||
(traverse (cdr lst)))))])
|
||||
(quasisyntax/loc expr
|
||||
(begin #,@(traverse (syntax->list #'bodies)))))]
|
||||
|
||||
|
||||
[(begin0 body)
|
||||
(quasisyntax/loc expr
|
||||
(begin0 #,(annotate #'body bound-vars #t module-name)))]
|
||||
|
||||
[(begin0 . bodies)
|
||||
(quasisyntax/loc expr
|
||||
(begin0 #,@(map (lambda (expr)
|
||||
(annotate expr bound-vars #f module-name))
|
||||
(syntax->list #'bodies))))]
|
||||
|
||||
[(let-values . clause)
|
||||
(let/rec-values-annotator #f)]
|
||||
|
||||
[(letrec-values . clause)
|
||||
(let/rec-values-annotator #t)]
|
||||
|
||||
[(set! var val)
|
||||
(let ([binder (and (syntax-original? #'var)
|
||||
(member #'var bound-vars free-identifier=?))])
|
||||
(when binder
|
||||
(record-bound-id 'set expr (car binder)))
|
||||
(quasisyntax/loc expr
|
||||
(set! var #,(annotate #`val bound-vars #f module-name))))]
|
||||
|
||||
[(quote _) expr]
|
||||
|
||||
[(quote-syntax _) expr]
|
||||
|
||||
[(quote-syntax _ #:local) expr]
|
||||
|
||||
[(with-continuation-mark key mark body)
|
||||
(quasisyntax/loc expr
|
||||
(with-continuation-mark key
|
||||
#,(annotate #'mark bound-vars #f module-name)
|
||||
#,(annotate #'body bound-vars is-tail? module-name)))]
|
||||
|
||||
[(#%plain-app . exprs)
|
||||
(let ([subexprs (map (lambda (expr)
|
||||
(annotate expr bound-vars #f module-name))
|
||||
(syntax->list #'exprs))])
|
||||
(if (or is-tail? (not (syntax-source expr)))
|
||||
(quasisyntax/loc expr (#%plain-app . #,subexprs))
|
||||
(wcm-wrap (make-debug-info module-name expr
|
||||
bound-vars bound-vars
|
||||
'normal #f (previous-bindings bound-vars))
|
||||
(quasisyntax/loc expr
|
||||
(#%plain-app . #,subexprs)))))]
|
||||
|
||||
[(#%top . var) expr]
|
||||
[(#%variable-reference . _) expr]
|
||||
|
||||
[else (error 'expr-syntax-object-iterator "unknown expr: ~a"
|
||||
(syntax->datum expr))])))
|
||||
|
||||
(if annotate-break?
|
||||
(break-wrap
|
||||
(make-debug-info module-name expr bound-vars bound-vars
|
||||
'at-break #f (previous-bindings bound-vars))
|
||||
annotated
|
||||
expr
|
||||
is-tail?)
|
||||
annotated))
|
||||
|
||||
(values (top-level-annotate stx) (hash-map breakpoints (lambda (k v) k))))
|
||||
|
||||
(define (arglist-bindings arglist-stx)
|
||||
(syntax-case arglist-stx ()
|
||||
[var
|
||||
(identifier? arglist-stx)
|
||||
(list arglist-stx)]
|
||||
[(var ...)
|
||||
(syntax->list arglist-stx)]
|
||||
[(var . others)
|
||||
(cons #'var (arglist-bindings #'others))]))
|
||||
|
||||
(define (disarm stx) (syntax-disarm stx code-insp))
|
||||
(define (rearm old new) (syntax-rearm new old))
|
||||
|
||||
(define code-insp (variable-reference->module-declaration-inspector
|
||||
(#%variable-reference)))
|
||||
309
elpa/racket-mode-20181004.309/racket/debug.rkt
Normal file
309
elpa/racket-mode-20181004.309/racket/debug.rkt
Normal file
@@ -0,0 +1,309 @@
|
||||
#lang racket/base
|
||||
|
||||
(require (for-syntax racket/base)
|
||||
gui-debugger/marks
|
||||
racket/contract
|
||||
racket/format
|
||||
racket/lazy-require
|
||||
racket/list
|
||||
racket/match
|
||||
racket/set
|
||||
racket/string
|
||||
syntax/modread
|
||||
"interactions.rkt"
|
||||
"util.rkt")
|
||||
|
||||
(lazy-require ["debug-annotator.rkt" (annotate-for-single-stepping)])
|
||||
|
||||
(provide (rename-out [on-break-channel debug-notify-channel])
|
||||
debug-eval
|
||||
debug-resume
|
||||
debug-disable
|
||||
make-debug-eval-handler
|
||||
next-break
|
||||
set-debug-repl-namespace!)
|
||||
|
||||
(define debug-repl-ns (make-base-namespace))
|
||||
(define (set-debug-repl-namespace! ns)
|
||||
(set! debug-repl-ns ns))
|
||||
|
||||
;; A gui-debugger/marks "mark" is a thunk that returns a
|
||||
;; full-mark-struct -- although gui-debugger/marks doesn't provide
|
||||
;; that struct. Instead the thunk can be passed to various accessor
|
||||
;; functions.
|
||||
(define mark/c (-> any/c))
|
||||
|
||||
;; A "mark-binding" is a list whose first element is syntax of the
|
||||
;; identifier, and whose second element is a get/set! procedure.
|
||||
(define get/set!/c (case-> (-> any/c)
|
||||
(-> any/c void)))
|
||||
|
||||
(define breakable-positions/c (hash/c path? (set/c #:cmp 'eq pos/c)))
|
||||
(define/contract breakable-positions breakable-positions/c (make-hash))
|
||||
(define/contract (breakable-position? src pos)
|
||||
(-> path? pos/c boolean?)
|
||||
(set-member? (hash-ref breakable-positions src (seteq)) pos))
|
||||
|
||||
(define/contract (annotate stx)
|
||||
(-> syntax? syntax?)
|
||||
(define source (syntax-source stx))
|
||||
(display-commented (format "Debug annotate ~v" source))
|
||||
(define-values (annotated breakables)
|
||||
(annotate-for-single-stepping stx break? break-before break-after))
|
||||
(hash-update! breakable-positions
|
||||
source
|
||||
(λ (s) (set-union s (list->seteq breakables)))
|
||||
(seteq))
|
||||
annotated)
|
||||
|
||||
(define break-when/c (or/c 'all 'none (cons/c path-string? pos/c)))
|
||||
(define/contract next-break
|
||||
(case-> (-> break-when/c)
|
||||
(-> break-when/c void))
|
||||
(let ([v 'none])
|
||||
(case-lambda [() v]
|
||||
[(v!) (set! v v!)])))
|
||||
|
||||
;; If this returns #t, either break-before or break-after will be
|
||||
;; called next.
|
||||
(define ((break? src) pos)
|
||||
(match (next-break)
|
||||
['none #f]
|
||||
['all #t]
|
||||
[(cons (== src) (== pos)) #t]
|
||||
[_ #f]))
|
||||
|
||||
(define/contract (break-before top-mark ccm)
|
||||
(-> mark/c continuation-mark-set? (or/c #f (listof any/c)))
|
||||
(break 'before top-mark ccm #f))
|
||||
|
||||
(define/contract (break-after top-mark ccm . vals)
|
||||
(->* (mark/c continuation-mark-set?) #:rest (listof any/c)
|
||||
any)
|
||||
(apply values (break 'after top-mark ccm vals)))
|
||||
|
||||
(define/contract (break before/after top-mark ccm vals)
|
||||
(-> (or/c 'before 'after) mark/c continuation-mark-set? (or/c #f (listof any/c))
|
||||
(or/c #f (listof any/c)))
|
||||
(define stx (mark-source top-mark))
|
||||
(define src (syntax-source stx))
|
||||
(define pos (case before/after
|
||||
[(before) (syntax-position stx)]
|
||||
[(after) (+ (syntax-position stx) (syntax-span stx) -1)]))
|
||||
(define locals
|
||||
(for*/list ([binding (in-list (mark-bindings top-mark))]
|
||||
[stx (in-value (first binding))]
|
||||
[get/set! (in-value (second binding))]
|
||||
#:when (and (syntax-original? stx) (syntax-source stx)))
|
||||
(list (syntax-source stx)
|
||||
(syntax-position stx)
|
||||
(syntax-span stx)
|
||||
(syntax->datum stx)
|
||||
(~v (get/set!)))))
|
||||
;; Start a debug repl on its own thread, because below we're going to
|
||||
;; block indefinitely with (channel-get on-resume-channel), waiting for
|
||||
;; the Emacs front end to issue a debug-resume command.
|
||||
(define repl-thread (parameterize ([current-namespace debug-repl-ns])
|
||||
(thread (repl src pos top-mark))))
|
||||
;; The on-break-channel is how we notify the Emacs front-end. This
|
||||
;; is a synchronous channel-put but it should return fairly quickly,
|
||||
;; as soon as the TCP command server gets and writes it. In other
|
||||
;; words, this is sent as a notification, unlike a command response
|
||||
;; as a result of a request.
|
||||
(define this-break-id (new-break-id))
|
||||
(channel-put on-break-channel
|
||||
(list 'debug-break
|
||||
(cons src pos)
|
||||
breakable-positions
|
||||
locals
|
||||
(cons this-break-id
|
||||
(case before/after
|
||||
[(before) (list 'before)]
|
||||
[(after) (list 'after (~s vals))]))))
|
||||
;; Wait for debug-resume command to put to on-resume-channel. If
|
||||
;; wrong break ID, ignore and wait again. Note that some Racket
|
||||
;; values are non-serializable -- e.g. #<output-port> -- in which
|
||||
;; case just eat the exn:fail:read and use the original `vals`.
|
||||
(let wait ()
|
||||
(begin0
|
||||
(match (channel-get on-resume-channel)
|
||||
[(list break-when (list (== this-break-id) 'before))
|
||||
(next-break (calc-next-break before/after break-when top-mark ccm))
|
||||
#f]
|
||||
[(list break-when (list (== this-break-id) (or 'before 'after) vals-str))
|
||||
(next-break (calc-next-break before/after break-when top-mark ccm))
|
||||
(with-handlers ([exn:fail:read? (λ _ vals)])
|
||||
(read (open-input-string vals-str)))]
|
||||
[_ (wait)])
|
||||
(kill-thread repl-thread)
|
||||
(newline))))
|
||||
|
||||
(define/contract (calc-next-break before/after break-when top-mark ccm)
|
||||
(-> (or/c 'before 'after) (or/c break-when/c 'over 'out) mark/c continuation-mark-set?
|
||||
any)
|
||||
(define (big-step frames)
|
||||
(define num-marks (length (debug-marks (current-continuation-marks))))
|
||||
(or (for/or ([frame (in-list frames)]
|
||||
[depth (in-range (length frames) -1 -1)]
|
||||
#:when (<= num-marks depth))
|
||||
(let* ([stx (mark-source frame)]
|
||||
[src (syntax-source stx)]
|
||||
[left (syntax-position stx)]
|
||||
[right (and left (+ left (syntax-span stx) -1))])
|
||||
(and right
|
||||
(breakable-position? src right)
|
||||
(cons src right))))
|
||||
'all))
|
||||
(match* [break-when before/after]
|
||||
[['out _] (big-step (debug-marks ccm))]
|
||||
[['over 'before] (big-step (cons top-mark (debug-marks ccm)))]
|
||||
[['over 'after] 'all]
|
||||
[[v _] v]))
|
||||
|
||||
(define break-id/c nat/c)
|
||||
(define/contract new-break-id
|
||||
(-> break-id/c)
|
||||
(let ([n 0]) (λ () (begin0 n (set! n (add1 n))))))
|
||||
|
||||
(define/contract (debug-marks ccm)
|
||||
(-> continuation-mark-set? (listof mark/c))
|
||||
(continuation-mark-set->list ccm debug-key))
|
||||
|
||||
|
||||
;;; Debug REPL
|
||||
|
||||
(define ((repl src pos top-mark))
|
||||
(parameterize ([current-prompt-read (make-prompt-read src pos top-mark)])
|
||||
(read-eval-print-loop)))
|
||||
|
||||
(define ((make-prompt-read src pos top-mark))
|
||||
(define-values (_base name _dir) (split-path src))
|
||||
(define stx (get-interaction (format "[~a:~a]" name pos)))
|
||||
(with-locals stx (mark-bindings top-mark)))
|
||||
|
||||
(define (with-locals stx bindings)
|
||||
;; Note that mark-bindings is ordered from inner to outer scopes --
|
||||
;; and can include outer variables shadowed by inner ones. So use
|
||||
;; only the first occurence of each identifier symbol we encounter.
|
||||
;; e.g. in (let ([x _]) (let ([x _]) ___)) we want only the inner x.
|
||||
(define ht (make-hasheq))
|
||||
(for* ([binding (in-list bindings)]
|
||||
[sym (in-value (syntax->datum (first binding)))]
|
||||
#:unless (hash-has-key? ht sym)
|
||||
[get/set! (in-value (second binding))])
|
||||
(hash-set! ht sym get/set!))
|
||||
(syntax-case stx ()
|
||||
;; I couldn't figure out how to get a set! transformer to work for
|
||||
;; Typed Racket -- how to annotate or cast a get/set! as (-> Any
|
||||
;; Void). So instead, just intercept (set! id e) as a datum and
|
||||
;; effectively (get/set! (eval e debug-repl-ns)) here. In other
|
||||
;; words treat the stx like a REPL "command". Of course this
|
||||
;; totally bypasses type-checking, but this is a debugger. YOLO!
|
||||
[(set! id e)
|
||||
(and (module-declared? 'typed/racket/base)
|
||||
(eq? 'set! (syntax->datum #'set!))
|
||||
(identifier? #'id)
|
||||
(hash-has-key? ht (syntax->datum #'id)))
|
||||
(let ([set (hash-ref ht (syntax->datum #'id))]
|
||||
[v (eval #'e debug-repl-ns)])
|
||||
(set v)
|
||||
#`(void))]
|
||||
;; Wrap stx in a let-syntax form with a make-set!-transformer for
|
||||
;; every local variable in the mark-bindings results.
|
||||
[_
|
||||
(let ([syntax-bindings
|
||||
(for/list ([(sym get/set!) (in-hash ht)])
|
||||
(define id (datum->syntax #f sym))
|
||||
(define xform
|
||||
(make-set!-transformer
|
||||
(λ (stx)
|
||||
(syntax-case stx (set!)
|
||||
[(set! id v) (identifier? #'id) #`(#%plain-app #,get/set! v)]
|
||||
[id (identifier? #'id) #`'#,(get/set!)]))))
|
||||
#`(#,id #,xform))])
|
||||
#`(let-syntax #,syntax-bindings
|
||||
#,stx))]))
|
||||
|
||||
|
||||
;;; Command interface
|
||||
|
||||
;; Intended use is for `code` to be a function definition form. It
|
||||
;; will be re-defined annotated for single stepping: When executed it
|
||||
;; will call our break?, break-before, and break-after functions.
|
||||
(define/contract (debug-eval source-str line col pos code)
|
||||
(-> path-string? pos/c nat/c pos/c string? #t)
|
||||
(define source (string->path source-str))
|
||||
(define in (open-input-string code))
|
||||
(port-count-lines! in)
|
||||
(set-port-next-location! in line col pos)
|
||||
(eval (annotate (expand (read-syntax source in))))
|
||||
(next-break 'all)
|
||||
#t)
|
||||
|
||||
(define locals/c (listof (list/c path-string? pos/c pos/c symbol? string?)))
|
||||
(define break-vals/c (cons/c break-id/c
|
||||
(or/c (list/c 'before)
|
||||
(list/c 'after string?))))
|
||||
(define on-break/c (list/c 'debug-break
|
||||
break-when/c
|
||||
breakable-positions/c
|
||||
locals/c
|
||||
break-vals/c))
|
||||
(define/contract on-break-channel (channel/c on-break/c) (make-channel))
|
||||
|
||||
(define resume-vals/c (cons/c break-id/c
|
||||
(or/c (list/c 'before)
|
||||
(list/c 'before string?)
|
||||
(list/c 'after string?))))
|
||||
(define on-resume/c (list/c (or/c break-when/c 'out 'over) resume-vals/c))
|
||||
(define/contract on-resume-channel (channel/c on-resume/c) (make-channel))
|
||||
|
||||
(define/contract (debug-resume resume-info)
|
||||
(-> on-resume/c #t)
|
||||
(channel-put on-resume-channel resume-info)
|
||||
#t)
|
||||
|
||||
(define (debug-disable)
|
||||
(next-break 'none)
|
||||
(for ([k (in-hash-keys breakable-positions)])
|
||||
(hash-remove! breakable-positions k)))
|
||||
|
||||
|
||||
;;; Make eval handler to instrument entire files
|
||||
|
||||
(define eval-handler/c (-> any/c any))
|
||||
|
||||
(define/contract ((make-debug-eval-handler files [orig-eval (current-eval)]) v)
|
||||
(->* ((set/c path?)) (eval-handler/c) eval-handler/c)
|
||||
(cond [(compiled-expression? (syntax-or-sexpr->sexpr v))
|
||||
(orig-eval v)]
|
||||
[else
|
||||
(define stx (syntax-or-sexpr->syntax v))
|
||||
(define top-stx (expand-syntax-to-top-form stx))
|
||||
(cond [(set-member? files (syntax-source stx))
|
||||
(next-break 'all)
|
||||
(parameterize* ([current-eval orig-eval]
|
||||
[current-load/use-compiled
|
||||
(let ([orig (current-load/use-compiled)])
|
||||
(λ (file mod)
|
||||
(cond [(set-member? files file)
|
||||
(load-module/annotate file mod)]
|
||||
[else
|
||||
(orig file mod)])))])
|
||||
(eval-syntax (annotate (expand-syntax top-stx))))]
|
||||
[else (orig-eval top-stx)])]))
|
||||
|
||||
;; This never seems to be called ???
|
||||
(define (load-module/annotate file m)
|
||||
(display-commented (format "~v" `(load-module/annotate ,file ,m)))
|
||||
(define-values (base _ __) (split-path file))
|
||||
(call-with-input-file* file
|
||||
(λ (in)
|
||||
(port-count-lines! in)
|
||||
(parameterize ([read-accept-compiled #f]
|
||||
[current-load-relative-directory base])
|
||||
(with-module-reading-parameterization
|
||||
(λ ()
|
||||
(define e (parameterize ([current-namespace (make-base-namespace)])
|
||||
(expand (read-syntax file in))))
|
||||
(eval (annotate (check-module-form e m file)))))))))
|
||||
57
elpa/racket-mode-20181004.309/racket/elisp.rkt
Normal file
57
elpa/racket-mode-20181004.309/racket/elisp.rkt
Normal file
@@ -0,0 +1,57 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/contract
|
||||
racket/match
|
||||
racket/port
|
||||
racket/set)
|
||||
|
||||
(provide elisp-read
|
||||
elisp-writeln
|
||||
elisp-bool/c
|
||||
as-racket-bool)
|
||||
|
||||
;;; read/write Emacs Lisp values
|
||||
|
||||
(define (elisp-read in)
|
||||
(elisp->racket (read in)))
|
||||
|
||||
(define (elisp-writeln v out)
|
||||
(elisp-write v out)
|
||||
(newline out))
|
||||
|
||||
(define (elisp-write v out)
|
||||
(write (racket->elisp v) out))
|
||||
|
||||
(define elisp-bool/c (or/c #t '()))
|
||||
(define (as-racket-bool v)
|
||||
;; elisp->racket "de-puns" 'nil as '() -- not #f. Use this helper to
|
||||
;; treat as a boolean.
|
||||
(and v (not (null? v))))
|
||||
|
||||
(define (elisp->racket v)
|
||||
(match v
|
||||
['nil '()] ;not #f -- see as-racket-bool
|
||||
['t #t]
|
||||
[(? list? xs) (map elisp->racket xs)]
|
||||
[(cons x y) (cons (elisp->racket x) (elisp->racket y))]
|
||||
[(vector s _ ...) s] ;Emacs strings can be #("string" . properties)
|
||||
[v v]))
|
||||
|
||||
(define (racket->elisp v)
|
||||
(match v
|
||||
[(or #f (list)) 'nil]
|
||||
[#t 't]
|
||||
[(? list? xs) (map racket->elisp xs)]
|
||||
[(cons x y) (cons (racket->elisp x) (racket->elisp y))]
|
||||
[(? path? v) (path->string v)]
|
||||
[(? hash? v) (for/list ([(k v) (in-hash v)])
|
||||
(cons (racket->elisp k) (racket->elisp v)))]
|
||||
[(? set? v) (map racket->elisp (set->list v))]
|
||||
[v v]))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
(check-equal? (with-output-to-string
|
||||
(λ () (elisp-write '(1 #t nil () (a . b) #hash((1 . 2) (3 . 4)))
|
||||
(current-output-port))))
|
||||
"(1 t nil nil (a . b) ((1 . 2) (3 . 4)))"))
|
||||
197
elpa/racket-mode-20181004.309/racket/error.rkt
Normal file
197
elpa/racket-mode-20181004.309/racket/error.rkt
Normal file
@@ -0,0 +1,197 @@
|
||||
#lang at-exp racket/base
|
||||
|
||||
(require racket/format
|
||||
racket/match
|
||||
(only-in racket/path path-only)
|
||||
racket/runtime-path
|
||||
racket/string
|
||||
setup/collects
|
||||
setup/dirs
|
||||
"fresh-line.rkt"
|
||||
"instrument.rkt"
|
||||
"util.rkt")
|
||||
|
||||
(provide display-exn
|
||||
our-error-display-handler
|
||||
show-full-path-in-errors)
|
||||
|
||||
(module+ test
|
||||
(require rackunit))
|
||||
|
||||
(define (display-exn exn)
|
||||
(our-error-display-handler (exn-message exn) exn))
|
||||
|
||||
(define (our-error-display-handler str v)
|
||||
(cond [(exn? v)
|
||||
(unless (equal? "Check failure" (exn-message v)) ;rackunit check fails
|
||||
(fresh-line)
|
||||
(display-commented (fully-qualify-error-path str))
|
||||
(display-srclocs v)
|
||||
(unless (exn:fail:user? v)
|
||||
(display-context v))
|
||||
(maybe-suggest-packages v))]
|
||||
[else
|
||||
(fresh-line)
|
||||
(display-commented str)]))
|
||||
|
||||
(define (display-srclocs exn)
|
||||
(when (exn:srclocs? exn)
|
||||
(define srclocs
|
||||
(match ((exn:srclocs-accessor exn) exn)
|
||||
;; Some exceptions like exn:fail:read? include the first
|
||||
;; srcloc in exn-message -- don't show it again.
|
||||
[(cons _ xs)
|
||||
#:when (or (exn:fail:read? exn)
|
||||
(exn:fail:contract:variable? exn))
|
||||
xs]
|
||||
;; Some exceptions like exn:fail:syntax? with Typed Racket
|
||||
;; include _all_ in exn-message -- don't show _any_.
|
||||
[_
|
||||
#:when (exn:fail:syntax? exn)
|
||||
'()]
|
||||
[xs xs]))
|
||||
(for ([s (in-list srclocs)])
|
||||
(display-commented (source-location->string s)))))
|
||||
|
||||
(define (display-context exn)
|
||||
(cond [(instrumenting-enabled)
|
||||
(define p (open-output-string))
|
||||
(print-error-trace p exn)
|
||||
(match (get-output-string p)
|
||||
["" (void)]
|
||||
[s (display-commented (string-append "Context (errortrace):"
|
||||
;; et prepends a \n
|
||||
s))])]
|
||||
[else
|
||||
(match (context->string
|
||||
(continuation-mark-set->context (exn-continuation-marks exn)))
|
||||
["" (void)]
|
||||
[s (display-commented (string-append "Context:\n"
|
||||
s))])]))
|
||||
|
||||
(define (context->string xs)
|
||||
;; Limit the context in two ways:
|
||||
;; 1. Don't go beyond error-print-context-length
|
||||
;; 2. Don't go into "system" context that's just noisy.
|
||||
(string-join (for/list ([x xs]
|
||||
[_ (error-print-context-length)]
|
||||
#:unless (system-context? x))
|
||||
(context-item->string x))
|
||||
"\n"))
|
||||
|
||||
(define-runtime-path here "error.rkt")
|
||||
(define (system-context? ci)
|
||||
(match-define (cons id src) ci)
|
||||
(or (not src)
|
||||
(let ([src (srcloc-source src)])
|
||||
(and (path? src)
|
||||
(or (equal? (path-only src) (path-only here))
|
||||
(under-system-path? src))))))
|
||||
|
||||
(define (under-system-path? path)
|
||||
(match (path->collects-relative path)
|
||||
[`(collects #"mred" . ,_) #t]
|
||||
[`(collects #"racket" #"contract" . ,_) #t]
|
||||
[`(collects #"racket" #"private" . ,_) #t]
|
||||
[`(collects #"typed-racket" . ,_) #t]
|
||||
[_ #f]))
|
||||
|
||||
(define (context-item->string ci)
|
||||
(match-define (cons id src) ci)
|
||||
(string-append (if (or src id) " " "")
|
||||
(if src (source-location->string src) "")
|
||||
(if (and src id) " " "")
|
||||
(if id (format "~a" id) "")))
|
||||
|
||||
;; Don't use source-location->string from syntax/srcloc. Don't want
|
||||
;; the setup/path-to-relative behavior that replaces full pathnames
|
||||
;; with <collects>, <pkgs> etc. Instead want full pathnames for Emacs'
|
||||
;; compilation-mode. HOWEVER note that <collects> or <pkgs> might be
|
||||
;; baked into exn-message string already; we handle that in
|
||||
;; `fully-qualify-error-path`. Here we handle only strings we create
|
||||
;; ourselves, such as for the Context "stack trace".
|
||||
(define (source-location->string x)
|
||||
(match-define (srcloc src line col pos span) x)
|
||||
(format "~a:~a:~a" src (or line "1") (or col "1")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; Fully qualified pathnames in error messages, so that Emacs
|
||||
;; compilation-mode can do its stuff.
|
||||
|
||||
;; srcloc->string uses current-directory-for-user to shorten error
|
||||
;; messages. But we always want full pathnames. Setting it to
|
||||
;; 'pref-dir -- very unlikely user .rkt file will be there -- is
|
||||
;; least-worst way AFAIK.
|
||||
(define (show-full-path-in-errors)
|
||||
(current-directory-for-user (find-system-path 'pref-dir)))
|
||||
|
||||
;; If this looks like a Racket error message, but the filename is
|
||||
;; not fully-qualified, prepend curdir to the filename.
|
||||
;;
|
||||
;; This covers Racket 5.3.6 and earlier. In fact, this might be
|
||||
;; sufficient for _all_ versions of Racket and we don't need the
|
||||
;; `show-full-path-in-errors` thing above, at all. Not yet sure.
|
||||
(define (fully-qualify-error-path s)
|
||||
(match s
|
||||
[(pregexp "^([^/.]+)\\.([^.]+):(\\d+)[:.](\\d+):(.*)$"
|
||||
(list _ base ext line col more))
|
||||
(define curdir (path->string (current-directory)))
|
||||
(string-append curdir base "." ext ":" line ":" col ":" more)]
|
||||
[s (regexp-replace* #rx"<collects>"
|
||||
s
|
||||
(path->string (find-collects-dir)))]))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
(check-equal?
|
||||
(parameterize ([current-directory "/tmp/"])
|
||||
(fully-qualify-error-path "foo.rkt:3:0: f: unbound identifier\n in: f"))
|
||||
"/tmp/foo.rkt:3:0: f: unbound identifier\n in: f")
|
||||
(check-equal?
|
||||
(fully-qualify-error-path "/tmp/foo.rkt:3:0: f: unbound identifier\n in: f")
|
||||
"/tmp/foo.rkt:3:0: f: unbound identifier\n in: f")
|
||||
(let ([o (open-output-string)])
|
||||
(parameterize ([current-error-port o])
|
||||
(display-srclocs (make-exn:fail:read "..."
|
||||
(current-continuation-marks)
|
||||
'())))
|
||||
(check-equal? (get-output-string o) "")))
|
||||
|
||||
(define maybe-suggest-packages
|
||||
(with-handlers ([exn:fail? (λ _ void)])
|
||||
(with-dynamic-requires ([racket/base exn:missing-module?]
|
||||
[racket/base exn:missing-module-accessor]
|
||||
[pkg/db get-catalogs]
|
||||
[pkg/lib pkg-catalog-suggestions-for-module])
|
||||
(λ (exn)
|
||||
(when (exn:missing-module? exn)
|
||||
(match (get-catalogs)
|
||||
[(list)
|
||||
(display-commented
|
||||
@~a{-----
|
||||
Can't suggest packages to install, because pkg/db get-catalogs is '().
|
||||
To configure:
|
||||
1. Start DrRacket.
|
||||
2. Choose "File | Package Mananger".
|
||||
3. Click "Available from Catalog".
|
||||
4. When prompted, click "Update".
|
||||
-----})]
|
||||
[_
|
||||
(define mod ((exn:missing-module-accessor exn) exn))
|
||||
(match (pkg-catalog-suggestions-for-module mod)
|
||||
[(list) void]
|
||||
[(list p)
|
||||
(display-commented
|
||||
@~a{Try "raco pkg install @|p|" ?})]
|
||||
[(? list? ps)
|
||||
(display-commented
|
||||
@~a{Try "raco pkg install" one of @(string-join ps ", ") ?})]
|
||||
[_ void])]))))))
|
||||
|
||||
(module+ test
|
||||
;; Point of this test is older Rackets where the with-handlers
|
||||
;; clause is exercised.
|
||||
(check-not-exn
|
||||
(λ ()
|
||||
(maybe-suggest-packages (exn:fail "" (current-continuation-marks))))))
|
||||
302
elpa/racket-mode-20181004.309/racket/example/example.rkt
Normal file
302
elpa/racket-mode-20181004.309/racket/example/example.rkt
Normal file
@@ -0,0 +1,302 @@
|
||||
;; -*- racket-indent-sequence-depth: 100; racket-indent-curly-as-sequence: t; -*-
|
||||
|
||||
;;; NOTE: After changing this file you will need to M-x faceup-write-file
|
||||
;;; to regenerate the .faceup test comparison file.
|
||||
;;;
|
||||
;;; NOTE: You may need to disable certain features -- for example
|
||||
;;; global-paren-face-mode -- during the M-x faceup-write-file.
|
||||
|
||||
#lang racket
|
||||
|
||||
(require xml)
|
||||
(provide valid-bucket-name?)
|
||||
|
||||
;; Various def* forms are font-locked:
|
||||
|
||||
(define (function foo)
|
||||
#t)
|
||||
|
||||
(define ((curried-function x) y)
|
||||
(list x y))
|
||||
|
||||
(define a-var 10)
|
||||
|
||||
(define/contract (f2 x)
|
||||
(any/c . -> . any)
|
||||
#t)
|
||||
|
||||
(define-values (1st-var 2nd-var) (values 1 2))
|
||||
|
||||
(define-thing foo) ;bug 276
|
||||
|
||||
;; let: font-lock identifiers
|
||||
|
||||
(let ([foo 10]
|
||||
[bar 20])
|
||||
foo)
|
||||
|
||||
(let loop ([x 10])
|
||||
(unless (zero? x)
|
||||
(loop (sub1 x))))
|
||||
|
||||
(let* ([foo 10]
|
||||
[bar 20])
|
||||
foo)
|
||||
|
||||
(let-values ([(a b) (values 1 2)])
|
||||
(values a b))
|
||||
|
||||
(let*-values ([(a b) (values 1 2)])
|
||||
(values a b))
|
||||
|
||||
(letrec-values ([(a b) (values 1 2)])
|
||||
(values a b))
|
||||
|
||||
(let-syntax ([foo #'foo])
|
||||
foo)
|
||||
|
||||
(letrec-syntax ([foo #'foo])
|
||||
foo)
|
||||
|
||||
(let-syntaxes ([(foo) #'foo])
|
||||
foo)
|
||||
|
||||
(letrec-syntaxes ([(foo) #'foo])
|
||||
foo)
|
||||
|
||||
(letrec-syntaxes+values ([(foo) #'foo])
|
||||
([(a b) (values 1 2)])
|
||||
foo)
|
||||
|
||||
;; for/fold is indented correctly:
|
||||
(for/fold ([str ""])
|
||||
([ss '("a" "b" "c")])
|
||||
(string-append str ss))
|
||||
|
||||
;; Auto-converts word `lambda` to `λ`:
|
||||
(lambda (x) #t)
|
||||
|
||||
;; Or use M-C-y to insert to insert `λ` char.
|
||||
|
||||
;; Smart indentation for quoted lists:
|
||||
'(1 2
|
||||
3 4)
|
||||
|
||||
;; Smart indentation for vector literals:
|
||||
#(1 2
|
||||
3 4)
|
||||
|
||||
;; Smart indentation for Rackjure dict literals:
|
||||
(module x rackjure
|
||||
{'a 0
|
||||
'b 2})
|
||||
|
||||
;; Silly test submodule example.
|
||||
;; Try using C-c C-f to Fold (hide) it, and C-c C-u to Unfold it.
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
(check-true #t))
|
||||
|
||||
;; Single line comment
|
||||
|
||||
#|
|
||||
|
||||
Multi-line
|
||||
comment
|
||||
|
||||
|#
|
||||
|
||||
#;(sexpr comment)
|
||||
|
||||
;; Nested sexpr comments
|
||||
|
||||
(list 2
|
||||
#;2)
|
||||
|
||||
(list 1
|
||||
#;4
|
||||
#;(3))
|
||||
|
||||
(let (#;[x #;1]
|
||||
[y 2])
|
||||
y)
|
||||
|
||||
(define x #<<FOO
|
||||
asdfasdf
|
||||
asdfasdf
|
||||
asdfasdf
|
||||
FOO
|
||||
)
|
||||
|
||||
#;(define x #<<BAR
|
||||
asdfasdf
|
||||
asdfasdf
|
||||
asdfasdf
|
||||
BAR
|
||||
)
|
||||
|
||||
|identifier with spaces|
|
||||
|
||||
|;no comment|
|
||||
|
||||
| #|no comment|# |
|
||||
|
||||
(define (a-function x #:keyword [y 0])
|
||||
(and (append (car '(1 2 3))))
|
||||
(regexp-match? #rx"foobar" "foobar")
|
||||
(regexp-match? #px"foobar" "foobar")
|
||||
(define a 1)
|
||||
(let ([a "foo"]
|
||||
[b "bar"])
|
||||
(displayln b))
|
||||
(let* ([a "foo"]
|
||||
[b "bar"])
|
||||
(displayln b))
|
||||
(let-values ([(a b) (values 1 2)])
|
||||
#t)
|
||||
(for/list ([x (in-list (list 1 2 (list 3 4)))])
|
||||
(cond [(pair? x) (car x)]
|
||||
[else x])))
|
||||
|
||||
;; Issue 261
|
||||
"@|widget-id|" @|foo|
|
||||
|
||||
;; Issue 298
|
||||
(define x (begin "|" '\|))
|
||||
|
||||
(define (foo)
|
||||
(let ([x 10])
|
||||
#t)
|
||||
|
||||
(let ([x 1]
|
||||
[y 2])
|
||||
#t)
|
||||
|
||||
(define 1/2-the-way 0)
|
||||
(define less-than-1/2 0)
|
||||
|
||||
;; Self-eval examples
|
||||
(values
|
||||
1/2-the-way ;should NOT be self-eval
|
||||
less-than-1/2 ;should NOT be self-eval
|
||||
+inf.0
|
||||
-inf.0
|
||||
+nan.0
|
||||
#t
|
||||
#f
|
||||
1
|
||||
1.0
|
||||
1/2
|
||||
-1/2
|
||||
#b100
|
||||
#o123
|
||||
#d123
|
||||
#x7f7f
|
||||
'symbol
|
||||
'|symbol with spaces|
|
||||
'|;no comment|
|
||||
'| #|no comment|# |
|
||||
'symbol-with-no-alpha/numeric-chars
|
||||
#\c
|
||||
#\space
|
||||
#\newline
|
||||
|
||||
;; Literal number examples
|
||||
|
||||
;; #b
|
||||
#b1.1
|
||||
#b-1.1
|
||||
#b1e1
|
||||
#b0/1
|
||||
#b1/1
|
||||
#b1e-1
|
||||
#b101
|
||||
|
||||
;; #d
|
||||
#d-1.23
|
||||
#d1.123
|
||||
#d1e3
|
||||
#d1e-22
|
||||
#d1/2
|
||||
#d-1/2
|
||||
#d1
|
||||
#d-1
|
||||
|
||||
;; No # reader prefix -- same as #d
|
||||
-1.23
|
||||
1.123
|
||||
1e3
|
||||
1e-22
|
||||
1/2
|
||||
-1/2
|
||||
1
|
||||
-1
|
||||
|
||||
;; #e
|
||||
#e-1.23
|
||||
#e1.123
|
||||
#e1e3
|
||||
#e1e-22
|
||||
#e1
|
||||
#e-1
|
||||
#e1/2
|
||||
#e-1/2
|
||||
|
||||
;; #i always float
|
||||
#i-1.23
|
||||
#i1.123
|
||||
#i1e3
|
||||
#i1e-22
|
||||
#i1/2
|
||||
#i-1/2
|
||||
#i1
|
||||
#i-1
|
||||
|
||||
;; #o
|
||||
#o777.777
|
||||
#o-777.777
|
||||
#o777e777
|
||||
#o777e-777
|
||||
#o3/7
|
||||
#o-3/7
|
||||
#o777
|
||||
#o-777
|
||||
|
||||
;; #x
|
||||
#x-f.f
|
||||
#xf.f
|
||||
#x-f
|
||||
#xf
|
||||
))
|
||||
|
||||
(define/contract (valid-bucket-name? s #:keyword [dns-compliant? #t])
|
||||
((string?) (#:keyword boolean?) . ->* . boolean?)
|
||||
(cond
|
||||
[dns-compliant?
|
||||
(and (<= 3 (string-length s)) (<= (string-length s) 63)
|
||||
(not (regexp-match #px"\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}" s))
|
||||
(for/and ([s (regexp-split #rx"\\." s)])
|
||||
(define (valid-first-or-last? c)
|
||||
(or (char-lower-case? (string-ref s 0))
|
||||
(char-numeric? (string-ref s 0))))
|
||||
(define (valid-mid? c)
|
||||
(or (valid-first-or-last? c)
|
||||
(equal? c #\-)))
|
||||
(define len (string-length s))
|
||||
(and (< 0 len)
|
||||
(valid-first-or-last? (string-ref s 0))
|
||||
(valid-first-or-last? (string-ref s (sub1 len)))
|
||||
(or (<= len 2)
|
||||
(for/and ([c (substring s 1 (sub1 len))])
|
||||
(valid-mid? c))))))]
|
||||
[else
|
||||
(and (<= (string-length s) 255)
|
||||
(for/and ([c s])
|
||||
(or (char-numeric? c)
|
||||
(char-lower-case? c)
|
||||
(char-upper-case? c)
|
||||
(equal? c #\.)
|
||||
(equal? c #\-)
|
||||
(equal? c #\_))))]))
|
||||
|
||||
(displayln "I'm running!")
|
||||
302
elpa/racket-mode-20181004.309/racket/example/example.rkt.faceup
Normal file
302
elpa/racket-mode-20181004.309/racket/example/example.rkt.faceup
Normal file
@@ -0,0 +1,302 @@
|
||||
«m:;; »«x:-*- racket-indent-sequence-depth: 100; racket-indent-curly-as-sequence: t; -*-
|
||||
»
|
||||
«m:;;; »«x:NOTE: After changing this file you will need to M-x faceup-write-file
|
||||
»«m:;;; »«x:to regenerate the .faceup test comparison file.
|
||||
»«m:;;;»«x:
|
||||
»«m:;;; »«x:NOTE: You may need to disable certain features -- for example
|
||||
»«m:;;; »«x:global-paren-face-mode -- during the M-x faceup-write-file.
|
||||
»
|
||||
«k:#lang» «v:racket»
|
||||
|
||||
(«k:require» xml)
|
||||
(«k:provide» valid-bucket-name?)
|
||||
|
||||
«m:;; »«x:Various def* forms are font-locked:
|
||||
»
|
||||
(«k:define» («f:function» foo)
|
||||
«:racket-selfeval-face:#t»)
|
||||
|
||||
(«k:define» ((«f:curried-function» x) y)
|
||||
(«b:list» x y))
|
||||
|
||||
(«k:define» «v:a-var» «:racket-selfeval-face:10»)
|
||||
|
||||
(«b:define/contract» («f:f2» x)
|
||||
(«b:any/c» . «b:->» . «b:any»)
|
||||
«:racket-selfeval-face:#t»)
|
||||
|
||||
(«k:define-values» («v:1st-var 2nd-var») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»))
|
||||
|
||||
(define-thing «v:foo») «m:;»«x:bug 276
|
||||
»
|
||||
«m:;; »«x:let: font-lock identifiers
|
||||
»
|
||||
(«k:let» ([«v:foo» «:racket-selfeval-face:10»]
|
||||
[«v:bar» «:racket-selfeval-face:20»])
|
||||
foo)
|
||||
|
||||
(«k:let» «f:loop» ([«v:x» «:racket-selfeval-face:10»])
|
||||
(«k:unless» («b:zero?» x)
|
||||
(loop («b:sub1» x))))
|
||||
|
||||
(«k:let*» ([«v:foo» «:racket-selfeval-face:10»]
|
||||
[«v:bar» «:racket-selfeval-face:20»])
|
||||
foo)
|
||||
|
||||
(«k:let-values» ([(«v:a» «v:b») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
|
||||
(«b:values» a b))
|
||||
|
||||
(«k:let*-values» ([(«v:a» «v:b») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
|
||||
(«b:values» a b))
|
||||
|
||||
(«k:letrec-values» ([(«v:a» «v:b») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
|
||||
(«b:values» a b))
|
||||
|
||||
(«k:let-syntax» ([«v:foo» #«:racket-selfeval-face:'foo»])
|
||||
foo)
|
||||
|
||||
(«k:letrec-syntax» ([«v:foo» #«:racket-selfeval-face:'foo»])
|
||||
foo)
|
||||
|
||||
(«k:let-syntaxes» ([(«v:foo») #«:racket-selfeval-face:'foo»])
|
||||
foo)
|
||||
|
||||
(«k:letrec-syntaxes» ([(«v:foo») #«:racket-selfeval-face:'foo»])
|
||||
foo)
|
||||
|
||||
(«k:letrec-syntaxes+values» ([(«v:foo») #«:racket-selfeval-face:'foo»])
|
||||
([(a b) («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
|
||||
foo)
|
||||
|
||||
«m:;; »«x:for/fold is indented correctly:
|
||||
»(«k:for/fold» ([str «s:""»])
|
||||
([ss '(«s:"a"» «s:"b"» «s:"c"»)])
|
||||
(«b:string-append» str ss))
|
||||
|
||||
«m:;; »«x:Auto-converts word `lambda` to `λ`:
|
||||
»(«k:lambda» (x) «:racket-selfeval-face:#t»)
|
||||
|
||||
«m:;; »«x:Or use M-C-y to insert to insert `λ` char.
|
||||
»
|
||||
«m:;; »«x:Smart indentation for quoted lists:
|
||||
»'(«:racket-selfeval-face:1» «:racket-selfeval-face:2»
|
||||
«:racket-selfeval-face:3» «:racket-selfeval-face:4»)
|
||||
|
||||
«m:;; »«x:Smart indentation for vector literals:
|
||||
»#(«:racket-selfeval-face:1» «:racket-selfeval-face:2»
|
||||
«:racket-selfeval-face:3» «:racket-selfeval-face:4»)
|
||||
|
||||
«m:;; »«x:Smart indentation for Rackjure dict literals:
|
||||
»(«k:module» «f:x» «v:rackjure»
|
||||
{«:racket-selfeval-face:'a» «:racket-selfeval-face:0»
|
||||
«:racket-selfeval-face:'b» «:racket-selfeval-face:2»})
|
||||
|
||||
«m:;; »«x:Silly test submodule example.
|
||||
»«m:;; »«x:Try using C-c C-f to Fold (hide) it, and C-c C-u to Unfold it.
|
||||
»(«k:module+» «f:test»
|
||||
(«k:require» rackunit)
|
||||
(check-true «:racket-selfeval-face:#t»))
|
||||
|
||||
«m:;; »«x:Single line comment
|
||||
»
|
||||
«x:#|
|
||||
|
||||
Multi-line
|
||||
comment
|
||||
|
||||
|#»
|
||||
|
||||
«m:#;»«x:(sexpr comment)»
|
||||
|
||||
«m:;; »«x:Nested sexpr comments
|
||||
»
|
||||
(«b:list» «:racket-selfeval-face:2»
|
||||
«m:#;»«x:2»)
|
||||
|
||||
(«b:list» «:racket-selfeval-face:1»
|
||||
«m:#;»«x:4»
|
||||
«m:#;»«x:(3)»)
|
||||
|
||||
(«k:let» («m:#;»«x:[x #;1]»
|
||||
[«v:y» «:racket-selfeval-face:2»])
|
||||
y)
|
||||
|
||||
(«k:define» «v:x» «:racket-here-string-face:#<<FOO
|
||||
asdfasdf
|
||||
asdfasdf
|
||||
asdfasdf
|
||||
FOO
|
||||
» )
|
||||
|
||||
«m:#;»«x:(define x #<<BAR
|
||||
asdfasdf
|
||||
asdfasdf
|
||||
asdfasdf
|
||||
BAR
|
||||
)»
|
||||
|
||||
|identifier with spaces|
|
||||
|
||||
|;no comment|
|
||||
|
||||
| #|no comment|# |
|
||||
|
||||
(«k:define» («f:a-function» x «:racket-keyword-argument-face:#:keyword» [y «:racket-selfeval-face:0»])
|
||||
(«k:and» («b:append» («b:car» '(«:racket-selfeval-face:1» «:racket-selfeval-face:2» «:racket-selfeval-face:3»))))
|
||||
(«b:regexp-match?» «:racket-selfeval-face:#rx»«s:"foobar"» «s:"foobar"»)
|
||||
(«b:regexp-match?» «:racket-selfeval-face:#px»«s:"foobar"» «s:"foobar"»)
|
||||
(«k:define» «v:a» «:racket-selfeval-face:1»)
|
||||
(«k:let» ([«v:a» «s:"foo"»]
|
||||
[«v:b» «s:"bar"»])
|
||||
(«b:displayln» b))
|
||||
(«k:let*» ([«v:a» «s:"foo"»]
|
||||
[«v:b» «s:"bar"»])
|
||||
(«b:displayln» b))
|
||||
(«k:let-values» ([(«v:a» «v:b») («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)])
|
||||
«:racket-selfeval-face:#t»)
|
||||
(«k:for/list» ([x («k:in-list» («b:list» «:racket-selfeval-face:1» «:racket-selfeval-face:2» («b:list» «:racket-selfeval-face:3» «:racket-selfeval-face:4»)))])
|
||||
(«k:cond» [(«b:pair?» x) («b:car» x)]
|
||||
[«k:else» x])))
|
||||
|
||||
«m:;; »«x:Issue 261
|
||||
»«s:"@|widget-id|"» @|foo|
|
||||
|
||||
«m:;; »«x:Issue 298
|
||||
»(«k:define» «v:x» («k:begin» «s:"|"» '\|))
|
||||
|
||||
(«k:define» («f:foo»)
|
||||
(«k:let» ([«v:x» «:racket-selfeval-face:10»])
|
||||
«:racket-selfeval-face:#t»)
|
||||
|
||||
(«k:let» ([«v:x» «:racket-selfeval-face:1»]
|
||||
[«v:y» «:racket-selfeval-face:2»])
|
||||
«:racket-selfeval-face:#t»)
|
||||
|
||||
(«k:define» «v:1/2-the-way» «:racket-selfeval-face:0»)
|
||||
(«k:define» «v:less-than-1/2» «:racket-selfeval-face:0»)
|
||||
|
||||
«m:;; »«x:Self-eval examples
|
||||
» («b:values»
|
||||
1/2-the-way «m:;»«x:should NOT be self-eval
|
||||
» less-than-1/2 «m:;»«x:should NOT be self-eval
|
||||
» «:racket-selfeval-face:+inf.0»
|
||||
«:racket-selfeval-face:-inf.0»
|
||||
«:racket-selfeval-face:+nan.0»
|
||||
«:racket-selfeval-face:#t»
|
||||
«:racket-selfeval-face:#f»
|
||||
«:racket-selfeval-face:1»
|
||||
«:racket-selfeval-face:1.0»
|
||||
«:racket-selfeval-face:1/2»
|
||||
«:racket-selfeval-face:-1/2»
|
||||
«:racket-selfeval-face:#b100»
|
||||
«:racket-selfeval-face:#o123»
|
||||
«:racket-selfeval-face:#d123»
|
||||
«:racket-selfeval-face:#x7f7f»
|
||||
«:racket-selfeval-face:'symbol»
|
||||
«:racket-selfeval-face:'|symbol with spaces|»
|
||||
«:racket-selfeval-face:'|;no comment|»
|
||||
«:racket-selfeval-face:'| #|no comment|# |»
|
||||
«:racket-selfeval-face:'symbol-with-no-alpha/numeric-chars»
|
||||
«:racket-selfeval-face:#\c»
|
||||
«:racket-selfeval-face:#\space»
|
||||
«:racket-selfeval-face:#\newline»
|
||||
|
||||
«m:;; »«x:Literal number examples
|
||||
»
|
||||
«m:;; »«x:#b
|
||||
» «:racket-selfeval-face:#b1.1»
|
||||
«:racket-selfeval-face:#b-1.1»
|
||||
«:racket-selfeval-face:#b1e1»
|
||||
«:racket-selfeval-face:#b0/1»
|
||||
«:racket-selfeval-face:#b1/1»
|
||||
«:racket-selfeval-face:#b1e-1»
|
||||
«:racket-selfeval-face:#b101»
|
||||
|
||||
«m:;; »«x:#d
|
||||
» «:racket-selfeval-face:#d-1.23»
|
||||
«:racket-selfeval-face:#d1.123»
|
||||
«:racket-selfeval-face:#d1e3»
|
||||
«:racket-selfeval-face:#d1e-22»
|
||||
«:racket-selfeval-face:#d1/2»
|
||||
«:racket-selfeval-face:#d-1/2»
|
||||
«:racket-selfeval-face:#d1»
|
||||
«:racket-selfeval-face:#d-1»
|
||||
|
||||
«m:;; »«x:No # reader prefix -- same as #d
|
||||
» «:racket-selfeval-face:-1.23»
|
||||
«:racket-selfeval-face:1.123»
|
||||
«:racket-selfeval-face:1e3»
|
||||
«:racket-selfeval-face:1e-22»
|
||||
«:racket-selfeval-face:1/2»
|
||||
«:racket-selfeval-face:-1/2»
|
||||
«:racket-selfeval-face:1»
|
||||
«:racket-selfeval-face:-1»
|
||||
|
||||
«m:;; »«x:#e
|
||||
» «:racket-selfeval-face:#e-1.23»
|
||||
«:racket-selfeval-face:#e1.123»
|
||||
«:racket-selfeval-face:#e1e3»
|
||||
«:racket-selfeval-face:#e1e-22»
|
||||
«:racket-selfeval-face:#e1»
|
||||
«:racket-selfeval-face:#e-1»
|
||||
«:racket-selfeval-face:#e1/2»
|
||||
«:racket-selfeval-face:#e-1/2»
|
||||
|
||||
«m:;; »«x:#i always float
|
||||
» «:racket-selfeval-face:#i-1.23»
|
||||
«:racket-selfeval-face:#i1.123»
|
||||
«:racket-selfeval-face:#i1e3»
|
||||
«:racket-selfeval-face:#i1e-22»
|
||||
«:racket-selfeval-face:#i1/2»
|
||||
«:racket-selfeval-face:#i-1/2»
|
||||
«:racket-selfeval-face:#i1»
|
||||
«:racket-selfeval-face:#i-1»
|
||||
|
||||
«m:;; »«x:#o
|
||||
» «:racket-selfeval-face:#o777.777»
|
||||
«:racket-selfeval-face:#o-777.777»
|
||||
«:racket-selfeval-face:#o777e777»
|
||||
«:racket-selfeval-face:#o777e-777»
|
||||
«:racket-selfeval-face:#o3/7»
|
||||
«:racket-selfeval-face:#o-3/7»
|
||||
«:racket-selfeval-face:#o777»
|
||||
«:racket-selfeval-face:#o-777»
|
||||
|
||||
«m:;; »«x:#x
|
||||
» «:racket-selfeval-face:#x-f.f»
|
||||
«:racket-selfeval-face:#xf.f»
|
||||
«:racket-selfeval-face:#x-f»
|
||||
«:racket-selfeval-face:#xf»
|
||||
))
|
||||
|
||||
(«b:define/contract» («f:valid-bucket-name?» s «:racket-keyword-argument-face:#:keyword» [dns-compliant? «:racket-selfeval-face:#t»])
|
||||
((«b:string?») («:racket-keyword-argument-face:#:keyword» «b:boolean?») . «b:->*» . «b:boolean?»)
|
||||
(«k:cond»
|
||||
[dns-compliant?
|
||||
(«k:and» («b:<=» «:racket-selfeval-face:3» («b:string-length» s)) («b:<=» («b:string-length» s) «:racket-selfeval-face:63»)
|
||||
(«b:not» («b:regexp-match» «:racket-selfeval-face:#px»«s:"\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}"» s))
|
||||
(«k:for/and» ([s («b:regexp-split» «:racket-selfeval-face:#rx»«s:"\\."» s)])
|
||||
(«k:define» («f:valid-first-or-last?» c)
|
||||
(«k:or» («b:char-lower-case?» («b:string-ref» s «:racket-selfeval-face:0»))
|
||||
(«b:char-numeric?» («b:string-ref» s «:racket-selfeval-face:0»))))
|
||||
(«k:define» («f:valid-mid?» c)
|
||||
(«k:or» (valid-first-or-last? c)
|
||||
(«b:equal?» c «:racket-selfeval-face:#\-»)))
|
||||
(«k:define» «v:len» («b:string-length» s))
|
||||
(«k:and» («b:<» «:racket-selfeval-face:0» len)
|
||||
(valid-first-or-last? («b:string-ref» s «:racket-selfeval-face:0»))
|
||||
(valid-first-or-last? («b:string-ref» s («b:sub1» len)))
|
||||
(«k:or» («b:<=» len «:racket-selfeval-face:2»)
|
||||
(«k:for/and» ([c («b:substring» s «:racket-selfeval-face:1» («b:sub1» len))])
|
||||
(valid-mid? c))))))]
|
||||
[«k:else»
|
||||
(«k:and» («b:<=» («b:string-length» s) «:racket-selfeval-face:255»)
|
||||
(«k:for/and» ([c s])
|
||||
(«k:or» («b:char-numeric?» c)
|
||||
(«b:char-lower-case?» c)
|
||||
(«b:char-upper-case?» c)
|
||||
(«b:equal?» c «:racket-selfeval-face:#\.»)
|
||||
(«b:equal?» c «:racket-selfeval-face:#\-»)
|
||||
(«b:equal?» c «:racket-selfeval-face:#\_»))))]))
|
||||
|
||||
(«b:displayln» «s:"I'm running!"»)
|
||||
325
elpa/racket-mode-20181004.309/racket/example/indent.rkt
Normal file
325
elpa/racket-mode-20181004.309/racket/example/indent.rkt
Normal file
@@ -0,0 +1,325 @@
|
||||
;; -*- racket-indent-sequence-depth: 100; racket-indent-curly-as-sequence: t; -*-
|
||||
|
||||
;;; NOTE: After changing this file you will need to M-x faceup-write-file
|
||||
;;; to regenerate the .faceup test comparison file.
|
||||
;;;
|
||||
;;; NOTE: You may need to disable certain features -- for example
|
||||
;;; global-paren-face-mode -- during the M-x faceup-write-file.
|
||||
|
||||
;;; Quoted list
|
||||
|
||||
'(a b
|
||||
(a b
|
||||
c))
|
||||
|
||||
'((1) 2 3
|
||||
(3)
|
||||
4 5)
|
||||
|
||||
;;; Quasiquoted list (align with head) and unquote or unquote-splicing
|
||||
;;; (use normal indent rules for the form).
|
||||
|
||||
`(Part ()
|
||||
(PartNumber ()
|
||||
,part)
|
||||
(ETag ()
|
||||
,etag))
|
||||
|
||||
`((,(x)
|
||||
,y))
|
||||
|
||||
`(Delete
|
||||
,@(for/list ([p (in-list paths)])
|
||||
`(Object ()
|
||||
(Key () ,p))))
|
||||
|
||||
;;; Syntax
|
||||
|
||||
#'(for/list ([x xs])
|
||||
x)
|
||||
|
||||
#`(for/list ([x xs])
|
||||
x)
|
||||
|
||||
#'(#%app (#%app hasheq (quote a) (quote 42))
|
||||
(quote a))
|
||||
|
||||
(#%app (#%app hasheq (quote a) (quote 42))
|
||||
(quote a))
|
||||
|
||||
#'(foo (#%app hasheq (quote a) (quote 42))
|
||||
(quote a))
|
||||
|
||||
;;; Rackjure style dictionary (when racket-indent-curly-as-sequence is t).
|
||||
|
||||
{a b
|
||||
c d}
|
||||
|
||||
{a b
|
||||
c d
|
||||
b '(a x
|
||||
s (x y
|
||||
x v))}
|
||||
|
||||
;;; Vector
|
||||
|
||||
#(a b
|
||||
c d)
|
||||
|
||||
;;; List with a keyword as first member (e.g. in many contracts)
|
||||
|
||||
(#:x y
|
||||
#:y x)
|
||||
|
||||
;;; Normal function application.
|
||||
|
||||
(foobar x
|
||||
y
|
||||
z)
|
||||
|
||||
(foobar
|
||||
x
|
||||
y
|
||||
z)
|
||||
|
||||
(dict-set a
|
||||
b
|
||||
c)
|
||||
|
||||
(dict-set
|
||||
a
|
||||
b
|
||||
c)
|
||||
|
||||
(call-with-values (lambda () (values 1 2))
|
||||
+)
|
||||
|
||||
(call-with-values
|
||||
(lambda () (values 1 2))
|
||||
+)
|
||||
|
||||
;;; Forms with special indentation
|
||||
|
||||
(let ([x 0])
|
||||
x)
|
||||
|
||||
;; indent 2
|
||||
|
||||
(syntax-case stx ()
|
||||
[(_ x) #'#f]
|
||||
[(_ x y) #'#t])
|
||||
|
||||
;; indent 3
|
||||
|
||||
(syntax-case* stx () x
|
||||
[(_ x) #'#f]
|
||||
[(_ x y) #'#t])
|
||||
|
||||
(syntax-case*
|
||||
stx
|
||||
(#%module-begin
|
||||
module
|
||||
define-values
|
||||
define-syntaxes
|
||||
define
|
||||
define/contract
|
||||
define-syntax
|
||||
struct
|
||||
define-struct)
|
||||
x
|
||||
[(_ x) #'#f]
|
||||
[(_ x y) #'#t])
|
||||
|
||||
;; begin and cond have 0 style
|
||||
(begin
|
||||
0
|
||||
0)
|
||||
|
||||
(begin 0
|
||||
0)
|
||||
|
||||
(cond [1 2]
|
||||
[3 4])
|
||||
|
||||
(cond
|
||||
[1 2]
|
||||
[3 4])
|
||||
|
||||
(if a
|
||||
x
|
||||
x)
|
||||
|
||||
;; begin*
|
||||
|
||||
(begin-for-foo 0
|
||||
0)
|
||||
|
||||
(begin-for-foo
|
||||
0
|
||||
0)
|
||||
|
||||
(with-handlers ([x y])
|
||||
a b c)
|
||||
|
||||
;; def, with-, call-with- and other 'defun style
|
||||
|
||||
(define (x) x x
|
||||
x)
|
||||
|
||||
(struct x x
|
||||
())
|
||||
|
||||
(match-define (list x y)
|
||||
(list 1 2))
|
||||
|
||||
(with-output-to-file path #:mode 'text #:exists 'replace
|
||||
(λ () (display "Hello, world.")))
|
||||
|
||||
(call-with-output-file path #:mode 'text #:exists 'replace
|
||||
(λ (out) (display "Hello, world." out)))
|
||||
|
||||
|
||||
;;; Special forms: When the first non-distinguished form is on the
|
||||
;;; same line as distinguished forms, disregard it for indent.
|
||||
|
||||
;; module has indent 2
|
||||
|
||||
(module 1
|
||||
2
|
||||
3
|
||||
4
|
||||
5)
|
||||
|
||||
;; Normal case
|
||||
(module 1 2
|
||||
3
|
||||
4
|
||||
5)
|
||||
|
||||
;; Weird case -- but this is how scheme-mode indents it.
|
||||
(module 1 2 3
|
||||
4
|
||||
5)
|
||||
|
||||
;; Weird case -- but this is how scheme-mode indents it.
|
||||
(module 1 2 3 4
|
||||
5)
|
||||
|
||||
;;; for/fold
|
||||
|
||||
;; for/fold untyped, accum on same line
|
||||
(for/fold ([a 0]
|
||||
[b 0])
|
||||
([x 0]
|
||||
[y 0])
|
||||
#t)
|
||||
|
||||
;; for/fold untyped, accum on different line
|
||||
(for/fold
|
||||
([a 0]
|
||||
[b 0])
|
||||
([x 0]
|
||||
[y 0])
|
||||
#t)
|
||||
|
||||
;; for/fold typed, type on same line
|
||||
(for/fold : T
|
||||
([a 0]
|
||||
[b 0])
|
||||
([x 0]
|
||||
[y 0])
|
||||
#t)
|
||||
|
||||
;; for/fold typed, type on different line
|
||||
(for/fold
|
||||
: T
|
||||
([a 0]
|
||||
[b 0])
|
||||
([x 0]
|
||||
[y 0])
|
||||
#t)
|
||||
|
||||
;;; Bug #50
|
||||
|
||||
'((x
|
||||
y) A
|
||||
z
|
||||
(x
|
||||
y) A
|
||||
z)
|
||||
|
||||
(match args
|
||||
[(list x) (x
|
||||
y)] ...
|
||||
[(list x) (x y)] ...
|
||||
[(list x) (x y)] ...)
|
||||
|
||||
(define-syntax (fstruct stx)
|
||||
(syntax-parse stx
|
||||
[(_ id:id (field:id ...))
|
||||
(with-syntax ([(accessor ...)
|
||||
(for/list ([fld (in-list (syntax->list #'(field ...)))])
|
||||
(format-id stx "~a-~a" (syntax->datum #'id) fld))])
|
||||
#'(serializable-struct
|
||||
id (field ...) #:transparent
|
||||
#:property prop:procedure
|
||||
(lambda (self . args)
|
||||
(match args
|
||||
[(list 'field) (accessor self)] ...
|
||||
[(list (list 'field)) (accessor self)] ...
|
||||
[(list (list-rest 'field fields)) ((accessor self) fields)] ...
|
||||
[(list-rest 'field f args)
|
||||
(struct-copy id self
|
||||
[field (apply f (accessor self) args)])] ...
|
||||
[(list-rest (list 'field) f args) ;<-- THIS SEXPR IS INDENTED TOO FAR
|
||||
(struct-copy id self
|
||||
[field (apply f (accessor self) args)])] ...
|
||||
[(list-rest (list-rest 'field fields) args)
|
||||
(struct-copy id self
|
||||
[field (apply (accessor self) fields args)])] ...))))]))
|
||||
|
||||
;; Bug #123
|
||||
|
||||
#hash([a . (#hash()
|
||||
0)]
|
||||
[b . (#hasheq()
|
||||
0)]
|
||||
[c . (#fx(0 1 2)
|
||||
0)]
|
||||
[d . (#fx3(0 1 2)
|
||||
0)]
|
||||
[e . (#fl(0.0 1.0 2.0)
|
||||
0)]
|
||||
[f . (#fl3(0.0 1.0 2.0)
|
||||
0)]
|
||||
[g . (#s(foo x)
|
||||
0)]
|
||||
[h . (#3(0 1 2)
|
||||
0)])
|
||||
|
||||
;; Bug #136
|
||||
|
||||
#;(list 1
|
||||
#;2
|
||||
3)
|
||||
|
||||
(list 1
|
||||
#;(list 1
|
||||
(let ([x 2]
|
||||
#;[y 3])
|
||||
x)
|
||||
3)
|
||||
2
|
||||
3)
|
||||
|
||||
;; Bug #243
|
||||
(cond [x y
|
||||
z]
|
||||
[(= a x) y
|
||||
z])
|
||||
|
||||
;; Bug #262
|
||||
(define-metafunction λL
|
||||
∪ : (x ...) ... -> (x ...)
|
||||
[(∪ any_ls ...)
|
||||
,(apply append (term (any_ls ...)))])
|
||||
325
elpa/racket-mode-20181004.309/racket/example/indent.rkt.faceup
Normal file
325
elpa/racket-mode-20181004.309/racket/example/indent.rkt.faceup
Normal file
@@ -0,0 +1,325 @@
|
||||
«m:;; »«x:-*- racket-indent-sequence-depth: 100; racket-indent-curly-as-sequence: t; -*-
|
||||
»
|
||||
«m:;;; »«x:NOTE: After changing this file you will need to M-x faceup-write-file
|
||||
»«m:;;; »«x:to regenerate the .faceup test comparison file.
|
||||
»«m:;;;»«x:
|
||||
»«m:;;; »«x:NOTE: You may need to disable certain features -- for example
|
||||
»«m:;;; »«x:global-paren-face-mode -- during the M-x faceup-write-file.
|
||||
»
|
||||
«m:;;; »«x:Quoted list
|
||||
»
|
||||
'(a b
|
||||
(a b
|
||||
c))
|
||||
|
||||
'((«:racket-selfeval-face:1») «:racket-selfeval-face:2» «:racket-selfeval-face:3»
|
||||
(«:racket-selfeval-face:3»)
|
||||
«:racket-selfeval-face:4» «:racket-selfeval-face:5»)
|
||||
|
||||
«m:;;; »«x:Quasiquoted list (align with head) and unquote or unquote-splicing
|
||||
»«m:;;; »«x:(use normal indent rules for the form).
|
||||
»
|
||||
`(Part ()
|
||||
(PartNumber ()
|
||||
,part)
|
||||
(ETag ()
|
||||
,etag))
|
||||
|
||||
`((,(x)
|
||||
,y))
|
||||
|
||||
`(Delete
|
||||
,@(«k:for/list» ([p («k:in-list» paths)])
|
||||
`(«t:Object» ()
|
||||
(Key () ,p))))
|
||||
|
||||
«m:;;; »«x:Syntax
|
||||
»
|
||||
#'(«k:for/list» ([x xs])
|
||||
x)
|
||||
|
||||
#`(«k:for/list» ([x xs])
|
||||
x)
|
||||
|
||||
#'(«k:#%app» («k:#%app» «b:hasheq» («k:quote» a) («k:quote» «:racket-selfeval-face:42»))
|
||||
(«k:quote» a))
|
||||
|
||||
(«k:#%app» («k:#%app» «b:hasheq» («k:quote» a) («k:quote» «:racket-selfeval-face:42»))
|
||||
(«k:quote» a))
|
||||
|
||||
#'(foo («k:#%app» «b:hasheq» («k:quote» a) («k:quote» «:racket-selfeval-face:42»))
|
||||
(«k:quote» a))
|
||||
|
||||
«m:;;; »«x:Rackjure style dictionary (when racket-indent-curly-as-sequence is t).
|
||||
»
|
||||
{a b
|
||||
c d}
|
||||
|
||||
{a b
|
||||
c d
|
||||
b '(a x
|
||||
s (x y
|
||||
x v))}
|
||||
|
||||
«m:;;; »«x:Vector
|
||||
»
|
||||
#(a b
|
||||
c d)
|
||||
|
||||
«m:;;; »«x:List with a keyword as first member (e.g. in many contracts)
|
||||
»
|
||||
(«:racket-keyword-argument-face:#:x» y
|
||||
«:racket-keyword-argument-face:#:y» x)
|
||||
|
||||
«m:;;; »«x:Normal function application.
|
||||
»
|
||||
(foobar x
|
||||
y
|
||||
z)
|
||||
|
||||
(foobar
|
||||
x
|
||||
y
|
||||
z)
|
||||
|
||||
(«b:dict-set» a
|
||||
b
|
||||
c)
|
||||
|
||||
(«b:dict-set»
|
||||
a
|
||||
b
|
||||
c)
|
||||
|
||||
(«b:call-with-values» («k:lambda» () («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»))
|
||||
«b:+»)
|
||||
|
||||
(«b:call-with-values»
|
||||
(«k:lambda» () («b:values» «:racket-selfeval-face:1» «:racket-selfeval-face:2»))
|
||||
«b:+»)
|
||||
|
||||
«m:;;; »«x:Forms with special indentation
|
||||
»
|
||||
(«k:let» ([«v:x» «:racket-selfeval-face:0»])
|
||||
x)
|
||||
|
||||
«m:;; »«x:indent 2
|
||||
»
|
||||
(«k:syntax-case» stx ()
|
||||
[(«k:_» x) #«:racket-selfeval-face:'#f»]
|
||||
[(«k:_» x y) #«:racket-selfeval-face:'#t»])
|
||||
|
||||
«m:;; »«x:indent 3
|
||||
»
|
||||
(«k:syntax-case*» stx () x
|
||||
[(«k:_» x) #«:racket-selfeval-face:'#f»]
|
||||
[(«k:_» x y) #«:racket-selfeval-face:'#t»])
|
||||
|
||||
(«k:syntax-case*»
|
||||
stx
|
||||
(«k:#%module-begin»
|
||||
«k:module»
|
||||
«k:define-values»
|
||||
«k:define-syntaxes»
|
||||
«k:define»
|
||||
«b:define/contract»
|
||||
«k:define-syntax»
|
||||
«k:struct»
|
||||
«k:define-struct»)
|
||||
x
|
||||
[(«k:_» x) #«:racket-selfeval-face:'#f»]
|
||||
[(«k:_» x y) #«:racket-selfeval-face:'#t»])
|
||||
|
||||
«m:;; »«x:begin and cond have 0 style
|
||||
»(«k:begin»
|
||||
«:racket-selfeval-face:0»
|
||||
«:racket-selfeval-face:0»)
|
||||
|
||||
(«k:begin» «:racket-selfeval-face:0»
|
||||
«:racket-selfeval-face:0»)
|
||||
|
||||
(«k:cond» [«:racket-selfeval-face:1» «:racket-selfeval-face:2»]
|
||||
[«:racket-selfeval-face:3» «:racket-selfeval-face:4»])
|
||||
|
||||
(«k:cond»
|
||||
[«:racket-selfeval-face:1» «:racket-selfeval-face:2»]
|
||||
[«:racket-selfeval-face:3» «:racket-selfeval-face:4»])
|
||||
|
||||
(«k:if» a
|
||||
x
|
||||
x)
|
||||
|
||||
«m:;; »«x:begin*
|
||||
»
|
||||
(begin-for-foo «:racket-selfeval-face:0»
|
||||
«:racket-selfeval-face:0»)
|
||||
|
||||
(begin-for-foo
|
||||
«:racket-selfeval-face:0»
|
||||
«:racket-selfeval-face:0»)
|
||||
|
||||
(«k:with-handlers» ([x y])
|
||||
a b c)
|
||||
|
||||
«m:;; »«x:def, with-, call-with- and other 'defun style
|
||||
»
|
||||
(«k:define» («f:x») x x
|
||||
x)
|
||||
|
||||
(«k:struct» x x
|
||||
())
|
||||
|
||||
(«b:match-define» («b:list» x y)
|
||||
(«b:list» «:racket-selfeval-face:1» «:racket-selfeval-face:2»))
|
||||
|
||||
(«k:with-output-to-file» path «:racket-keyword-argument-face:#:mode» «:racket-selfeval-face:'text» «:racket-keyword-argument-face:#:exists» «:racket-selfeval-face:'replace»
|
||||
(«k:λ» () («b:display» «s:"Hello, world."»)))
|
||||
|
||||
(«k:call-with-output-file» path «:racket-keyword-argument-face:#:mode» «:racket-selfeval-face:'text» «:racket-keyword-argument-face:#:exists» «:racket-selfeval-face:'replace»
|
||||
(«k:λ» (out) («b:display» «s:"Hello, world."» out)))
|
||||
|
||||
|
||||
«m:;;; »«x:Special forms: When the first non-distinguished form is on the
|
||||
»«m:;;; »«x:same line as distinguished forms, disregard it for indent.
|
||||
»
|
||||
«m:;; »«x:module has indent 2
|
||||
»
|
||||
(«k:module» «:racket-selfeval-face:1»
|
||||
«:racket-selfeval-face:2»
|
||||
«:racket-selfeval-face:3»
|
||||
«:racket-selfeval-face:4»
|
||||
«:racket-selfeval-face:5»)
|
||||
|
||||
«m:;; »«x:Normal case
|
||||
»(«k:module» «:racket-selfeval-face:1» «:racket-selfeval-face:2»
|
||||
«:racket-selfeval-face:3»
|
||||
«:racket-selfeval-face:4»
|
||||
«:racket-selfeval-face:5»)
|
||||
|
||||
«m:;; »«x:Weird case -- but this is how scheme-mode indents it.
|
||||
»(«k:module» «:racket-selfeval-face:1» «:racket-selfeval-face:2» «:racket-selfeval-face:3»
|
||||
«:racket-selfeval-face:4»
|
||||
«:racket-selfeval-face:5»)
|
||||
|
||||
«m:;; »«x:Weird case -- but this is how scheme-mode indents it.
|
||||
»(«k:module» «:racket-selfeval-face:1» «:racket-selfeval-face:2» «:racket-selfeval-face:3» «:racket-selfeval-face:4»
|
||||
«:racket-selfeval-face:5»)
|
||||
|
||||
«m:;;; »«x:for/fold
|
||||
»
|
||||
«m:;; »«x:for/fold untyped, accum on same line
|
||||
»(«k:for/fold» ([a «:racket-selfeval-face:0»]
|
||||
[b «:racket-selfeval-face:0»])
|
||||
([x «:racket-selfeval-face:0»]
|
||||
[y «:racket-selfeval-face:0»])
|
||||
«:racket-selfeval-face:#t»)
|
||||
|
||||
«m:;; »«x:for/fold untyped, accum on different line
|
||||
»(«k:for/fold»
|
||||
([a «:racket-selfeval-face:0»]
|
||||
[b «:racket-selfeval-face:0»])
|
||||
([x «:racket-selfeval-face:0»]
|
||||
[y «:racket-selfeval-face:0»])
|
||||
«:racket-selfeval-face:#t»)
|
||||
|
||||
«m:;; »«x:for/fold typed, type on same line
|
||||
»(«k:for/fold» «b::» T
|
||||
([a «:racket-selfeval-face:0»]
|
||||
[b «:racket-selfeval-face:0»])
|
||||
([x «:racket-selfeval-face:0»]
|
||||
[y «:racket-selfeval-face:0»])
|
||||
«:racket-selfeval-face:#t»)
|
||||
|
||||
«m:;; »«x:for/fold typed, type on different line
|
||||
»(«k:for/fold»
|
||||
«b::» T
|
||||
([a «:racket-selfeval-face:0»]
|
||||
[b «:racket-selfeval-face:0»])
|
||||
([x «:racket-selfeval-face:0»]
|
||||
[y «:racket-selfeval-face:0»])
|
||||
«:racket-selfeval-face:#t»)
|
||||
|
||||
«m:;;; »«x:Bug #50
|
||||
»
|
||||
'((x
|
||||
y) A
|
||||
z
|
||||
(x
|
||||
y) A
|
||||
z)
|
||||
|
||||
(«b:match» args
|
||||
[(«b:list» x) (x
|
||||
y)] «k:...»
|
||||
[(«b:list» x) (x y)] «k:...»
|
||||
[(«b:list» x) (x y)] «k:...»)
|
||||
|
||||
(«k:define-syntax» («f:fstruct» stx)
|
||||
(«b:syntax-parse» stx
|
||||
[(«k:_» id:id (field:id «k:...»))
|
||||
(«k:with-syntax» ([(accessor «k:...»)
|
||||
(«k:for/list» ([fld («k:in-list» («b:syntax->list» #'(«b:field» «k:...»)))])
|
||||
(«b:format-id» stx «s:"~a-~a"» («b:syntax->datum» #«:racket-selfeval-face:'id») fld))])
|
||||
#'(serializable-struct
|
||||
id («b:field» «k:...») «:racket-keyword-argument-face:#:transparent»
|
||||
«:racket-keyword-argument-face:#:property» «b:prop:procedure»
|
||||
(«k:lambda» (self . args)
|
||||
(«b:match» args
|
||||
[(«b:list» «:racket-selfeval-face:'field») (accessor self)] «k:...»
|
||||
[(«b:list» («b:list» «:racket-selfeval-face:'field»)) (accessor self)] «k:...»
|
||||
[(«b:list» (list-rest «:racket-selfeval-face:'field» fields)) ((accessor self) fields)] «k:...»
|
||||
[(list-rest «:racket-selfeval-face:'field» f args)
|
||||
(«k:struct-copy» id self
|
||||
[«b:field» («k:apply» f (accessor self) args)])] «k:...»
|
||||
[(list-rest («b:list» «:racket-selfeval-face:'field») f args) «m:;»«x:<-- THIS SEXPR IS INDENTED TOO FAR
|
||||
» («k:struct-copy» id self
|
||||
[«b:field» («k:apply» f (accessor self) args)])] «k:...»
|
||||
[(list-rest (list-rest «:racket-selfeval-face:'field» fields) args)
|
||||
(«k:struct-copy» id self
|
||||
[«b:field» («k:apply» (accessor self) fields args)])] «k:...»))))]))
|
||||
|
||||
«m:;; »«x:Bug #123
|
||||
»
|
||||
#hash([a . (#hash()
|
||||
«:racket-selfeval-face:0»)]
|
||||
[b . (#hasheq()
|
||||
«:racket-selfeval-face:0»)]
|
||||
[c . (#fx(«:racket-selfeval-face:0» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)
|
||||
«:racket-selfeval-face:0»)]
|
||||
[d . (#fx3(«:racket-selfeval-face:0» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)
|
||||
«:racket-selfeval-face:0»)]
|
||||
[e . (#fl(«:racket-selfeval-face:0.0» «:racket-selfeval-face:1.0» «:racket-selfeval-face:2.0»)
|
||||
«:racket-selfeval-face:0»)]
|
||||
[f . (#fl3(«:racket-selfeval-face:0.0» «:racket-selfeval-face:1.0» «:racket-selfeval-face:2.0»)
|
||||
«:racket-selfeval-face:0»)]
|
||||
[g . (#s(foo x)
|
||||
«:racket-selfeval-face:0»)]
|
||||
[h . (#3(«:racket-selfeval-face:0» «:racket-selfeval-face:1» «:racket-selfeval-face:2»)
|
||||
«:racket-selfeval-face:0»)])
|
||||
|
||||
«m:;; »«x:Bug #136
|
||||
»
|
||||
«m:#;»«x:(list 1
|
||||
#;2
|
||||
3)»
|
||||
|
||||
(«b:list» «:racket-selfeval-face:1»
|
||||
«m:#;»«x:(list 1
|
||||
(let ([x 2]
|
||||
#;[y 3])
|
||||
x)
|
||||
3)»
|
||||
«:racket-selfeval-face:2»
|
||||
«:racket-selfeval-face:3»)
|
||||
|
||||
«m:;; »«x:Bug #243
|
||||
»(«k:cond» [x y
|
||||
z]
|
||||
[(«b:=» a x) y
|
||||
z])
|
||||
|
||||
«m:;; »«x:Bug #262
|
||||
»(define-metafunction «v:λL»
|
||||
∪ «b::» (x «k:...») «k:...» «b:->» (x «k:...»)
|
||||
[(∪ any_ls «k:...»)
|
||||
,(«k:apply» «b:append» (term (any_ls «k:...»)))])
|
||||
@@ -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)))))))
|
||||
235
elpa/racket-mode-20181004.309/racket/find.rkt
Normal file
235
elpa/racket-mode-20181004.309/racket/find.rkt
Normal file
@@ -0,0 +1,235 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/contract
|
||||
(only-in racket/format ~a)
|
||||
racket/list
|
||||
racket/match
|
||||
"syntax.rkt")
|
||||
|
||||
(provide find-definition
|
||||
find-signature)
|
||||
|
||||
(define location/c (list/c path-string? natural-number/c natural-number/c))
|
||||
|
||||
;; Try to find the definition of `str`, returning a list with the file
|
||||
;; name, line and column, 'kernel, or #f if not found.
|
||||
(define/contract (find-definition str)
|
||||
(-> string? (or/c #f 'kernel location/c))
|
||||
(match (find-definition/stx str)
|
||||
[(list* stx file submods)
|
||||
(list (path->string (or (syntax-source stx) file))
|
||||
(or (syntax-line stx) 1)
|
||||
(or (syntax-column stx) 0))]
|
||||
[v v]))
|
||||
|
||||
;; Try to find the definition of `str`, returning its signature or #f.
|
||||
;; When defined in 'kernel, returns a form saying so, not #f.
|
||||
(define/contract (find-signature str)
|
||||
(-> string? (or/c #f pair?))
|
||||
(match (find-definition/stx str)
|
||||
['kernel '("defined in #%kernel, signature unavailable")]
|
||||
[(list* id-stx file submods)
|
||||
(define file-stx (file->syntax file))
|
||||
(define sub-stx (submodule file submods file-stx))
|
||||
(match ($signature (syntax-e id-stx) sub-stx)
|
||||
[(? syntax? stx) (syntax->datum stx)]
|
||||
[_ #f])]
|
||||
[v v]))
|
||||
|
||||
(define/contract (find-definition/stx str)
|
||||
(-> string?
|
||||
(or/c #f 'kernel (cons/c syntax? (cons/c path? (listof symbol?)))))
|
||||
(match (identifier-binding* str)
|
||||
[(? list? xs)
|
||||
(define ht (make-hash)) ;cache in case source repeated
|
||||
(for/or ([x (in-list (remove-duplicates xs))])
|
||||
(match x
|
||||
[(cons id 'kernel) 'kernel]
|
||||
[(list* id file submods)
|
||||
(define (sub-stx file->stx)
|
||||
(hash-ref! ht (cons file file->stx)
|
||||
(λ () (submodule file submods (file->stx file)))))
|
||||
(match (or ($definition id (sub-stx file->expanded-syntax))
|
||||
(match ($renaming-provide id (sub-stx file->syntax))
|
||||
[(? syntax? s)
|
||||
($definition (syntax-e s) (sub-stx file->expanded-syntax))]
|
||||
[_ #f]))
|
||||
[#f #f]
|
||||
[stx (list* stx file submods)])]))]
|
||||
[_ #f]))
|
||||
|
||||
;; Distill identifier-binding to what we need. Unfortunately it can't
|
||||
;; report the definition id in the case of a contract-out and a
|
||||
;; rename-out, both. For `(provide (contract-out [rename orig new
|
||||
;; contract]))` it reports (1) the contract-wrapper as the id, and (2)
|
||||
;; `new` as the nominal-id -- but NOT (3) `orig`. Instead the caller
|
||||
;; will need try using `renaming-provide`.
|
||||
(define/contract (identifier-binding* v)
|
||||
(-> (or/c string? symbol? identifier?)
|
||||
(or/c #f
|
||||
(listof (cons/c symbol?
|
||||
(or/c 'kernel
|
||||
(cons/c path-string? (listof symbol?)))))))
|
||||
(define sym->id namespace-symbol->identifier)
|
||||
(define id (cond [(string? v) (sym->id (string->symbol v))]
|
||||
[(symbol? v) (sym->id v)]
|
||||
[(identifier? v) v]))
|
||||
(match (identifier-binding id)
|
||||
[(list source-mpi source-id
|
||||
nominal-source-mpi nominal-source-id
|
||||
source-phase import-phase nominal-export-phase)
|
||||
(list (cons source-id (mpi->path source-mpi))
|
||||
(cons nominal-source-id (mpi->path nominal-source-mpi)))]
|
||||
[_ #f]))
|
||||
|
||||
(define/contract (mpi->path mpi)
|
||||
(-> module-path-index?
|
||||
(or/c 'kernel
|
||||
(cons/c path-string? (listof symbol?))))
|
||||
(define (hash-bang-symbol? v)
|
||||
(and (symbol? v)
|
||||
(regexp-match? #px"^#%" (symbol->string v))))
|
||||
(match (resolved-module-path-name (module-path-index-resolve mpi))
|
||||
[(? hash-bang-symbol?) 'kernel]
|
||||
[(? path-string? path) (list path)]
|
||||
[(? symbol? sym) (list (build-path (current-load-relative-directory)
|
||||
(~a sym ".rkt")))]
|
||||
[(list (? path-string? path) (? symbol? subs) ...)
|
||||
(list* path subs)]))
|
||||
|
||||
;; For use with syntax-case*. When we use syntax-case for syntax-e equality.
|
||||
(define (syntax-e-eq? a b)
|
||||
(eq? (syntax-e a) (syntax-e b)))
|
||||
|
||||
(define ((make-eq-sym? sym) stx)
|
||||
(and (eq? sym (syntax-e stx)) stx))
|
||||
|
||||
(define (file-module file)
|
||||
(match (path->string (last (explode-path file)))
|
||||
[(pregexp "(.+?)\\.rkt$" (list _ v)) (string->symbol v)]))
|
||||
|
||||
;; Return bodies (wrapped in begin) of the module indicated by
|
||||
;; file and sub-mod-syms.
|
||||
(define (submodule file sub-mod-syms stx)
|
||||
(submodule* (cons (file-module file) sub-mod-syms) stx))
|
||||
|
||||
(define (submodule* mods stx)
|
||||
(match-define (cons this more) mods)
|
||||
(define (subs stxs)
|
||||
(if (empty? more)
|
||||
#`(begin . #,stxs)
|
||||
(ormap (λ (stx) (submodule* more stx))
|
||||
(syntax->list stxs))))
|
||||
(syntax-case* stx (module #%module-begin) syntax-e-eq?
|
||||
[(module name _ (#%module-begin . stxs))
|
||||
(eq? this (syntax-e #'name))
|
||||
(subs #'stxs)]
|
||||
[(module name _ . stxs)
|
||||
(eq? this (syntax-e #'name))
|
||||
(subs #'stxs)]
|
||||
[_ #f]))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
(check-equal? (syntax->datum
|
||||
(submodule "/path/to/file.rkt" '(a b c)
|
||||
#'(module file racket
|
||||
(module a racket
|
||||
(module not-b racket #f)
|
||||
(module b racket
|
||||
(module not-c racket #f)
|
||||
(module c racket "bingo")
|
||||
(module not-c racket #f))
|
||||
(module not-b racket #f)))))
|
||||
'(begin "bingo")))
|
||||
|
||||
;; Given a symbol and syntax, return syntax corresponding to the
|
||||
;; definition. Intentionally does NOT walk into module forms, so, give
|
||||
;; us the module bodies wrapped in begin.
|
||||
;;
|
||||
;; If `stx` is expanded we can find things defined via definer
|
||||
;; macros.
|
||||
;;
|
||||
;; If `stx` is not expanded, we will miss some things, however the
|
||||
;; syntax will be closer to what a human expects -- e.g. `(define (f
|
||||
;; x) x)` instead of `(define-values (f) (lambda (x) x))`.
|
||||
(define ($definition sym stx) ;;symbol? syntax? -> syntax?
|
||||
(define eq-sym? (make-eq-sym? sym))
|
||||
;; This is a hack to handle definer macros that neglect to set
|
||||
;; srcloc properly using syntax/loc or (format-id ___ #:source __):
|
||||
;; If the stx lacks srcloc and its parent stx has srcloc, return the
|
||||
;; parent stx instead. Caveats: 1. Assumes caller only cares about
|
||||
;; the srcloc. 2. We only check immediate parent. 3. We only use
|
||||
;; this for define-values and define-syntaxes, below, on the
|
||||
;; assumption that this only matters for fully-expanded syntax.
|
||||
(define (loc s)
|
||||
(if (and (not (syntax-line s))
|
||||
(syntax-line stx))
|
||||
stx
|
||||
s))
|
||||
(syntax-case* stx
|
||||
(begin define-values define-syntaxes
|
||||
define define/contract
|
||||
define-syntax struct define-struct)
|
||||
syntax-e-eq?
|
||||
[(begin . stxs) (ormap (λ (stx) ($definition sym stx))
|
||||
(syntax->list #'stxs))]
|
||||
[(define (s . _) . _) (eq-sym? #'s) stx]
|
||||
[(define/contract (s . _) . _) (eq-sym? #'s) stx]
|
||||
[(define s . _) (eq-sym? #'s) stx]
|
||||
[(define-values (ss ...) . _) (ormap eq-sym? (syntax->list #'(ss ...)))
|
||||
(loc (ormap eq-sym? (syntax->list #'(ss ...))))]
|
||||
[(define-syntax (s . _) . _) (eq-sym? #'s) stx]
|
||||
[(define-syntax s . _) (eq-sym? #'s) stx]
|
||||
[(define-syntaxes (ss ...) . _) (ormap eq-sym? (syntax->list #'(ss ...)))
|
||||
(loc (ormap eq-sym? (syntax->list #'(ss ...))))]
|
||||
[(define-struct s . _) (eq-sym? #'s) stx]
|
||||
[(define-struct (s _) . _) (eq-sym? #'s) stx]
|
||||
[(struct s . _) (eq-sym? #'s) stx]
|
||||
[(struct (s _) . _) (eq-sym? #'s) stx]
|
||||
[_ #f]))
|
||||
|
||||
;; Given a symbol and syntax, return syntax corresponding to the
|
||||
;; function definition signature. The input syntax should NOT be
|
||||
;; `expand`ed. This intentionally does NOT walk into module forms, so,
|
||||
;; give us the module bodies wrapped in begin.
|
||||
(define ($signature sym stx) ;;symbol? syntax? -> (or/c #f list?)
|
||||
(define eq-sym? (make-eq-sym? sym))
|
||||
(syntax-case* stx (begin define define/contract case-lambda) syntax-e-eq?
|
||||
[(begin . stxs) (ormap (λ (stx) ($signature sym stx))
|
||||
(syntax->list #'stxs))]
|
||||
[(define (s . as) . _) (eq-sym? #'s) #'(s . as)]
|
||||
[(define/contract (s . as) . _) (eq-sym? #'s) #'(s . as)]
|
||||
[(define s (case-lambda [(ass ...) . _] ...)) (eq-sym? #'s) #'((s ass ...) ...)]
|
||||
[_ #f]))
|
||||
|
||||
;; Find sym in a contracting and/or renaming provide, and return the
|
||||
;; syntax for the ORIGINAL identifier (before being contracted and/or
|
||||
;; renamed). The input syntax should NOT be expanded.
|
||||
(define ($renaming-provide sym stx) ;;symbol? syntax? -> syntax?
|
||||
(define eq-sym? (make-eq-sym? sym))
|
||||
(syntax-case* stx (begin provide provide/contract) syntax-e-eq?
|
||||
[(begin . stxs)
|
||||
(ormap (λ (stx) ($renaming-provide sym stx))
|
||||
(syntax->list #'stxs))]
|
||||
[(provide/contract . stxs)
|
||||
(for/or ([stx (syntax->list #'stxs)])
|
||||
(syntax-case stx ()
|
||||
[(s _) (eq-sym? #'s)]
|
||||
[_ #f]))]
|
||||
[(provide . stxs)
|
||||
(for/or ([stx (syntax->list #'stxs)])
|
||||
(syntax-case* stx (contract-out rename-out) syntax-e-eq?
|
||||
[(contract-out . stxs)
|
||||
(for/or ([stx (syntax->list #'stxs)])
|
||||
(syntax-case* stx (rename) syntax-e-eq?
|
||||
[(rename orig s _) (eq-sym? #'s) #'orig]
|
||||
[(s _) (eq-sym? #'s) #'s]
|
||||
[_ #f]))]
|
||||
[(rename-out . stxs)
|
||||
(for/or ([stx (syntax->list #'stxs)])
|
||||
(syntax-case* stx () syntax-e-eq?
|
||||
[(orig s) (eq-sym? #'s) #'orig]
|
||||
[_ #f]))]
|
||||
[_ #f]))]
|
||||
[_ #f]))
|
||||
37
elpa/racket-mode-20181004.309/racket/fresh-line.rkt
Normal file
37
elpa/racket-mode-20181004.309/racket/fresh-line.rkt
Normal 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))
|
||||
42
elpa/racket-mode-20181004.309/racket/gui.rkt
Normal file
42
elpa/racket-mode-20181004.309/racket/gui.rkt
Normal file
@@ -0,0 +1,42 @@
|
||||
#lang at-exp racket/base
|
||||
|
||||
(require (only-in racket/format ~a)
|
||||
"util.rkt")
|
||||
|
||||
(provide gui-required?
|
||||
require-gui
|
||||
txt/gui)
|
||||
|
||||
(define root-eventspace #f) ;#f until racket/gui/base required first time
|
||||
|
||||
(define (gui-required?)
|
||||
(and root-eventspace #t))
|
||||
|
||||
;; Extra explanation for situations like issue 93, entering `(require
|
||||
;; redex)` in the REPL, as opposed to having it in a .rkt file.
|
||||
(define more-explanation
|
||||
@~a{The namespace was reset. Any `require`s you entered in the REPL were "undone".
|
||||
This includes the `require` you just entered. You may want to enter it again.})
|
||||
|
||||
;; This must be called from the main thread, under the main custodian!
|
||||
(define (require-gui in-repl?)
|
||||
(when (gui-required?)
|
||||
(error 'require-gui "Already required"))
|
||||
(display-commented "On-demand, one-time instantiation of racket/gui/base.")
|
||||
(when in-repl?
|
||||
(display-commented more-explanation))
|
||||
(define current-eventspace (gui-dyn-req 'current-eventspace))
|
||||
(define make-eventspace (gui-dyn-req 'make-eventspace))
|
||||
(set! root-eventspace (make-eventspace))
|
||||
(current-eventspace root-eventspace))
|
||||
|
||||
;; Like mz/mr from racket/sandbox.
|
||||
(define-syntax txt/gui
|
||||
(syntax-rules ()
|
||||
[(_ txtval guisym)
|
||||
(if (gui-required?)
|
||||
(gui-dyn-req 'guisym)
|
||||
txtval)]))
|
||||
|
||||
(define (gui-dyn-req sym)
|
||||
(dynamic-require 'racket/gui/base sym))
|
||||
26
elpa/racket-mode-20181004.309/racket/image.rkt
Normal file
26
elpa/racket-mode-20181004.309/racket/image.rkt
Normal 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]))
|
||||
225
elpa/racket-mode-20181004.309/racket/instrument.rkt
Normal file
225
elpa/racket-mode-20181004.309/racket/instrument.rkt
Normal file
@@ -0,0 +1,225 @@
|
||||
#lang at-exp racket/base
|
||||
|
||||
(require (only-in errortrace/errortrace-key
|
||||
errortrace-key)
|
||||
(only-in errortrace/errortrace-lib
|
||||
print-error-trace
|
||||
error-context-display-depth)
|
||||
(only-in errortrace/stacktrace
|
||||
stacktrace^
|
||||
stacktrace@
|
||||
stacktrace-imports^)
|
||||
racket/format
|
||||
racket/match
|
||||
racket/unit
|
||||
syntax/parse
|
||||
"util.rkt")
|
||||
|
||||
(provide make-instrumented-eval-handler
|
||||
error-context-display-depth
|
||||
print-error-trace
|
||||
instrumenting-enabled
|
||||
test-coverage-enabled
|
||||
clear-test-coverage-info!
|
||||
get-test-coverage-info
|
||||
profiling-enabled
|
||||
clear-profile-info!
|
||||
get-profile-info)
|
||||
|
||||
;;; Core instrumenting
|
||||
|
||||
(define instrumenting-enabled (make-parameter #f))
|
||||
|
||||
;; These two parameters added to errortrace/stacktrace circa 6.0. They
|
||||
;; help make-st-mark capture the original, unexpanded syntax, which is
|
||||
;; nicer to report in a stack trace. Lacking that in older Rackets,
|
||||
;; the srcloc is still correct and Emacs next-error will work.
|
||||
(define original-stx (with-handlers ([exn:fail? (λ _ (make-parameter #f))])
|
||||
(dynamic-require 'errortrace/stacktrace 'original-stx)))
|
||||
(define expanded-stx (with-handlers ([exn:fail? (λ _ (make-parameter #f))])
|
||||
(dynamic-require 'errortrace/stacktrace 'expanded-stx)))
|
||||
|
||||
(define ((make-instrumented-eval-handler [orig-eval (current-eval)]) orig-exp)
|
||||
;; This is modeled after the one in DrRacket.
|
||||
(cond
|
||||
[(or (not (instrumenting-enabled))
|
||||
(compiled-expression? (syntax-or-sexpr->sexpr orig-exp)))
|
||||
(orig-eval orig-exp)]
|
||||
[else
|
||||
(let loop ([exp (syntax-or-sexpr->syntax orig-exp)])
|
||||
(let ([top-e (expand-syntax-to-top-form exp)])
|
||||
(syntax-case top-e (begin)
|
||||
[(begin expr ...)
|
||||
;; Found a `begin', so expand/eval each contained
|
||||
;; expression one at a time
|
||||
(let i-loop ([exprs (syntax->list #'(expr ...))]
|
||||
[last-one (list (void))])
|
||||
(cond
|
||||
[(null? exprs)
|
||||
(apply values last-one)]
|
||||
[else
|
||||
(i-loop (cdr exprs)
|
||||
(call-with-values
|
||||
(λ ()
|
||||
(call-with-continuation-prompt
|
||||
(λ () (loop (car exprs)))
|
||||
(default-continuation-prompt-tag)
|
||||
(λ args
|
||||
(apply
|
||||
abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
args))))
|
||||
list))]))]
|
||||
[_else
|
||||
;; Not `begin', so proceed with normal expand and eval
|
||||
(let* ([expanded-e (expand-syntax top-e)]
|
||||
;; For make-st-mark to work correctly we need to
|
||||
;; parameterize original-stx and expanded-stx.
|
||||
[annotated (parameterize ([original-stx top-e]
|
||||
[expanded-stx expanded-e])
|
||||
(annotate-top expanded-e
|
||||
(namespace-base-phase)))])
|
||||
(warn-about-time-apply expanded-e)
|
||||
(orig-eval annotated))])))]))
|
||||
|
||||
(define (warn-about-time-apply stx)
|
||||
(syntax-parse stx
|
||||
#:datum-literals (#%app time-apply)
|
||||
[(#%app time-apply . _)
|
||||
(display-commented
|
||||
@~a{Warning: time or time-apply used in errortrace annotated code.
|
||||
For meaningful timings, use command-line racket instead!})
|
||||
#t]
|
||||
[(ss ...) (for/or ([stx (in-list (syntax->list #'(ss ...)))])
|
||||
(warn-about-time-apply stx))]
|
||||
[_ #f]))
|
||||
|
||||
|
||||
;;; Better stack traces ("basic errortrace")
|
||||
|
||||
(define base-phase
|
||||
(variable-reference->module-base-phase (#%variable-reference)))
|
||||
|
||||
(define (with-mark mark expr phase)
|
||||
;; This is modeled after the one in errortrace-lib. Specifically,
|
||||
;; use `make-st-mark' for its capture of the original syntax to show
|
||||
;; in the stack trace error message.
|
||||
(match (make-st-mark mark phase)
|
||||
[#f expr]
|
||||
[loc (define phase-shift (- phase base-phase))
|
||||
(with-syntax ([expr expr]
|
||||
[loc loc]
|
||||
[errortrace-key errortrace-key]
|
||||
[qte (syntax-shift-phase-level #'quote phase-shift)]
|
||||
[wcm (syntax-shift-phase-level #'with-continuation-mark
|
||||
phase-shift)])
|
||||
(syntax (wcm (qte errortrace-key)
|
||||
loc
|
||||
expr)))]))
|
||||
|
||||
;; print-error-trace
|
||||
;;
|
||||
;; Just re-provide the one from errortrace-lib because (a) it works
|
||||
;; and (b) the `make-st-mark' representation is intentionally not
|
||||
;; documented.
|
||||
|
||||
|
||||
;;; Test coverage
|
||||
|
||||
(define test-coverage-enabled (make-parameter #f)) ;stacktrace-imports^
|
||||
|
||||
(define test-coverage-info (make-hasheq)) ;(hash/c syntax? mpair?).
|
||||
;; This approach taken from DrR. Presumably set-mcar! is faster than a
|
||||
;; box, which in turn is faster than hash-set!. The cdr cell is
|
||||
;; ignored.
|
||||
|
||||
(define (clear-test-coverage-info!)
|
||||
(hash-clear! test-coverage-info))
|
||||
|
||||
(define (initialize-test-coverage-point expr) ;stacktrace-imports^
|
||||
(hash-set! test-coverage-info expr (mcons #f #f)))
|
||||
|
||||
(define (test-covered expr) ;stacktrace-imports^
|
||||
(define v (hash-ref test-coverage-info expr #f))
|
||||
(and v (with-syntax ([v v])
|
||||
#'(#%plain-app set-mcar! v #t))))
|
||||
|
||||
(define (get-test-coverage-info)
|
||||
;; Due to macro expansion (e.g. to an `if` form), there may be
|
||||
;; multiple data points for the exact same source location. We want
|
||||
;; to logically OR them: If any are true, the source location is
|
||||
;; covered.
|
||||
(define ht (make-hash)) ;; (list src pos span) => cover?
|
||||
(for* ([(stx v) (in-hash test-coverage-info)]
|
||||
[cover? (in-value (mcar v))]
|
||||
[loc (in-value (list (syntax-source stx)
|
||||
(syntax-position stx)
|
||||
(syntax-span stx)))])
|
||||
(match (hash-ref ht loc 'none)
|
||||
['none (hash-set! ht loc cover?)]
|
||||
[#f (when cover? (hash-set! ht loc #t))]
|
||||
[#t (void)]))
|
||||
(for/list ([(loc cover?) (in-hash ht)])
|
||||
(cons cover? loc)))
|
||||
|
||||
;;; Profiling
|
||||
|
||||
(define profile-key (gensym)) ;stacktrace-imports^
|
||||
|
||||
(define profiling-enabled (make-parameter #f)) ;stacktrace-imports^
|
||||
|
||||
(define profile-info (make-hasheq)) ;(hash/c any/c prof?)
|
||||
|
||||
|
||||
(define (clear-profile-info!)
|
||||
(hash-clear! profile-info))
|
||||
|
||||
(struct prof
|
||||
(nest? ;guard nested calls
|
||||
num ;exact-nonnegative-integer?
|
||||
time ;exact-nonnegative-integer?
|
||||
name ;(or/c #f symbol?)
|
||||
expr) ;syntax?
|
||||
#:mutable
|
||||
#:transparent)
|
||||
|
||||
(define (initialize-profile-point key name expr) ;stacktrace-imports^
|
||||
(hash-set! profile-info
|
||||
key
|
||||
(prof #f 0 0 (and (syntax? name) (syntax-e name)) expr)))
|
||||
|
||||
(define (register-profile-start key) ;stacktrace-imports^
|
||||
(define p (hash-ref profile-info key))
|
||||
(set-prof-num! p (add1 (prof-num p)))
|
||||
(cond [(prof-nest? p) #f]
|
||||
[else (set-prof-nest?! p #t)
|
||||
(current-process-milliseconds)]))
|
||||
|
||||
(define (register-profile-done key start) ;stacktrace-imports^
|
||||
(void
|
||||
(when start
|
||||
(define p (hash-ref profile-info key))
|
||||
(set-prof-nest?! p #f)
|
||||
(set-prof-time! p (+ (- (current-process-milliseconds) start)
|
||||
(prof-time p))))))
|
||||
|
||||
(define (get-profile-info)
|
||||
(for/list ([x (in-list (hash-values profile-info))])
|
||||
(match-define (prof nest? count msec name stx) x)
|
||||
(list count msec name stx)))
|
||||
|
||||
|
||||
;;; Finally, invoke the unit
|
||||
(define-values/invoke-unit/infer stacktrace@)
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; example
|
||||
|
||||
;; (parameterize ([instrumenting-enabled #t]
|
||||
;; [test-coverage-enabled #t]
|
||||
;; [profiling-enabled #f]
|
||||
;; [current-eval (make-instrumented-eval-handler (current-eval))])
|
||||
;; (namespace-require (string->path "/tmp/simple.rkt")))
|
||||
;; (get-test-coverage-info)
|
||||
;; (get-profile-info)
|
||||
84
elpa/racket-mode-20181004.309/racket/interactions.rkt
Normal file
84
elpa/racket-mode-20181004.309/racket/interactions.rkt
Normal file
@@ -0,0 +1,84 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/match
|
||||
"fresh-line.rkt")
|
||||
|
||||
(provide current-sync/yield
|
||||
get-interaction)
|
||||
|
||||
;; A channel to which a thread puts interactions that it reads using
|
||||
;; the current-read-interaction handler (which can be set by a lang
|
||||
;; from its configure-runtime, so, this should be compatible with
|
||||
;; any lang, even non-sexpr langs).
|
||||
;;
|
||||
;; This is its own thread and channel for a couple reasons:
|
||||
;;
|
||||
;; - Issue #311. A consumer can use sync/timeout to avoid displaying a
|
||||
;; prompt when multiple interactions are waiting.
|
||||
;;
|
||||
;; - Debugging. We can switch from the normal REPL to a debugger REPL,
|
||||
;; without input being stuck inside a read call for the former.
|
||||
;;
|
||||
;; One wrinkle is we need to be careful about calling yield instead of
|
||||
;; sync when the gui is active. See issue #326.
|
||||
|
||||
;; FIXME??: This used to be under the REPL custodian. Is it OK for it
|
||||
;; _not_ to be, now? For instance what if user runs another file, but
|
||||
;; this is still using the previous current-read-interaction value?
|
||||
(define chan (make-channel))
|
||||
|
||||
(define (read-interaction/put-channel)
|
||||
(define in ((current-get-interaction-input-port)))
|
||||
(define (read-interaction)
|
||||
(with-handlers ([exn:fail? values])
|
||||
((current-read-interaction) (object-name in) in))) ;[^1]
|
||||
(match (read-interaction)
|
||||
[(? eof-object?) (sync in)] ;[^2]
|
||||
[(? exn:fail? e) (channel-put chan e)] ;raise in other thread
|
||||
[v (channel-put chan v)])
|
||||
(read-interaction/put-channel))
|
||||
|
||||
(void (thread read-interaction/put-channel))
|
||||
|
||||
(define current-sync/yield (make-parameter sync)) ;see issue #326
|
||||
|
||||
(define (get-interaction prompt)
|
||||
(match (or (sync/timeout 0.01 chan) ;see issue #311
|
||||
(begin (display-prompt prompt)
|
||||
((current-sync/yield) chan)))
|
||||
[(? exn:fail? exn) (raise exn)]
|
||||
[v v]))
|
||||
|
||||
(define (display-prompt str)
|
||||
(flush-output (current-error-port))
|
||||
(fresh-line)
|
||||
(display str)
|
||||
(display "> ")
|
||||
(flush-output)
|
||||
(zero-column!))
|
||||
|
||||
;; "Footnote" comments about make-prompt-read and many attempts to fix
|
||||
;; issue #305.
|
||||
;;
|
||||
;; [^1]: datalog/lang expects each interaction to be EOF terminated.
|
||||
;; This seems to be a DrRacket convention (?). We could make
|
||||
;; that work here if we composed open-input-string with
|
||||
;; read-line. But that would fail for valid multi-line
|
||||
;; expressions in langs like racket/base e.g. "(+ 1\n2)". We
|
||||
;; could have Emacs racket-repl-submit append some marker that
|
||||
;; lets us know to combine multiple lines here -- but we'd have
|
||||
;; to be careful to eat the marker and avoid combining lines
|
||||
;; when the user is entering input for their own program that
|
||||
;; uses `read-line` etc. Trying to be clever here is maybe not
|
||||
;; smart. I _think_ the safest thing is for each lang like
|
||||
;; datalog to implement current-read-interaction like it says on
|
||||
;; the tin -- it can parse just one expression/statement from a
|
||||
;; normal, "infinite" input port; if that means the lang parser
|
||||
;; has to be tweaked for a single-expression/statement mode of
|
||||
;; usage, so be it.
|
||||
;;
|
||||
;; [^2]: The eof-object? clause is here only for datalog/lang
|
||||
;; configure-runtime.rkt. Its `the-read` returns eof if
|
||||
;; char-ready? is false. WAT. Why doesn't it just block like a
|
||||
;; normal read-interaction handler? Catch this and wait for more
|
||||
;; input to be available before calling it again.
|
||||
98
elpa/racket-mode-20181004.309/racket/keywords.rkt
Normal file
98
elpa/racket-mode-20181004.309/racket/keywords.rkt
Normal 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)
|
||||
93
elpa/racket-mode-20181004.309/racket/logger.rkt
Normal file
93
elpa/racket-mode-20181004.309/racket/logger.rkt
Normal file
@@ -0,0 +1,93 @@
|
||||
#lang at-exp racket/base
|
||||
|
||||
(require racket/match
|
||||
racket/format
|
||||
racket/tcp
|
||||
"elisp.rkt"
|
||||
"util.rkt")
|
||||
|
||||
(provide start-logger-server)
|
||||
|
||||
;; "On start-up, Racket creates an initial logger that is used to
|
||||
;; record events from the core run-time system. For example, an 'debug
|
||||
;; event is reported for each garbage collection (see Garbage
|
||||
;; Collection)." Use that; don't create new one. See issue #325.
|
||||
(define global-logger (current-logger))
|
||||
|
||||
(define (start-logger-server port launch-token)
|
||||
(void (thread (logger-thread port launch-token))))
|
||||
|
||||
(define ((logger-thread port launch-token))
|
||||
(define listener (tcp-listen port 4 #t "127.0.0.1"))
|
||||
(let accept ()
|
||||
(define-values (in out) (tcp-accept listener))
|
||||
(unless (or (not launch-token)
|
||||
(equal? launch-token (elisp-read in)))
|
||||
(display-commented "Authorization failed; exiting")
|
||||
(exit 1))
|
||||
;; Assumption: Any network fail means the client has disconnected,
|
||||
;; therefore we should go back to waiting to accept a connection.
|
||||
(with-handlers ([exn:fail:network? void])
|
||||
(let wait ([receiver never-evt])
|
||||
;; Assumption: Our Emacs code will write complete sexprs,
|
||||
;; therefore when `in` becomes ready `read` will return
|
||||
;; without blocking.
|
||||
(match (sync in receiver)
|
||||
[(? input-port? in) (match (read in)
|
||||
[(? eof-object?) (void)]
|
||||
[v (wait (make-receiver v))])]
|
||||
[(vector level message _v topic)
|
||||
(parameterize ([current-output-port out])
|
||||
(display-log level topic message)
|
||||
(flush-output))
|
||||
(wait receiver)])))
|
||||
(close-input-port in)
|
||||
(close-output-port out)
|
||||
(accept)))
|
||||
|
||||
(define (display-log level topic message)
|
||||
(display (label level))
|
||||
(display " ")
|
||||
(display (ensure-topic-in-message topic message))
|
||||
(newline))
|
||||
|
||||
(define (ensure-topic-in-message topic message)
|
||||
(match message
|
||||
[(pregexp (format "^~a: " (regexp-quote (~a topic))))
|
||||
message]
|
||||
[message-without-topic
|
||||
(format "~a: ~a" (or topic "*") message-without-topic)]))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
(check-equal? (ensure-topic-in-message 'topic "topic: message")
|
||||
"topic: message")
|
||||
(check-equal? (ensure-topic-in-message 'topic "message")
|
||||
"topic: message")
|
||||
(check-equal? (ensure-topic-in-message #f "message")
|
||||
"*: message"))
|
||||
|
||||
(define (label level)
|
||||
;; justify
|
||||
(case level
|
||||
[(debug) "[ debug]"]
|
||||
[(info) "[ info]"]
|
||||
[(warning) "[warning]"]
|
||||
[(error) "[ error]"]
|
||||
[(fatal) "[ fatal]"]
|
||||
[else @~a{[level]}]))
|
||||
|
||||
(define (make-receiver alist)
|
||||
(apply make-log-receiver (list* global-logger
|
||||
(alist->spec alist))))
|
||||
|
||||
;; Convert from ([logger . level] ...) alist to the format used by
|
||||
;; make-log-receiver: (level logger ... ... default-level). In the
|
||||
;; alist, treat the logger '* as the default level.
|
||||
(define (alist->spec xs) ;(Listof (Pairof Symbol Symbol)) -> (Listof Symbol)
|
||||
(for/fold ([spec '()])
|
||||
([x (in-list xs)])
|
||||
(append spec
|
||||
(match x
|
||||
[(cons '* level) (list level)]
|
||||
[(cons logger level) (list level logger)]))))
|
||||
8
elpa/racket-mode-20181004.309/racket/md5.rkt
Normal file
8
elpa/racket-mode-20181004.309/racket/md5.rkt
Normal file
@@ -0,0 +1,8 @@
|
||||
#lang racket/base
|
||||
|
||||
(require file/md5)
|
||||
|
||||
(provide file->md5)
|
||||
|
||||
(define (file->md5 file)
|
||||
(call-with-input-file* file (compose bytes->string/utf-8 md5)))
|
||||
151
elpa/racket-mode-20181004.309/racket/mod.rkt
Normal file
151
elpa/racket-mode-20181004.309/racket/mod.rkt
Normal 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-20181004.309/racket/namespace.rkt
Normal file
269
elpa/racket-mode-20181004.309/racket/namespace.rkt
Normal 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)))
|
||||
273
elpa/racket-mode-20181004.309/racket/run.rkt
Normal file
273
elpa/racket-mode-20181004.309/racket/run.rkt
Normal file
@@ -0,0 +1,273 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/cmdline
|
||||
racket/contract/base
|
||||
racket/contract/region
|
||||
racket/format
|
||||
racket/match
|
||||
racket/pretty
|
||||
racket/runtime-path
|
||||
racket/set
|
||||
racket/string
|
||||
"channel.rkt"
|
||||
"command-server.rkt"
|
||||
(only-in "debug.rkt" make-debug-eval-handler)
|
||||
"elisp.rkt"
|
||||
"error.rkt"
|
||||
"gui.rkt"
|
||||
"instrument.rkt"
|
||||
"interactions.rkt"
|
||||
"logger.rkt"
|
||||
"mod.rkt"
|
||||
"namespace.rkt"
|
||||
(prefix-in stx-cache: "syntax.rkt")
|
||||
"util.rkt")
|
||||
|
||||
;; Main moving parts:
|
||||
;;
|
||||
;; 1. This main thread, which receives a couple messages on a channel
|
||||
;; (see channel.rkt). One message is a `rerun` struct with info
|
||||
;; about a new file/module to run. The main thread loops forever
|
||||
;; (the `rerun` function tail calls itself forever). The special
|
||||
;; case of racket/gui/base is handled with a custom module names
|
||||
;; resolver and another message.
|
||||
;;
|
||||
;; 2. A thread created for each run; loads a module and goes into
|
||||
;; a read-eval-print-loop.
|
||||
;;
|
||||
;; 3. A thread for a command server that listens on a TCP port (see
|
||||
;; command-server.rkt). One of the commands is a `run` command.
|
||||
|
||||
(module+ main
|
||||
(define-values (command-port launch-token run-info)
|
||||
(match (current-command-line-arguments)
|
||||
[(vector port)
|
||||
(values (string->number port)
|
||||
#f
|
||||
rerun-default)]
|
||||
[(vector port launch-token run-command)
|
||||
(values (string->number port)
|
||||
(elisp-read (open-input-string launch-token))
|
||||
(match (elisp-read (open-input-string run-command))
|
||||
[(list 'run what mem pp ctx args dbgs)
|
||||
(rerun (->mod/existing what)
|
||||
mem
|
||||
(as-racket-bool pp)
|
||||
ctx
|
||||
(list->vector args)
|
||||
(list->set (map string->path dbgs))
|
||||
void)]
|
||||
[v (eprintf "Bad arguments: ~v => ~v\n" run-command v)
|
||||
(exit)]))]
|
||||
[v
|
||||
(eprintf "Bad arguments: ~v\n" v)
|
||||
(exit)]))
|
||||
(start-command-server command-port launch-token)
|
||||
(start-logger-server (add1 command-port) launch-token)
|
||||
;; Emacs on Windows comint-mode needs buffering disabled.
|
||||
(when (eq? (system-type 'os) 'windows)
|
||||
(file-stream-buffer-mode (current-output-port) 'none))
|
||||
(display (banner))
|
||||
(flush-output)
|
||||
(parameterize ([error-display-handler our-error-display-handler])
|
||||
(run run-info)))
|
||||
|
||||
(define (run rr) ;rerun? -> void?
|
||||
(match-define (rerun maybe-mod
|
||||
mem-limit
|
||||
pretty-print?
|
||||
context-level
|
||||
cmd-line-args
|
||||
debug-files
|
||||
ready-thunk) rr)
|
||||
(define-values (dir file mod-path) (maybe-mod->dir/file/rmp maybe-mod))
|
||||
;; Always set current-directory and current-load-relative-directory
|
||||
;; to match the source file.
|
||||
(current-directory dir)
|
||||
(current-load-relative-directory dir)
|
||||
;; Make src-loc->string provide full pathnames
|
||||
(show-full-path-in-errors)
|
||||
;; Custodian for the REPL.
|
||||
(define repl-cust (make-custodian))
|
||||
(when (< 0 mem-limit)
|
||||
(custodian-limit-memory repl-cust
|
||||
(inexact->exact (round (* 1024 1024 mem-limit)))
|
||||
repl-cust))
|
||||
;; If racket/gui/base isn't loaded, the current-eventspace parameter
|
||||
;; doesn't exist, so make a "dummy" parameter of that name.
|
||||
(define current-eventspace (txt/gui (make-parameter #f) current-eventspace))
|
||||
|
||||
;; Create REPL thread
|
||||
(define repl-thread
|
||||
(parameterize* ;; Use `parameterize*` because the order matters.
|
||||
(;; FIRST: current-custodian and current-namespace, so in
|
||||
;; effect for later parameterizations.
|
||||
[current-custodian repl-cust]
|
||||
[current-namespace (if mod-path
|
||||
((txt/gui make-base-empty-namespace
|
||||
make-gui-empty-namespace))
|
||||
((txt/gui make-base-namespace
|
||||
make-gui-namespace)))]
|
||||
;; OTHERS:
|
||||
[compile-enforce-module-constants #f]
|
||||
[compile-context-preservation-enabled (not (eq? context-level 'low))]
|
||||
[current-eval
|
||||
(cond [(debug-level? context-level) (make-debug-eval-handler debug-files)]
|
||||
[(instrument-level? context-level)(make-instrumented-eval-handler)]
|
||||
[else (current-eval)])]
|
||||
[instrumenting-enabled (instrument-level? context-level)]
|
||||
[profiling-enabled (eq? context-level 'profile)]
|
||||
[test-coverage-enabled (eq? context-level 'coverage)]
|
||||
[current-sync/yield (txt/gui sync yield)]
|
||||
;; LAST: `current-eventspace` because `make-eventspace`
|
||||
;; creates an event handler thread -- now. We want that
|
||||
;; thread to inherit the parameterizations above. (Otherwise
|
||||
;; in the non-gui case, we call `thread` below in the body of
|
||||
;; the parameterize* form, so that's fine.)
|
||||
[current-eventspace ((txt/gui void make-eventspace))])
|
||||
;; repl-thunk will be called from another thread -- either a plain
|
||||
;; thread when racket/gui/base is not (yet) instantiated, or, from
|
||||
;; (eventspace-handler-thread (current-eventspace)).
|
||||
(define (repl-thunk)
|
||||
;; 0. Command line arguments
|
||||
(current-command-line-arguments cmd-line-args)
|
||||
;; 1. Set current-print and pretty-print hooks.
|
||||
(current-print (make-print-handler pretty-print?))
|
||||
(pretty-print-print-hook (make-pretty-print-print-hook))
|
||||
(pretty-print-size-hook (make-pretty-print-size-hook))
|
||||
(print-syntax-width +inf.0)
|
||||
;; 2. If module, require and enter its namespace, etc.
|
||||
(stx-cache:before-run maybe-mod)
|
||||
(when (and maybe-mod mod-path)
|
||||
(parameterize ([current-module-name-resolver module-name-resolver-for-run]
|
||||
[current-eval (stx-cache:make-eval-handler maybe-mod)])
|
||||
;; When exn:fail? during module load, re-run with "empty"
|
||||
;; module. Note: Unlikely now that we're using
|
||||
;; dynamic-require/some-namespace.
|
||||
(define (load-exn-handler exn)
|
||||
(display-exn exn)
|
||||
(channel-put message-to-main-thread-channel
|
||||
(struct-copy rerun rr [maybe-mod #f]))
|
||||
(sync never-evt))
|
||||
(with-handlers ([exn? load-exn-handler])
|
||||
(maybe-configure-runtime mod-path) ;FIRST: see #281
|
||||
(current-namespace (dynamic-require/some-namespace maybe-mod))
|
||||
(maybe-warn-about-submodules mod-path context-level)
|
||||
(check-top-interaction))))
|
||||
(stx-cache:after-run maybe-mod)
|
||||
;; 3. Tell command server to use our namespace and module.
|
||||
(attach-command-server (current-namespace) maybe-mod)
|
||||
;; 3b. And call the ready-thunk command-server gave us from a
|
||||
;; run command, so that it can send a response for the run
|
||||
;; command. Because the command server runs on a different
|
||||
;; thread, it is probably waiting with (sync some-channel) and
|
||||
;; the thunk will simply channel-put.
|
||||
(ready-thunk)
|
||||
;; 4. read-eval-print-loop
|
||||
(parameterize ([current-prompt-read (make-prompt-read maybe-mod)]
|
||||
[current-module-name-resolver module-name-resolver-for-repl])
|
||||
;; Note that read-eval-print-loop catches all non-break
|
||||
;; exceptions.
|
||||
(read-eval-print-loop)))
|
||||
|
||||
;; Main thread: Run repl-thunk on a plain thread, or, on the
|
||||
;; eventspace thread via queue-callback. Return the thread.
|
||||
(define t/v ((txt/gui thread queue-callback ) repl-thunk))
|
||||
(define thd ((txt/gui (λ _ t/v) eventspace-handler-thread) (current-eventspace)))
|
||||
thd))
|
||||
|
||||
;; Main thread: Wait for message from REPL thread on channel. Also
|
||||
;; catch breaks, in which case we (a) break the REPL thread so
|
||||
;; display-exn runs there, and (b) continue from the break instead
|
||||
;; of re-running so that the REPL environment is maintained.
|
||||
(define message
|
||||
(call-with-exception-handler
|
||||
(match-lambda
|
||||
[(and (or (? exn:break:terminate?) (? exn:break:hang-up?)) e) e]
|
||||
[(exn:break msg marks continue) (break-thread repl-thread) (continue)]
|
||||
[e e])
|
||||
(λ () (sync message-to-main-thread-channel))))
|
||||
(match context-level
|
||||
['profile (clear-profile-info!)]
|
||||
['coverage (clear-test-coverage-info!)]
|
||||
[_ (void)])
|
||||
(custodian-shutdown-all repl-cust)
|
||||
(newline) ;; FIXME: Move this to racket-mode.el instead?
|
||||
(match message
|
||||
[(? rerun? new-rr) (run new-rr)]
|
||||
[(load-gui repl?) (require-gui repl?) (run rr)]))
|
||||
|
||||
(define (maybe-configure-runtime mod-path)
|
||||
;; Do configure-runtime when available.
|
||||
;; Important for langs like Typed Racket.
|
||||
(with-handlers ([exn:fail? void])
|
||||
(match (module->language-info mod-path #t)
|
||||
[(vector mp name val)
|
||||
(define get-info ((dynamic-require mp name) val))
|
||||
(define configs (get-info 'configure-runtime '()))
|
||||
(for ([config (in-list configs)])
|
||||
(match-let ([(vector mp name val) config])
|
||||
((dynamic-require mp name) val)))]
|
||||
[_ (void)])
|
||||
(define cr-submod `(submod
|
||||
,@(match mod-path
|
||||
[(list 'submod sub-paths ...) sub-paths]
|
||||
[_ (list mod-path)])
|
||||
configure-runtime))
|
||||
(when (module-declared? cr-submod)
|
||||
(dynamic-require cr-submod #f))))
|
||||
|
||||
(define (check-top-interaction)
|
||||
;; Check that the lang defines #%top-interaction
|
||||
(unless (memq '#%top-interaction (namespace-mapped-symbols))
|
||||
(display-commented
|
||||
"Because the language used by this module provides no #%top-interaction\n you will be unable to evaluate expressions here in the REPL.")))
|
||||
|
||||
;; Catch attempt to load racket/gui/base for the first time.
|
||||
(define (make-module-name-resolver repl?)
|
||||
(let ([orig-resolver (current-module-name-resolver)])
|
||||
(define (resolve mp rmp stx load?)
|
||||
(when (and load? (memq mp '(racket/gui/base
|
||||
racket/gui/dynamic
|
||||
scheme/gui/base)))
|
||||
(unless (gui-required?)
|
||||
(channel-put message-to-main-thread-channel
|
||||
(load-gui repl?))
|
||||
(sync never-evt)))
|
||||
(orig-resolver mp rmp stx load?))
|
||||
(case-lambda
|
||||
[(rmp ns) (orig-resolver rmp ns)]
|
||||
[(mp rmp stx) (resolve mp rmp stx #t)]
|
||||
[(mp rmp stx load?) (resolve mp rmp stx load?)])))
|
||||
(define module-name-resolver-for-run (make-module-name-resolver #f))
|
||||
(define module-name-resolver-for-repl (make-module-name-resolver #t))
|
||||
|
||||
(define (make-print-handler pretty-print?)
|
||||
(cond [pretty-print? pretty-print-handler]
|
||||
[else (make-plain-print-handler)]))
|
||||
|
||||
;; Note: The `dynamic-require`s seem to be necessary otherwise
|
||||
;; file/convertible's convertible? always returns #f. Which seeems to
|
||||
;; be a namespace issue that I don't understand.
|
||||
(define-runtime-path image.rkt "image.rkt")
|
||||
|
||||
(define (make-plain-print-handler)
|
||||
(let ([convert (dynamic-require image.rkt 'convert-image)])
|
||||
(λ (v)
|
||||
(void (unless (void? v)
|
||||
(print (convert v))
|
||||
(newline))))))
|
||||
|
||||
(define (make-pretty-print-size-hook [orig (pretty-print-size-hook)])
|
||||
(let ([convert? (dynamic-require image.rkt 'convert-image?)]
|
||||
[width (floor (/ (pretty-print-columns) 4))]) ;magic number? yep.
|
||||
(λ (value display? port)
|
||||
(cond [(convert? value) width]
|
||||
[else (orig value display? port)]))))
|
||||
|
||||
(define (make-pretty-print-print-hook [orig (pretty-print-print-hook)])
|
||||
(let ([convert? (dynamic-require image.rkt 'convert-image?)]
|
||||
[convert (dynamic-require image.rkt 'convert-image)])
|
||||
(λ (value display? port)
|
||||
(cond [(convert? value) (print (convert value) port)]
|
||||
[else (orig value display? port)]))))
|
||||
176
elpa/racket-mode-20181004.309/racket/scribble.rkt
Normal file
176
elpa/racket-mode-20181004.309/racket/scribble.rkt
Normal 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 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)]))
|
||||
100
elpa/racket-mode-20181004.309/racket/syntax.rkt
Normal file
100
elpa/racket-mode-20181004.309/racket/syntax.rkt
Normal file
@@ -0,0 +1,100 @@
|
||||
#lang racket/base
|
||||
|
||||
(require (only-in compiler/cm [get-file-sha1 file->digest])
|
||||
racket/contract
|
||||
racket/match
|
||||
racket/promise
|
||||
syntax/modread
|
||||
"mod.rkt")
|
||||
|
||||
(provide file->syntax
|
||||
file->expanded-syntax
|
||||
before-run
|
||||
make-eval-handler
|
||||
after-run)
|
||||
|
||||
;; Return a syntax object or #f for the contents of `file`. The
|
||||
;; resulting syntax is applied to `k` while the parameters
|
||||
;; current-load-relative-directory and current-namespace are still set
|
||||
;; appropriately.
|
||||
(define/contract (file->syntax file [k values])
|
||||
(->* (path-string?)
|
||||
((-> syntax? syntax?))
|
||||
(or/c #f syntax?))
|
||||
(define-values (base _ __) (split-path file))
|
||||
(parameterize ([current-load-relative-directory base]
|
||||
[current-namespace (make-base-namespace)])
|
||||
(with-handlers ([exn:fail? (λ _ #f)])
|
||||
(k
|
||||
(with-module-reading-parameterization
|
||||
(λ ()
|
||||
(with-input-from-file file read-syntax/count-lines)))))))
|
||||
|
||||
(define (read-syntax/count-lines)
|
||||
(port-count-lines! (current-input-port))
|
||||
(read-syntax))
|
||||
|
||||
;;; expanded syntax caching
|
||||
|
||||
;; cache : (hash/c file (cons/c digest-string? (or/c promise? syntax?)))
|
||||
(define cache (make-hash))
|
||||
(define last-mod #f)
|
||||
|
||||
;; Call this early in a file run, _before_ any evaluation. If it's not
|
||||
;; the same file as before, we empty the cache -- to free up memory.
|
||||
;; If it's the same file, we keep the cache.
|
||||
(define (before-run maybe-mod)
|
||||
(unless (equal? last-mod maybe-mod)
|
||||
(hash-clear! cache)
|
||||
(set! last-mod maybe-mod)))
|
||||
|
||||
(define ((make-eval-handler maybe-mod [orig-eval (current-eval)]) e)
|
||||
(cond [(and (syntax? e)
|
||||
(syntax-source e)
|
||||
(path-string? (syntax-source e))
|
||||
(not (compiled-expression? (syntax-e e))))
|
||||
(define expanded-stx (expand e))
|
||||
(cache-set! (syntax-source e) (λ () expanded-stx))
|
||||
(orig-eval expanded-stx)]
|
||||
[else (orig-eval e)]))
|
||||
|
||||
(define (after-run maybe-mod)
|
||||
;; When the rkt file being run has a compiled zo that was used, then
|
||||
;; our eval-hander above won't expand and cache any syntax. That
|
||||
;; means when the user does a command that needs expanded syntax
|
||||
;; (e.g. find-completion), they will need to wait for expansion. But
|
||||
;; if you call this _after_ the file was run, it will cache-set! the
|
||||
;; expansion using `delay/thread` -- i.e. the work will happen "in
|
||||
;; the background". (Furthermore, when we already have a cache entry
|
||||
;; for the file and digest, from a previous run, we'll just use
|
||||
;; that.) As a result, it's likely to be mostly or entirely ready
|
||||
;; when the user does a command.
|
||||
(define-values (dir base _) (maybe-mod->dir/file/rmp maybe-mod))
|
||||
(when (and dir base)
|
||||
(define path (build-path dir base))
|
||||
(cache-set! path (λ () (delay/thread (file->syntax path expand))))))
|
||||
|
||||
;; cache-set! takes a thunk so that, if the cache already has an entry
|
||||
;; for the file and digest, it can avoid doing any work. Furthermore,
|
||||
;; if you already have a digest for file, supply it to avoid redoing
|
||||
;; that work, too.
|
||||
(define/contract (cache-set! file thk [digest #f])
|
||||
(->* (path-string? (-> (or/c promise? syntax?)))
|
||||
((or/c #f string?))
|
||||
any)
|
||||
(let ([digest (or digest (file->digest file))])
|
||||
(match (hash-ref cache file #f)
|
||||
[(cons (== digest) _)
|
||||
(void)]
|
||||
[_
|
||||
(hash-set! cache file (cons digest (thk)))])))
|
||||
|
||||
(define (file->expanded-syntax file)
|
||||
(define digest (file->digest file))
|
||||
(match (hash-ref cache file #f)
|
||||
[(cons (== digest) promise)
|
||||
(force promise)]
|
||||
[_
|
||||
(define stx (file->syntax file expand))
|
||||
(cache-set! file (λ () stx) digest)
|
||||
stx]))
|
||||
55
elpa/racket-mode-20181004.309/racket/test/find-examples.rkt
Normal file
55
elpa/racket-mode-20181004.309/racket/test/find-examples.rkt
Normal file
@@ -0,0 +1,55 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/contract)
|
||||
|
||||
;; Examples for test/defn.rkt.
|
||||
|
||||
(define (plain x) x)
|
||||
(provide plain)
|
||||
(provide (rename-out [plain renamed]))
|
||||
|
||||
(define (contracted1 x) x)
|
||||
(provide (contract-out [contracted1 (-> any/c any)]))
|
||||
(define (contracted2 x) x)
|
||||
(provide/contract [contracted2 (-> any/c any)])
|
||||
|
||||
(define (c/r x) x)
|
||||
(provide (contract-out [rename c/r contracted/renamed (-> any/c any)]))
|
||||
|
||||
(define-syntax-rule (plain-definer name)
|
||||
(begin
|
||||
(define (name x) x)
|
||||
(provide name)))
|
||||
(plain-definer plain-by-macro)
|
||||
|
||||
(define-syntax-rule (contracted-definer name)
|
||||
(begin
|
||||
(define (name x) x)
|
||||
(provide (contract-out [name (-> any/c any)]))))
|
||||
(contracted-definer contracted-by-macro)
|
||||
|
||||
;; This is here to try to trip naive matching, by having a definition
|
||||
;; of `sub` that is not actually provided, unlike the one in the `sub`
|
||||
;; module just below.
|
||||
(module red-herring racket/base
|
||||
(define (sub) #f))
|
||||
|
||||
(module sub racket/base
|
||||
(define (sub x) x)
|
||||
(provide sub
|
||||
(rename-out [sub sub/renamed])))
|
||||
(require 'sub)
|
||||
(provide sub sub/renamed)
|
||||
|
||||
;; Likewise, another case of naive matching:
|
||||
(module red-herring-2 racket/base
|
||||
(define (foo) #f))
|
||||
|
||||
(define (foo x) x)
|
||||
(provide foo)
|
||||
|
||||
;; Issue 317
|
||||
(define a-number 42)
|
||||
(provide a-number)
|
||||
(define a-parameter (make-parameter #f))
|
||||
(provide a-parameter)
|
||||
121
elpa/racket-mode-20181004.309/racket/test/find.rkt
Normal file
121
elpa/racket-mode-20181004.309/racket/test/find.rkt
Normal file
@@ -0,0 +1,121 @@
|
||||
#lang at-exp racket/base
|
||||
|
||||
(require racket/format
|
||||
racket/match
|
||||
racket/runtime-path
|
||||
rackunit
|
||||
syntax/modread
|
||||
"../find.rkt"
|
||||
"find-examples.rkt")
|
||||
|
||||
(define-runtime-path dot-dot "..")
|
||||
|
||||
(define-namespace-anchor nsa)
|
||||
(parameterize ([current-namespace (namespace-anchor->namespace nsa)])
|
||||
(define (not-0 v) (not (= 0 v)))
|
||||
(define (not-1 v) (not (= 1 v)))
|
||||
|
||||
(check-equal? (find-definition "display")
|
||||
'kernel)
|
||||
(check-equal? (find-signature "display")
|
||||
'("defined in #%kernel, signature unavailable"))
|
||||
|
||||
(check-match (find-definition "displayln")
|
||||
(list (pregexp "/racket/private/misc\\.rkt$")
|
||||
(? not-1)
|
||||
(? not-0)))
|
||||
(check-equal? (find-signature "displayln")
|
||||
'((displayln v) (displayln v p))) ;case-lambda defn
|
||||
|
||||
;; Test a definer macro that (as of Racket 6.7) does not properly
|
||||
;; set srcloc: Can we at least return a specfic location for its
|
||||
;; parent syntax (as opposed to line 1 column 0)?
|
||||
(check-match (find-definition "in-hash")
|
||||
(list (pregexp "/racket/private/for.rkt$")
|
||||
(? not-1)
|
||||
(? not-0)))
|
||||
|
||||
;; Tests for specific locations in find-examples.rkt
|
||||
|
||||
(check-match (find-definition "plain")
|
||||
(list (pregexp "find-examples.rkt$") 7 9))
|
||||
(check-equal? (find-signature "plain")
|
||||
'(plain x))
|
||||
|
||||
(check-match (find-definition "renamed")
|
||||
(list (pregexp "find-examples.rkt$") 7 9))
|
||||
(check-equal? (find-signature "renamed")
|
||||
'(plain x))
|
||||
|
||||
(check-match (find-definition "contracted1")
|
||||
(list (pregexp "find-examples.rkt$") 11 9))
|
||||
(check-equal? (find-signature "contracted1")
|
||||
'(contracted1 x))
|
||||
|
||||
(check-match (find-definition "contracted2")
|
||||
(list (pregexp "find-examples.rkt$") 13 9))
|
||||
(check-equal? (find-signature "contracted2")
|
||||
'(contracted2 x))
|
||||
|
||||
(check-match (find-definition "contracted/renamed")
|
||||
(list (pregexp "find-examples.rkt$") 16 9))
|
||||
(check-equal? (find-signature "contracted/renamed")
|
||||
'(c/r x))
|
||||
|
||||
(check-match (find-definition "plain-by-macro")
|
||||
(list (pregexp "find-examples.rkt$") 23 15))
|
||||
(check-false (find-signature "plain-by-macro"))
|
||||
|
||||
(check-match (find-definition "contracted-by-macro")
|
||||
(list (pregexp "find-examples.rkt$") 29 20))
|
||||
(check-false (find-signature "contracted-by-macro"))
|
||||
|
||||
(check-match (find-definition "sub")
|
||||
(list (pregexp "find-examples.rkt$") 38 11))
|
||||
(check-equal? (find-signature "sub")
|
||||
'(sub x))
|
||||
|
||||
(check-match (find-definition "sub/renamed")
|
||||
(list (pregexp "find-examples.rkt$") 38 11))
|
||||
(check-equal? (find-signature "sub/renamed")
|
||||
'(sub x))
|
||||
|
||||
(check-match (find-definition "foo")
|
||||
(list (pregexp "find-examples.rkt$") 48 9))
|
||||
(check-equal? (find-signature "foo")
|
||||
'(foo x))
|
||||
|
||||
(check-match (find-definition "a-number")
|
||||
(list (pregexp "find-examples.rkt$") 52 8))
|
||||
|
||||
(check-match (find-definition "a-parameter")
|
||||
(list (pregexp "find-examples.rkt$") 54 8))
|
||||
|
||||
;; This is (roughly) a test of opening a Racket source file and
|
||||
;; doing M-. on every non-list sexpr: Call find-definition on each
|
||||
;; sexpr. Not-found (#f) is fine. But fail test for (list _ 1 0) --
|
||||
;; i.e. the source file was found, but not the location within.
|
||||
(define (check-non-bof-location file)
|
||||
(define ht (make-hash))
|
||||
(define (find k) ;memoized find-definition
|
||||
(hash-ref ht k
|
||||
(λ ()
|
||||
(define v (find-definition (format "~a" k)))
|
||||
(hash-set! ht k v)
|
||||
v)))
|
||||
(define (walk v)
|
||||
(if (list? v)
|
||||
(for-each walk v)
|
||||
(match (find v)
|
||||
[(list where 1 0)
|
||||
(fail @~a{can't find definition of `@|v|` in @where})]
|
||||
[_ (void)])))
|
||||
(walk
|
||||
(with-module-reading-parameterization
|
||||
;; Why read not read-syntax? Because we only care about the
|
||||
;; sexprs as text: `find-definition` takes a string, because
|
||||
;; `racket-visit-definition` takes text from an Emacs buffer.
|
||||
(λ () (with-input-from-file file read)))))
|
||||
(for ([file '("commands/requires.rkt"
|
||||
"run.rkt")])
|
||||
(check-non-bof-location (build-path dot-dot file))))
|
||||
39
elpa/racket-mode-20181004.309/racket/util.rkt
Normal file
39
elpa/racket-mode-20181004.309/racket/util.rkt
Normal file
@@ -0,0 +1,39 @@
|
||||
#lang racket/base
|
||||
|
||||
(require (for-syntax racket/base
|
||||
syntax/parse))
|
||||
|
||||
(provide display-commented
|
||||
with-dynamic-requires
|
||||
string->namespace-syntax
|
||||
syntax-or-sexpr->syntax
|
||||
syntax-or-sexpr->sexpr
|
||||
nat/c
|
||||
pos/c)
|
||||
|
||||
(define (display-commented str)
|
||||
(eprintf "; ~a\n"
|
||||
(regexp-replace* "\n" str "\n; ")))
|
||||
|
||||
(define-syntax (with-dynamic-requires stx)
|
||||
(syntax-parse stx
|
||||
[(_ ([lib:id id:id] ...+) body:expr ...+)
|
||||
#'(let ([id (dynamic-require 'lib 'id)] ...)
|
||||
body ...)]))
|
||||
|
||||
(define (string->namespace-syntax str)
|
||||
(namespace-syntax-introduce
|
||||
(read-syntax #f (open-input-string str))))
|
||||
|
||||
(define (syntax-or-sexpr->syntax v)
|
||||
(if (syntax? v)
|
||||
v
|
||||
(namespace-syntax-introduce (datum->syntax #f v))))
|
||||
|
||||
(define (syntax-or-sexpr->sexpr v)
|
||||
(if (syntax? v)
|
||||
(syntax-e v)
|
||||
v))
|
||||
|
||||
(define nat/c exact-nonnegative-integer?)
|
||||
(define pos/c exact-positive-integer?)
|
||||
Reference in New Issue
Block a user