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\\)@[^ ]*?> ")
87 (defconst geiser-racket--init-server-cmd
",start-geiser")
90 ;;; Evaluation support:
92 (defun geiser-racket--language ()
94 (goto-char (point-min))
95 (if (re-search-forward
96 "^\\(?:#lang\\|(module +[^ ]+?\\) +\\([^ ]+?\\|([^)]+)\\) *$" nil t
)
97 (car (geiser-syntax--read-from-string (match-string-no-properties 1)))
100 (defun geiser-racket--geiser-procedure (proc &rest args
)
103 (format ",geiser-eval %s %s %s"
105 (geiser-racket--language)
106 (mapconcat 'identity
(cdr args
) " ")))
107 ((load-file compile-file
)
108 (format ",geiser-eval geiser/main racket (geiser:%s %s)"
110 ((no-values) ",geiser-no-values")
111 (t (format ",apply geiser:%s (%s)" proc
(mapconcat 'identity args
" ")))))
113 (defconst geiser-racket--module-re
114 "^(module +\\([^ ]+\\)")
116 (defun geiser-racket--explicit-module ()
118 (goto-char (point-min))
119 (and (re-search-forward geiser-racket--module-re nil t
)
121 (car (geiser-syntax--read-from-string
122 (match-string-no-properties 1)))))))
124 (defsubst geiser-racket--implicit-module
()
126 (goto-char (point-min))
127 (if (re-search-forward "^#lang " nil t
)
131 (defun geiser-racket--get-module (&optional module
)
132 (cond ((and (null module
) (buffer-file-name)))
133 ;; (geiser-racket--explicit-module)
134 ((null module
) (geiser-racket--implicit-module))
135 ((symbolp module
) module
)
136 ((and (stringp module
) (file-name-absolute-p module
)) module
)
137 ((stringp module
) (intern module
))
140 (defun geiser-racket--symbol-begin (module)
141 (save-excursion (skip-syntax-backward "^-()>") (point)))
143 (defun geiser-racket--enter-command (module)
144 (when (stringp module
)
145 (cond ((zerop (length module
)) ",enter #f")
146 ((file-name-absolute-p module
) (format ",enter (file %S)" module
))
147 (t (format ",enter %s" module
)))))
149 (defun geiser-racket--import-command (module)
150 (and (stringp module
)
151 (not (zerop (length module
)))
152 (format "(require %s)" module
)))
154 (defun geiser-racket--exit-command ()
156 (get-buffer-process (current-buffer)))
158 (defconst geiser-racket--binding-forms
159 '(for for
/list for
/hash for
/hasheq for
/and for
/or
160 for
/lists for
/first for
/last for
/fold
161 for
: for
/list
: for
/hash
: for
/hasheq
: for
/and
: for
/or
:
162 for
/lists
: for
/first
: for
/last
: for
/fold
:))
164 (defconst geiser-racket--binding-forms
*
165 '(for* for
*/list for
*/lists for
*/hash for
*/hasheq for
*/and
166 for
*/or for
*/first for
*/last for
*/fold
167 for
*: for
*/list
: for
*/lists
: for
*/hash
: for
*/hasheq
: for
*/and
:
168 for
*/or
: for
*/first
: for
*/last
: for
*/fold
:))
172 (defsubst geiser-racket--get-help
(symbol module
)
173 (geiser-eval--send/wait
174 `(:eval
(get-help ',symbol
'(:module
,module
)) geiser
/autodoc
)))
176 (defun geiser-racket--external-help (id module
)
177 (message "Requesting help for '%s'..." id
)
178 (let ((out (geiser-eval--retort-output
179 (geiser-racket--get-help id module
))))
180 (when (and out
(string-match " but provided by:\n +\\(.+\\)\n" out
))
181 (geiser-racket--get-help id
(match-string 1 out
))))
182 (minibuffer-message "%s done" (current-message))
188 (defconst geiser-racket--file-rxs
190 "path:\"?\\([^>\"\n]+\\)\"?>"
191 "module: \"\\([^>\"\n]+\\)\""))
193 (defconst geiser-racket--geiser-file-rx
194 (format "^%s/?racket/geiser" (regexp-quote geiser-scheme-dir
)))
196 (defun geiser-racket--purge-trace ()
198 (while (re-search-forward geiser-racket--geiser-file-rx nil t
)
201 (defun geiser-racket--display-error (module key msg
)
204 (geiser-doc--insert-button key nil
'racket
)
212 (geiser-racket--purge-trace)
213 (mapc 'geiser-edit--buttonize-files geiser-racket--file-rxs
)
216 (or key
(not (zerop (length msg
)))))
219 ;;; Trying to ascertain whether a buffer is mzscheme scheme:
221 (defun geiser-racket--guess ()
223 (goto-char (point-min))
224 (re-search-forward "#lang " nil t
))
225 (geiser-racket--explicit-module)))
230 (defun connect-to-racket ()
231 "Start a Racket REPL connected to a remote process.
233 The remote process needs to be running a REPL server started
234 using start-geiser, a procedure in the geiser/server module."
236 (geiser-connect 'racket
))
240 ;;; Implementation definition:
242 (define-geiser-implementation racket
243 (unsupported-procedures '(callers callees generic-methods
))
244 (binary geiser-racket--binary
)
245 (arglist geiser-racket--parameters
)
246 (init-server-cmd geiser-racket--init-server-cmd
)
248 (prompt-regexp geiser-racket--prompt-regexp
)
249 (marshall-procedure geiser-racket--geiser-procedure
)
250 (find-module geiser-racket--get-module
)
251 (enter-command geiser-racket--enter-command
)
252 (import-command geiser-racket--import-command
)
253 (exit-command geiser-racket--exit-command
)
254 (find-symbol-begin geiser-racket--symbol-begin
)
255 (display-error geiser-racket--display-error
)
256 (display-help geiser-racket--external-help
)
257 (check-buffer geiser-racket--guess
)
258 (binding-forms geiser-racket--binding-forms
)
259 (binding-forms* geiser-racket--binding-forms
*))
261 (geiser-impl--add-to-alist 'regexp
"\\.ss$" 'racket t
)
262 (geiser-impl--add-to-alist 'regexp
"\\.rkt$" 'racket t
)
264 (defun run-gracket ()
265 "Start the Racket REPL using gracket instead of plain racket."
267 (let ((geiser-racket-use-gracket-p t
))
271 (provide 'geiser-racket
)
272 ;;; geiser-racket.el ends here