1 ;; geiser-racket.el -- geiser support for Racket scheme
3 ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the Modified BSD License. You should
7 ;; have received a copy of the license along with this program. If
8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
10 ;; Start date: Sat Apr 25, 2009 21:13
14 (require 'geiser-edit
)
16 (require 'geiser-eval
)
17 (require 'geiser-syntax
)
18 (require 'geiser-custom
)
19 (require 'geiser-base
)
24 (defgroup geiser-racket nil
25 "Customization for Geiser's Racket flavour."
28 (geiser-custom--defcustom geiser-racket-binary
29 (cond ((eq system-type
'windows-nt
) "Racket.exe")
31 "Name to use to call the racket executable when starting a REPL."
32 :type
'(choice string
(repeat string
))
33 :group
'geiser-racket
)
35 (geiser-custom--defcustom geiser-racket-gracket-binary
36 (cond ((eq system-type
'windows-nt
) "GRacket-text.exe")
38 "Name to use to call the gracket executable when starting a REPL.
39 This executable is used by `run-gracket', and, if
40 `geiser-racket-use-gracket-p' is set to t, by `run-racket'."
41 :type
'(choice string
(repeat string
))
42 :group
'geiser-racket
)
44 (geiser-custom--defcustom geiser-racket-collects nil
45 "A list of paths to be added to racket's collection directories."
47 :group
'geiser-racket
)
49 (geiser-custom--defcustom geiser-racket-init-file
"~/.racket-geiser"
50 "Initialization file with user code for the racket REPL."
52 :group
'geiser-racket
)
54 (geiser-custom--defcustom geiser-racket-use-gracket-p nil
55 "Whether to use the gracket binary to start Racket REPLs."
57 :group
'geiser-racket
)
63 (defsubst geiser-racket--real-binary
()
64 (if geiser-racket-use-gracket-p
65 geiser-racket-gracket-binary
66 geiser-racket-binary
))
68 (defun geiser-racket--binary ()
69 (let ((binary (geiser-racket--real-binary)))
70 (if (listp binary
) (car binary
) binary
)))
72 (defun geiser-racket--parameters ()
73 "Return a list with all parameters needed to start racket.
74 This function uses `geiser-racket-init-file' if it exists."
75 (let ((init-file (and (stringp geiser-racket-init-file
)
76 (expand-file-name geiser-racket-init-file
)))
77 (binary (geiser-racket--real-binary)))
79 "-S" ,(expand-file-name "racket/" geiser-scheme-dir
)
80 ,@(apply 'append
(mapcar (lambda (p) (list "-S" p
)) geiser-racket-collects
))
81 ,@(and (listp binary
) (cdr binary
))
82 ,@(and init-file
(file-readable-p init-file
) (list "-f" init-file
))
83 "-f" ,(expand-file-name "racket/geiser.rkt" geiser-scheme-dir
))))
85 (defconst geiser-racket--prompt-regexp
"^=?\\(mzscheme\\|racket\\)@[^ ]*?> ")
88 ;;; Evaluation support:
90 (defun geiser-racket--language ()
92 (goto-char (point-min))
93 (if (re-search-forward
94 "^\\(?:#lang\\|(module +[^ ]+?\\) +\\([^ ]+?\\|([^)]+)\\) *$" nil t
)
95 (car (geiser-syntax--read-from-string (match-string-no-properties 1)))
98 (defun geiser-racket--geiser-procedure (proc &rest args
)
101 (format ",geiser-eval %s %s %s"
103 (geiser-racket--language)
104 (mapconcat 'identity
(cdr args
) " ")))
105 ((load-file compile-file
)
106 (format ",geiser-eval geiser/main racket (geiser:%s %s)"
108 ((no-values) ",geiser-no-values")
109 (t (format ",apply geiser:%s (%s)" proc
(mapconcat 'identity args
" ")))))
111 (defconst geiser-racket--module-re
112 "^(module +\\([^ ]+\\)")
114 (defun geiser-racket--explicit-module ()
116 (goto-char (point-min))
117 (and (re-search-forward geiser-racket--module-re nil t
)
119 (car (geiser-syntax--read-from-string
120 (match-string-no-properties 1)))))))
122 (defsubst geiser-racket--implicit-module
()
124 (goto-char (point-min))
125 (if (re-search-forward "^#lang " nil t
)
129 (defun geiser-racket--get-module (&optional module
)
130 (cond ((and (null module
) (buffer-file-name)))
131 ;; (geiser-racket--explicit-module)
132 ((null module
) (geiser-racket--implicit-module))
133 ((symbolp module
) module
)
134 ((and (stringp module
) (file-name-absolute-p module
)) module
)
135 ((stringp module
) (intern module
))
138 (defun geiser-racket--symbol-begin (module)
139 (save-excursion (skip-syntax-backward "^-()>") (point)))
141 (defun geiser-racket--enter-command (module)
142 (when (stringp module
)
143 (cond ((zerop (length module
)) ",enter #f")
144 ((file-name-absolute-p module
) (format ",enter (file %S)" module
))
145 (t (format ",enter %s" module
)))))
147 (defun geiser-racket--import-command (module)
148 (and (stringp module
)
149 (not (zerop (length module
)))
150 (format "(require %s)" module
)))
152 (defun geiser-racket--exit-command ()
154 (get-buffer-process (current-buffer)))
156 (defconst geiser-racket--binding-forms
157 '(for for
/list for
/hash for
/hasheq for
/and for
/or
158 for
/lists for
/first for
/last for
/fold
159 for
: for
/list
: for
/hash
: for
/hasheq
: for
/and
: for
/or
:
160 for
/lists
: for
/first
: for
/last
: for
/fold
:))
162 (defconst geiser-racket--binding-forms
*
163 '(for* for
*/list for
*/lists for
*/hash for
*/hasheq for
*/and
164 for
*/or for
*/first for
*/last for
*/fold
165 for
*: for
*/list
: for
*/lists
: for
*/hash
: for
*/hasheq
: for
*/and
:
166 for
*/or
: for
*/first
: for
*/last
: for
*/fold
:))
170 (defsubst geiser-racket--get-help
(symbol module
)
171 (geiser-eval--send/wait
172 `(:eval
(get-help ',symbol
'(:module
,module
)) geiser
/autodoc
)))
174 (defun geiser-racket--external-help (id module
)
175 (message "Requesting help for '%s'..." id
)
176 (let ((out (geiser-eval--retort-output
177 (geiser-racket--get-help id module
))))
178 (when (and out
(string-match " but provided by:\n +\\(.+\\)\n" out
))
179 (geiser-racket--get-help id
(match-string 1 out
))))
180 (minibuffer-message "%s done" (current-message))
186 (defconst geiser-racket--file-rxs
188 "path:\"?\\([^>\"\n]+\\)\"?>"
189 "module: \"\\([^>\"\n]+\\)\""))
191 (defconst geiser-racket--geiser-file-rx
192 (format "^%s/?racket/geiser" (regexp-quote geiser-scheme-dir
)))
194 (defun geiser-racket--purge-trace ()
196 (while (re-search-forward geiser-racket--geiser-file-rx nil t
)
199 (defun geiser-racket--display-error (module key msg
)
202 (geiser-doc--insert-button key nil
'racket
)
210 (geiser-racket--purge-trace)
211 (mapc 'geiser-edit--buttonize-files geiser-racket--file-rxs
)
214 (or key
(not (zerop (length msg
)))))
217 ;;; Trying to ascertain whether a buffer is mzscheme scheme:
219 (defun geiser-racket--guess ()
221 (goto-char (point-min))
222 (re-search-forward "#lang " nil t
))
223 (geiser-racket--explicit-module)))
228 (defun connect-to-racket ()
229 "Start a Racket REPL connected to a remote process.
231 The remote process needs to be running a REPL server started
232 using start-geiser, a procedure in the geiser/server module."
234 (geiser-connect 'racket
))
238 ;;; Implementation definition:
240 (define-geiser-implementation racket
241 (unsupported-procedures '(callers callees generic-methods
))
242 (binary geiser-racket--binary
)
243 (arglist geiser-racket--parameters
)
246 (prompt-regexp geiser-racket--prompt-regexp
)
247 (marshall-procedure geiser-racket--geiser-procedure
)
248 (find-module geiser-racket--get-module
)
249 (enter-command geiser-racket--enter-command
)
250 (import-command geiser-racket--import-command
)
251 (exit-command geiser-racket--exit-command
)
252 (find-symbol-begin geiser-racket--symbol-begin
)
253 (display-error geiser-racket--display-error
)
254 (display-help geiser-racket--external-help
)
255 (check-buffer geiser-racket--guess
)
256 (binding-forms geiser-racket--binding-forms
)
257 (binding-forms* geiser-racket--binding-forms
*))
259 (geiser-impl--add-to-alist 'regexp
"\\.ss$" 'racket t
)
260 (geiser-impl--add-to-alist 'regexp
"\\.rkt$" 'racket t
)
262 (defun run-gracket ()
263 "Start the Racket REPL using gracket instead of plain racket."
265 (let ((geiser-racket-use-gracket-p t
))
269 (provide 'geiser-racket
)
270 ;;; geiser-racket.el ends here