1 ;; geiser-racket.el -- geiser support for Racket scheme
3 ;; Copyright (C) 2009, 2010, 2011, 2012, 2013 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-image
)
18 (require 'geiser-syntax
)
19 (require 'geiser-custom
)
20 (require 'geiser-base
)
26 (defgroup geiser-racket nil
27 "Customization for Geiser's Racket flavour."
30 (geiser-custom--defcustom geiser-racket-binary
31 (cond ((eq system-type
'windows-nt
) "Racket.exe")
33 "Name to use to call the racket executable when starting a REPL."
34 :type
'(choice string
(repeat string
))
35 :group
'geiser-racket
)
37 (geiser-custom--defcustom geiser-racket-gracket-binary
38 (cond ((eq system-type
'windows-nt
) "GRacket-text.exe")
40 "Name to use to call the gracket executable when starting a REPL.
41 This executable is used by `run-gracket', and, if
42 `geiser-racket-use-gracket-p' is set to t, by `run-racket'."
43 :type
'(choice string
(repeat string
))
44 :group
'geiser-racket
)
46 (geiser-custom--defcustom geiser-racket-collects nil
47 "A list of paths to be added to racket's collection directories."
49 :group
'geiser-racket
)
51 (geiser-custom--defcustom geiser-racket-init-file
"~/.racket-geiser"
52 "Initialization file with user code for the racket REPL."
54 :group
'geiser-racket
)
56 (geiser-custom--defcustom geiser-racket-use-gracket-p nil
57 "Whether to use the gracket binary to start Racket REPLs."
59 :group
'geiser-racket
)
61 (geiser-custom--defcustom geiser-racket-extra-keywords
62 '("define-syntax-rule" "provide" "require"
63 "unless" "when" "with-handlers")
64 "Extra keywords highlighted in Racket buffers."
65 :type
'(repeat string
)
66 :group
'geiser-racket
)
68 (geiser-custom--defcustom geiser-racket-case-sensitive-p t
69 "Non-nil means keyword highlighting is case-sensitive."
71 :group
'geiser-racket
)
76 (defsubst geiser-racket--real-binary
()
77 (if geiser-racket-use-gracket-p
78 geiser-racket-gracket-binary
79 geiser-racket-binary
))
81 (defun geiser-racket--binary ()
82 (let ((binary (geiser-racket--real-binary)))
83 (if (listp binary
) (car binary
) binary
)))
85 (defun geiser-racket--parameters ()
86 "Return a list with all parameters needed to start racket.
87 This function uses `geiser-racket-init-file' if it exists."
88 (let ((init-file (and (stringp geiser-racket-init-file
)
89 (expand-file-name geiser-racket-init-file
)))
90 (binary (geiser-racket--real-binary))
91 (rackdir (expand-file-name "racket/" geiser-scheme-dir
)))
92 `("-i" "-q" "-S" ,rackdir
93 ,@(apply 'append
(mapcar (lambda (p) (list "-S" p
))
94 geiser-racket-collects
))
95 ,@(and (listp binary
) (cdr binary
))
96 ,@(and init-file
(file-readable-p init-file
) (list "-f" init-file
))
97 "-f" ,(expand-file-name "geiser/startup.rkt" rackdir
))))
99 (defconst geiser-racket--prompt-regexp
"\\(mzscheme\\|racket\\)@[^ ]*> ")
101 (defun geiser-racket--startup (remote)
102 (if geiser-image-cache-dir
103 (geiser-eval--send/wait
104 `(:eval
(image-cache ,geiser-image-cache-dir
) geiser
/user
))
105 (setq geiser-image-cache-dir
106 (geiser-eval--send/result
'(:eval
(image-cache) geiser
/user
)))))
111 (defun connect-to-racket ()
112 "Start a Racket REPL connected to a remote process.
114 The remote process needs to be running a REPL server started
115 using start-geiser, a procedure in the geiser/server module."
117 (geiser-connect 'racket
))
121 ;;; Evaluation support:
123 (defun geiser-racket--language ()
125 (goto-char (point-min))
126 (if (re-search-forward
127 "^\\(?:#lang\\|(module +[^ ]+?\\) +\\([^ ]+?\\|([^)]+)\\) *$" nil t
)
128 (car (geiser-syntax--read-from-string (match-string-no-properties 1)))
131 (defun geiser-racket--enter-command (module)
132 (when (stringp module
)
133 (cond ((zerop (length module
)) ",enter #f")
134 ((file-name-absolute-p module
) (format ",enter %S" module
))
135 (t (format ",enter %s" module
)))))
137 (defun geiser-racket--geiser-procedure (proc &rest args
)
140 (format ",geiser-eval %s %s %s"
142 (geiser-racket--language)
143 (mapconcat 'identity
(cdr args
) " ")))
144 ((load-file compile-file
)
145 (format ",geiser-eval geiser/main racket (geiser:%s %s)"
147 ((no-values) ",geiser-no-values")
148 (t (format ",apply geiser:%s (%s)" proc
(mapconcat 'identity args
" ")))))
150 (defconst geiser-racket--module-re
151 "^(module +\\([^ ]+\\)")
153 (defun geiser-racket--explicit-module ()
155 (goto-char (point-min))
156 (and (re-search-forward geiser-racket--module-re nil t
)
158 (car (geiser-syntax--read-from-string
159 (match-string-no-properties 1)))))))
161 (defsubst geiser-racket--implicit-module
()
163 (goto-char (point-min))
164 (if (re-search-forward "^#lang " nil t
)
168 (defun geiser-racket--get-module (&optional module
)
169 (cond ((and (null module
) (buffer-file-name)))
170 ;; (geiser-racket--explicit-module)
171 ((null module
) (geiser-racket--implicit-module))
172 ((symbolp module
) module
)
173 ((and (stringp module
) (file-name-absolute-p module
)) module
)
174 ((stringp module
) (make-symbol module
))
177 (defun geiser-racket--symbol-begin (module)
178 (save-excursion (skip-syntax-backward "^-()>") (point)))
180 (defun geiser-racket--import-command (module)
181 (and (stringp module
)
182 (not (zerop (length module
)))
183 (format "(require %s)" module
)))
185 (defun geiser-racket--exit-command ()
187 (get-buffer-process (current-buffer)))
189 (defconst geiser-racket--binding-forms
190 '("for" "for/list" "for/hash" "for/hasheq" "for/and" "for/or"
191 "for/lists" "for/first" "for/last" "for/fold"
192 "for:" "for/list:" "for/hash:" "for/hasheq:" "for/and:" "for/or:"
193 "for/lists:" "for/first:" "for/last:" "for/fold:"
194 "define-syntax-rule"))
196 (defconst geiser-racket--binding-forms
*
197 '("for*" "for*/list" "for*/lists" "for*/hash" "for*/hasheq" "for*/and"
198 "for*/or" "for*/first" "for*/last" "for*/fold"
199 "for*:" "for*/list:" "for*/lists:" "for*/hash:" "for*/hasheq:" "for*/and:"
200 "for*/or:" "for*/first:" "for*/last:" "for*/fold:"))
204 (defsubst geiser-racket--get-help
(symbol module
)
205 (geiser-eval--send/wait
`(:scm
,(format ",help %s %s" symbol module
))))
207 (defun geiser-racket--external-help (id module
)
208 (message "Looking up manual for '%s'..." id
)
209 (let* ((ret (geiser-racket--get-help id
(format "%S" module
)))
210 (out (geiser-eval--retort-output ret
))
211 (ret (if (and out
(string-match " but provided by:\n +\\(.+\\)\n" out
))
212 (geiser-racket--get-help id
(match-string 1 out
))
214 (unless (string-match "^Sending to web browser.+"
215 (geiser-eval--retort-output ret
))
216 (minibuffer-message "%s not found" (current-message)))
222 (defconst geiser-racket--file-rxs
224 "path:\"?\\([^>\"\n]+\\)\"?>"
225 "module: \"\\([^>\"\n]+\\)\""))
227 (defconst geiser-racket--geiser-file-rx
228 (format "^%s/?racket/geiser" (regexp-quote geiser-scheme-dir
)))
230 (defun geiser-racket--purge-trace ()
232 (while (re-search-forward geiser-racket--geiser-file-rx nil t
)
235 (defun geiser-racket--display-error (module key msg
)
238 (geiser-doc--insert-button key nil
'racket
)
245 (when key
(geiser-racket--purge-trace))
246 (mapc 'geiser-edit--buttonize-files geiser-racket--file-rxs
)
249 (or key
(not (zerop (length msg
)))))
252 ;;; Trying to ascertain whether a buffer is mzscheme scheme:
254 (defun geiser-racket--guess ()
256 (goto-char (point-min))
257 (re-search-forward "#lang " nil t
))
258 (geiser-racket--explicit-module)))
261 ;;; Keywords and syntax
263 (defun geiser-racket--keywords ()
264 (append '(("^#lang\\>" .
0)
265 ("\\[\\(else\\)\\>" .
1))
266 (when geiser-racket-extra-keywords
267 `((,(format "[[(]%s\\>" (regexp-opt geiser-racket-extra-keywords
1))
270 (geiser-syntax--scheme-indent
274 (compound-unit/sig
0)
327 (parameterize-break 1)
331 (splicing-let-syntax 1)
332 (splicing-let-syntaxes 1)
333 (splicing-let-values 1)
335 (splicing-letrec-syntax 1)
336 (splicing-letrec-syntaxes 1)
337 (splicing-letrec-syntaxes+values
1)
338 (splicing-letrec-values 1)
341 (syntax-id-rules defun
)
351 ;;; Implementation definition:
353 (define-geiser-implementation racket
354 (unsupported-procedures '(callers callees generic-methods
))
355 (binary geiser-racket--binary
)
356 (arglist geiser-racket--parameters
)
357 (repl-startup geiser-racket--startup
)
358 (prompt-regexp geiser-racket--prompt-regexp
)
359 (marshall-procedure geiser-racket--geiser-procedure
)
360 (find-module geiser-racket--get-module
)
361 (enter-command geiser-racket--enter-command
)
362 (import-command geiser-racket--import-command
)
363 (exit-command geiser-racket--exit-command
)
364 (find-symbol-begin geiser-racket--symbol-begin
)
365 (display-error geiser-racket--display-error
)
366 (external-help geiser-racket--external-help
)
367 (check-buffer geiser-racket--guess
)
368 (keywords geiser-racket--keywords
)
369 (case-sensitive geiser-racket-case-sensitive-p
)
370 (binding-forms geiser-racket--binding-forms
)
371 (binding-forms* geiser-racket--binding-forms
*))
373 (geiser-impl--add-to-alist 'regexp
"\\.ss$" 'racket t
)
374 (geiser-impl--add-to-alist 'regexp
"\\.rkt$" 'racket t
)
376 (defun run-gracket ()
377 "Start the Racket REPL using gracket instead of plain racket."
379 (let ((geiser-racket-use-gracket-p t
))
383 (provide 'geiser-racket
)