1 ;; geiser-mode.el -- minor mode for scheme buffers
3 ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 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: Sun Feb 08, 2009 15:13
14 (require 'geiser-repl
)
15 (require 'geiser-menu
)
17 (require 'geiser-compile
)
18 (require 'geiser-completion
)
19 (require 'geiser-company
)
20 (require 'geiser-xref
)
21 (require 'geiser-edit
)
22 (require 'geiser-autodoc
)
23 (require 'geiser-debug
)
24 (require 'geiser-syntax
)
25 (require 'geiser-impl
)
26 (require 'geiser-eval
)
27 (require 'geiser-popup
)
28 (require 'geiser-custom
)
29 (require 'geiser-base
)
34 (defgroup geiser-mode nil
35 "Mode enabling Geiser abilities in Scheme buffers &co.."
38 (geiser-custom--defcustom geiser-mode-auto-p t
39 "Whether `geiser-mode' should be active by default in all scheme buffers."
43 (geiser-custom--defcustom geiser-mode-start-repl-p nil
44 "Whether a REPL should be automatically started if one is not
45 active when `geiser-mode' is activated in a buffer."
49 (geiser-custom--defcustom geiser-mode-autodoc-p t
50 "Whether `geiser-autodoc-mode' gets enabled by default in Scheme buffers."
52 :group
'geiser-autodoc
55 (geiser-custom--defcustom geiser-mode-company-p t
56 "Whether to use company-mode for completion, if available."
60 (geiser-custom--defcustom geiser-mode-smart-tab-p nil
61 "Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers."
67 ;;; Evaluation commands:
69 (defun geiser--go-to-repl ()
70 (switch-to-geiser nil nil
(current-buffer))
72 (goto-char (point-max)))
74 (defun geiser-eval-region (start end
&optional and-go raw nomsg
)
75 "Eval the current region in the Geiser REPL.
77 With prefix, goes to the REPL buffer afterwards (as
78 `geiser-eval-region-and-go')"
81 (narrow-to-region start end
)
83 (geiser-debug--send-region nil
86 (and and-go
'geiser--go-to-repl
)
90 (defun geiser-eval-region-and-go (start end
)
91 "Eval the current region in the Geiser REPL and visit it afterwads."
93 (geiser-eval-region start end t
))
95 (geiser-impl--define-caller geiser-eval--bounds eval-bounds
()
96 "A pair with the bounds of a buffer to be evaluated, defaulting
97 to (cons (point-min) . (point-max)).")
99 (defun geiser-eval-buffer (&optional and-go raw nomsg
)
100 "Eval the current buffer in the Geiser REPL.
102 With prefix, goes to the REPL buffer afterwards (as
103 `geiser-eval-buffer-and-go')"
105 (let* ((bounds (geiser-eval--bounds geiser-impl--implementation
))
106 (from (or (car bounds
) (point-min)))
107 (to (or (cdr bounds
) (point-max))))
108 (geiser-eval-region from to and-go raw nomsg
)))
110 (defun geiser-eval-buffer-and-go ()
111 "Eval the current buffer in the Geiser REPL and visit it afterwads."
113 (geiser-eval-buffer t
))
115 (defun geiser-eval-definition (&optional and-go
)
116 "Eval the current definition in the Geiser REPL.
118 With prefix, goes to the REPL buffer afterwards (as
119 `geiser-eval-definition-and-go')"
125 (geiser-eval-region (point) end and-go t
))))
127 (defun geiser-eval-definition-and-go ()
128 "Eval the current definition in the Geiser REPL and visit it afterwads."
130 (geiser-eval-definition t
))
132 (defun geiser-eval-last-sexp (print-to-buffer-p)
133 "Eval the previous sexp in the Geiser REPL.
135 With a prefix, print the result of the evaluation to the buffer."
137 (let* ((ret (geiser-eval-region (save-excursion (backward-sexp) (point))
142 (str (geiser-eval--retort-result-str ret
(when print-to-buffer-p
""))))
143 (when (and print-to-buffer-p
(not (string= "" str
)))
147 (defun geiser-compile-definition (&optional and-go
)
148 "Compile the current definition in the Geiser REPL.
150 With prefix, goes to the REPL buffer afterwards (as
151 `geiser-eval-definition-and-go')"
157 (geiser-debug--send-region t
160 (and and-go
'geiser--go-to-repl
)
163 (defun geiser-compile-definition-and-go ()
164 "Compile the current definition in the Geiser REPL and visit it afterwads."
166 (geiser-compile-definition t
))
168 (defun geiser-expand-region (start end
&optional all raw
)
169 "Macro-expand the current region and display it in a buffer.
170 With prefix, recursively macro-expand the resulting expression."
172 (geiser-debug--expand-region start end all
(not raw
)))
174 (defun geiser-expand-definition (&optional all
)
175 "Macro-expand the current definition.
177 With prefix, recursively macro-expand the resulting expression."
183 (geiser-expand-region (point) end all t
))))
185 (defun geiser-expand-last-sexp (&optional all
)
186 "Macro-expand the previous sexp.
188 With prefix, recursively macro-expand the resulting expression."
190 (geiser-expand-region (save-excursion (backward-sexp) (point))
195 (defun geiser-set-scheme ()
196 "Associates current buffer with a given Scheme implementation."
198 (let ((impl (geiser-impl--read-impl)))
199 (geiser-impl--set-buffer-implementation impl
)
200 (geiser-repl--set-up-repl impl
)))
202 (defun geiser-mode-switch-to-repl (arg)
203 "Switches to Geiser REPL.
205 With prefix, try to enter the current buffer's module."
208 (switch-to-geiser-module (geiser-eval--get-module) (current-buffer))
209 (switch-to-geiser nil nil
(current-buffer))))
211 (defun geiser-mode-switch-to-repl-and-enter ()
212 "Switches to Geiser REPL and enters current buffer's module."
214 (geiser-mode-switch-to-repl t
))
216 (defun geiser-restart-repl ()
217 "Restarts the REPL associated with the current buffer."
219 (let ((b (current-buffer)))
220 (geiser-mode-switch-to-repl nil
)
222 (sit-for 0.1) ;; ugly hack; but i don't care enough to fix it
223 (call-interactively 'run-geiser
)
224 (sit-for 0.2) ;; ditto
225 (goto-char (point-max))
228 (defun geiser-squarify (n)
229 "Toggle between () and [] for current form.
231 With numeric prefix, perform that many toggles, forward for
232 positive values and backward for negative."
234 (let ((pared (and (boundp 'paredit-mode
) paredit-mode
))
237 (when (and pared
(fboundp 'paredit-mode
)) (paredit-mode -
1))
240 (unless (looking-at-p "\\s(") (backward-up-list))
243 (round (looking-at-p "(")))
245 (backward-delete-char 1)
246 (insert (if round
"]" ")"))
249 (insert (if round
"[" "("))
250 (setq steps
(1- steps
))
253 (progn (when fwd
(forward-sexp 2))
255 (error (setq steps
0))))))
256 (when (and pared
(fboundp 'paredit-mode
)) (paredit-mode 1)))))
258 (defun geiser-insert-lambda (&optional full
)
259 "Insert λ at point. With prefix, inserts (λ ())."
262 (insert (make-char 'greek-iso8859-7
107))
263 (insert "(" (make-char 'greek-iso8859-7
107) " ())")
269 (make-variable-buffer-local
270 (defvar geiser-mode-string nil
271 "Modeline indicator for geiser-mode"))
273 (defun geiser-mode--lighter ()
274 (or geiser-mode-string
275 (format " %s" (or (geiser-impl--impl-str) "G"))))
277 (defvar geiser-mode-map
(make-sparse-keymap))
279 (define-minor-mode geiser-mode
280 "Toggle Geiser's mode.
282 With no argument, this command toggles the mode.
283 Non-null prefix argument turns on the mode.
284 Null prefix argument turns off the mode.
286 When Geiser mode is enabled, a host of nice utilities for
287 interacting with the Geiser REPL is at your disposal.
290 :lighter
(:eval
(geiser-mode--lighter))
292 :keymap geiser-mode-map
293 (when geiser-mode
(geiser-impl--set-buffer-implementation nil t
))
294 (setq geiser-autodoc-mode-string
"/A")
295 (setq geiser-smart-tab-mode-string
"/T")
296 (geiser-company--setup (and geiser-mode geiser-mode-company-p
))
297 (geiser-completion--setup geiser-mode
)
298 (when geiser-mode-autodoc-p
299 (geiser-autodoc-mode (if geiser-mode
1 -
1)))
300 (when geiser-mode-smart-tab-p
301 (geiser-smart-tab-mode (if geiser-mode
1 -
1)))
302 (geiser-syntax--add-kws)
303 (when (and geiser-mode
304 geiser-mode-start-repl-p
305 (not (geiser-repl--connection*)))
306 (save-window-excursion (run-geiser geiser-impl--implementation
))))
308 (defun turn-on-geiser-mode ()
309 "Enable `geiser-mode' (in a Scheme buffer)."
313 (defun turn-off-geiser-mode ()
314 "Disable `geiser-mode' (in a Scheme buffer)."
318 (defun geiser-mode--maybe-activate ()
319 (when (and geiser-mode-auto-p
(eq major-mode
'scheme-mode
))
320 (turn-on-geiser-mode)))
325 (geiser-menu--defmenu geiserm geiser-mode-map
326 ("Eval sexp before point" "\C-x\C-e" geiser-eval-last-sexp
)
327 ("Eval definition" "\M-\C-x" geiser-eval-definition
)
328 ("Eval definition and go" "\C-c\M-e" geiser-eval-definition-and-go
)
329 ("Eval region" "\C-c\C-r" geiser-eval-region
:enable mark-active
)
330 ("Eval region and go" "\C-c\M-r" geiser-eval-region-and-go
331 geiser-eval-region
:enable mark-active
)
332 ("Eval buffer" "\C-c\C-b" geiser-eval-buffer
)
333 ("Eval buffer and go" "\C-c\M-b" geiser-eval-buffer-and-go
)
334 ;; ("Compile definition" "\C-c\M-c" geiser-compile-definition)
335 ;; ("Compile definition and go" "\C-c\C-c" geiser-compile-definition-and-go)
337 ("Sexp before point" ("\C-c\C-m\C-e" "\C-c\C-me")
338 geiser-expand-last-sexp
)
339 ("Region" ("\C-c\C-m\C-r" "\C-c\C-mr") geiser-expand-region
)
340 ("Definition" ("\C-c\C-m\C-x" "\C-c\C-mx") geiser-expand-definition
))
342 ("Symbol documentation" ("\C-c\C-d\C-d" "\C-c\C-dd")
343 geiser-doc-symbol-at-point
:enable
(geiser--symbol-at-point))
344 ("Short symbol documentation" ("\C-c\C-d\C-s" "\C-c\C-ds")
345 geiser-autodoc-show
:enable
(geiser--symbol-at-point))
346 ("Module documentation" ("\C-c\C-d\C-m" "\C-c\C-dm") geiser-doc-module
)
347 ("Symbol manual lookup" ("\C-c\C-d\C-i" "\C-c\C-di")
348 geiser-doc-look-up-manual
:enable
(geiser-doc--manual-available-p))
349 (mode "Autodoc mode" ("\C-c\C-d\C-a" "\C-c\C-da") geiser-autodoc-mode
)
351 ("Compile buffer" "\C-c\C-k" geiser-compile-current-buffer
)
352 ("Switch to REPL" "\C-c\C-z" geiser-mode-switch-to-repl
)
353 ("Switch to REPL and enter module" "\C-c\C-a"
354 geiser-mode-switch-to-repl-and-enter
)
355 ("Set Scheme..." "\C-c\C-s" geiser-set-scheme
)
357 ("Edit symbol at point" "\M-." geiser-edit-symbol-at-point
358 :enable
(geiser--symbol-at-point))
359 ("Go to previous definition" "\M-," geiser-pop-symbol-stack
)
360 ("Complete symbol" ((kbd "M-TAB")) completion-at-point
361 :enable
(geiser--symbol-at-point))
362 ("Complete module name" ((kbd "M-`") (kbd "C-."))
363 geiser-completion--complete-module
)
364 ("Edit module" ("\C-c\C-e\C-m" "\C-c\C-em") geiser-edit-module
)
365 ("Add to load path..." ("\C-c\C-e\C-l" "\C-c\C-el") geiser-add-to-load-path
)
366 ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify
)
367 ("Insert λ" ("\C-c\\" "\C-c\C-\\") geiser-insert-lambda
)
369 ("Callers" ((kbd "C-c <")) geiser-xref-callers
370 :enable
(and (geiser-eval--supported-p 'callers
)
371 (geiser--symbol-at-point)))
372 ("Callees" ((kbd "C-c >")) geiser-xref-callees
373 :enable
(and (geiser-eval--supported-p 'callees
)
374 (geiser--symbol-at-point)))
376 (mode "Smart TAB mode" nil geiser-smart-tab-mode
)
378 (custom "Customize Geiser mode" geiser-mode
))
380 (define-key geiser-mode-map
[menu-bar scheme
] 'undefined
)
382 ;; (geiser-mode--triple-chord ?x ?m 'geiser-xref-generic-methods)
387 (defun geiser-mode--buffers ()
389 (dolist (buffer (buffer-list))
390 (when (buffer-live-p buffer
)
393 (push (cons buffer geiser-impl--implementation
) buffers
))))
396 (defun geiser-mode--restore (buffers)
398 (when (buffer-live-p (car b
))
401 (geiser-impl--set-buffer-implementation (cdr b
)))
404 (defun geiser-mode-unload-function ()
405 (dolist (b (geiser-mode--buffers))
406 (with-current-buffer (car b
) (geiser-mode nil
))))
409 (provide 'geiser-mode
)