NEWS entry since Diogo confirmed things work again
[geiser.git] / elisp / geiser-mode.el
blob4d43d1bcb8ba21bcb9162d8c97f517a32d0e794b
1 ;; geiser-mode.el -- minor mode for scheme buffers
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: Sun Feb 08, 2009 15:13
14 (require 'geiser-repl)
15 (require 'geiser-menu)
16 (require 'geiser-doc)
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)
32 ;;; Customization:
34 (defgroup geiser-mode nil
35 "Mode enabling Geiser abilities in Scheme buffers &co.."
36 :group 'geiser)
38 (geiser-custom--defcustom geiser-mode-auto-p t
39 "Whether `geiser-mode' should be active by default in all
40 scheme buffers."
41 :group 'geiser-mode
42 :type 'boolean)
44 (geiser-custom--defcustom geiser-mode-start-repl-p nil
45 "Whether a REPL should be automatically started if one is not
46 active when `geiser-mode' is activated in a buffer."
47 :group 'geiser-mode
48 :type 'boolean)
50 (geiser-custom--defcustom geiser-mode-autodoc-p t
51 "Whether `geiser-autodoc-mode' gets enabled by default in Scheme buffers."
52 :group 'geiser-mode
53 :group 'geiser-autodoc
54 :type 'boolean)
56 (geiser-custom--defcustom geiser-mode-company-p t
57 "Whether to use company-mode for completion, if available."
58 :group 'geiser-mode
59 :type 'boolean)
61 (geiser-custom--defcustom geiser-mode-smart-tab-p nil
62 "Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers."
63 :group 'geiser-mode
64 :type 'boolean)
68 ;;; Evaluation commands:
70 (defun geiser--go-to-repl ()
71 (switch-to-geiser nil nil (current-buffer))
72 (push-mark)
73 (goto-char (point-max)))
75 (defun geiser-eval-region (start end &optional and-go raw nomsg)
76 "Eval the current region in the Geiser REPL.
78 With prefix, goes to the REPL buffer afterwards (as
79 `geiser-eval-region-and-go')"
80 (interactive "rP")
81 (save-restriction
82 (narrow-to-region start end)
83 (check-parens))
84 (geiser-debug--send-region nil
85 start
86 end
87 (and and-go 'geiser--go-to-repl)
88 (not raw)
89 nomsg))
91 (defun geiser-eval-region-and-go (start end)
92 "Eval the current region in the Geiser REPL and visit it afterwads."
93 (interactive "r")
94 (geiser-eval-region start end t))
96 (defun geiser-eval-definition (&optional and-go)
97 "Eval the current definition in the Geiser REPL.
99 With prefix, goes to the REPL buffer afterwards (as
100 `geiser-eval-definition-and-go')"
101 (interactive "P")
102 (save-excursion
103 (end-of-defun)
104 (let ((end (point)))
105 (beginning-of-defun)
106 (geiser-eval-region (point) end and-go t))))
108 (defun geiser-eval-definition-and-go ()
109 "Eval the current definition in the Geiser REPL and visit it afterwads."
110 (interactive)
111 (geiser-eval-definition t))
113 (defun geiser-eval-last-sexp (print-to-buffer-p)
114 "Eval the previous sexp in the Geiser REPL.
116 With a prefix, print the result of the evaluation to the buffer."
117 (interactive "P")
118 (let* ((ret (geiser-eval-region (save-excursion (backward-sexp) (point))
119 (point)
122 print-to-buffer-p))
123 (str (geiser-eval--retort-result-str ret (when print-to-buffer-p ""))))
124 (when (and print-to-buffer-p (not (string= "" str)))
125 (push-mark)
126 (insert str))))
128 (defun geiser-compile-definition (&optional and-go)
129 "Compile the current definition in the Geiser REPL.
131 With prefix, goes to the REPL buffer afterwards (as
132 `geiser-eval-definition-and-go')"
133 (interactive "P")
134 (save-excursion
135 (end-of-defun)
136 (let ((end (point)))
137 (beginning-of-defun)
138 (geiser-debug--send-region t
139 (point)
141 (and and-go 'geiser--go-to-repl)
142 t))))
144 (defun geiser-compile-definition-and-go ()
145 "Compile the current definition in the Geiser REPL and visit it afterwads."
146 (interactive)
147 (geiser-compile-definition t))
149 (defun geiser-expand-region (start end &optional all raw)
150 "Macro-expand the current region and display it in a buffer.
151 With prefix, recursively macro-expand the resulting expression."
152 (interactive "rP")
153 (geiser-debug--expand-region start end all (not raw)))
155 (defun geiser-expand-definition (&optional all)
156 "Macro-expand the current definition.
158 With prefix, recursively macro-expand the resulting expression."
159 (interactive "P")
160 (save-excursion
161 (end-of-defun)
162 (let ((end (point)))
163 (beginning-of-defun)
164 (geiser-expand-region (point) end all t))))
166 (defun geiser-expand-last-sexp (&optional all)
167 "Macro-expand the previous sexp.
169 With prefix, recursively macro-expand the resulting expression."
170 (interactive "P")
171 (geiser-expand-region (save-excursion (backward-sexp) (point))
172 (point)
176 (defun geiser-set-scheme ()
177 "Associates current buffer with a given Scheme implementation."
178 (interactive)
179 (let ((impl (geiser-impl--read-impl)))
180 (geiser-impl--set-buffer-implementation impl)
181 (geiser-repl--set-up-repl impl)))
183 (defun geiser-mode-switch-to-repl (arg)
184 "Switches to Geiser REPL.
186 With prefix, try to enter the current buffer's module."
187 (interactive "P")
188 (if arg
189 (switch-to-geiser-module (geiser-eval--get-module) (current-buffer))
190 (switch-to-geiser nil nil (current-buffer))))
192 (defun geiser-mode-switch-to-repl-and-enter ()
193 "Switches to Geiser REPL and enters current buffer's module."
194 (interactive)
195 (geiser-mode-switch-to-repl t))
197 (defun geiser-restart-repl ()
198 "Restarts the REPL associated with the current buffer."
199 (interactive)
200 (let ((b (current-buffer)))
201 (geiser-mode-switch-to-repl nil)
202 (comint-kill-subjob)
203 (sit-for 0.1) ;; ugly hack; but i don't care enough to fix it
204 (call-interactively 'run-geiser)
205 (sit-for 0.2) ;; ditto
206 (goto-char (point-max))
207 (pop-to-buffer b)))
209 (defun geiser-squarify (n)
210 "Toggle between () and [] for current form.
212 With numeric prefix, perform that many toggles, forward for
213 positive values and backward for negative."
214 (interactive "p")
215 (let ((pared (and (boundp 'paredit-mode) paredit-mode))
216 (fwd (> n 0))
217 (steps (abs n)))
218 (when (and pared (fboundp 'paredit-mode)) (paredit-mode -1))
219 (unwind-protect
220 (save-excursion
221 (unless (looking-at-p "\\s(") (backward-up-list))
222 (while (> steps 0)
223 (let ((p (point))
224 (round (looking-at-p "(")))
225 (forward-sexp)
226 (backward-delete-char 1)
227 (insert (if round "]" ")"))
228 (goto-char p)
229 (delete-char 1)
230 (insert (if round "[" "("))
231 (setq steps (1- steps))
232 (backward-char)
233 (condition-case nil
234 (progn (when fwd (forward-sexp 2))
235 (backward-sexp))
236 (error (setq steps 0))))))
237 (when (and pared (fboundp 'paredit-mode)) (paredit-mode 1)))))
239 (defun geiser-insert-lambda (&optional full)
240 "Insert λ at point. With prefix, inserts (λ ())."
241 (interactive "P")
242 (if (not full)
243 (insert (make-char 'greek-iso8859-7 107))
244 (insert "(" (make-char 'greek-iso8859-7 107) " ())")
245 (backward-char 2)))
248 ;;; Geiser mode:
250 (make-variable-buffer-local
251 (defvar geiser-mode-string nil
252 "Modeline indicator for geiser-mode"))
254 (defun geiser-mode--lighter ()
255 (or geiser-mode-string
256 (format " %s" (or (geiser-impl--impl-str) "G"))))
258 (defvar geiser-mode-map (make-sparse-keymap))
260 (define-minor-mode geiser-mode
261 "Toggle Geiser's mode.
263 With no argument, this command toggles the mode.
264 Non-null prefix argument turns on the mode.
265 Null prefix argument turns off the mode.
267 When Geiser mode is enabled, a host of nice utilities for
268 interacting with the Geiser REPL is at your disposal.
269 \\{geiser-mode-map}"
270 :init-value nil
271 :lighter (:eval (geiser-mode--lighter))
272 :group 'geiser-mode
273 :keymap geiser-mode-map
274 (when geiser-mode (geiser-impl--set-buffer-implementation nil t))
275 (setq geiser-autodoc-mode-string "/A")
276 (setq geiser-smart-tab-mode-string "/T")
277 (geiser-company--setup (and geiser-mode geiser-mode-company-p))
278 (geiser-completion--setup geiser-mode)
279 (when geiser-mode-autodoc-p
280 (geiser-autodoc-mode (if geiser-mode 1 -1)))
281 (when geiser-mode-smart-tab-p
282 (geiser-smart-tab-mode (if geiser-mode 1 -1)))
283 (geiser-syntax--add-kws)
284 (when (and geiser-mode
285 geiser-mode-start-repl-p
286 (not (geiser-repl--connection*)))
287 (save-window-excursion (run-geiser geiser-impl--implementation))))
289 (defun turn-on-geiser-mode ()
290 "Enable `geiser-mode' (in a Scheme buffer)."
291 (interactive)
292 (geiser-mode 1))
294 (defun turn-off-geiser-mode ()
295 "Disable `geiser-mode' (in a Scheme buffer)."
296 (interactive)
297 (geiser-mode -1))
299 (defun geiser-mode--maybe-activate ()
300 (when geiser-mode-auto-p (turn-on-geiser-mode)))
303 ;;; Keys:
305 (geiser-menu--defmenu geiserm geiser-mode-map
306 ("Eval sexp before point" "\C-x\C-e" geiser-eval-last-sexp)
307 ("Eval definition" "\M-\C-x" geiser-eval-definition)
308 ("Eval definition and go" "\C-c\M-e" geiser-eval-definition-and-go)
309 ("Eval region" "\C-c\C-r" geiser-eval-region :enable mark-active)
310 ("Eval region and go" "\C-c\M-r" geiser-eval-region-and-go
311 geiser-eval-region :enable mark-active)
312 ;; ("Compile definition" "\C-c\M-c" geiser-compile-definition)
313 ;; ("Compile definition and go" "\C-c\C-c" geiser-compile-definition-and-go)
314 (menu "Macroexpand"
315 ("Sexp before point" ("\C-c\C-m\C-e" "\C-c\C-me")
316 geiser-expand-last-sexp)
317 ("Region" ("\C-c\C-m\C-r" "\C-c\C-mr") geiser-expand-region)
318 ("Definition" ("\C-c\C-m\C-x" "\C-c\C-mx") geiser-expand-definition))
320 ("Symbol documentation" ("\C-c\C-d\C-d" "\C-c\C-dd")
321 geiser-doc-symbol-at-point :enable (geiser--symbol-at-point))
322 ("Short symbol documentation" ("\C-c\C-d\C-s" "\C-c\C-ds")
323 geiser-autodoc-show :enable (geiser--symbol-at-point))
324 ("Module documentation" ("\C-c\C-d\C-m" "\C-c\C-dm") geiser-doc-module)
325 ("Symbol manual lookup" ("\C-c\C-d\C-i" "\C-c\C-di")
326 geiser-doc-look-up-manual :enable (geiser-doc--manual-available-p))
327 (mode "Autodoc mode" ("\C-c\C-d\C-a" "\C-c\C-da") geiser-autodoc-mode)
329 ("Compile buffer" "\C-c\C-k" geiser-compile-current-buffer)
330 ("Switch to REPL" "\C-c\C-z" geiser-mode-switch-to-repl)
331 ("Switch to REPL and enter module" "\C-c\C-a"
332 geiser-mode-switch-to-repl-and-enter)
333 ("Set Scheme..." "\C-c\C-s" geiser-set-scheme)
335 ("Edit symbol at point" "\M-." geiser-edit-symbol-at-point
336 :enable (geiser--symbol-at-point))
337 ("Go to previous definition" "\M-," geiser-pop-symbol-stack)
338 ("Complete symbol" ((kbd "M-TAB")) completion-at-point
339 :enable (geiser--symbol-at-point))
340 ("Complete module name" ((kbd "M-`") (kbd "C-."))
341 geiser-completion--complete-module)
342 ("Edit module" ("\C-c\C-e\C-m" "\C-c\C-em") geiser-edit-module)
343 ("Add to load path..." ("\C-c\C-e\C-l" "\C-c\C-el") geiser-add-to-load-path)
344 ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify)
345 ("Insert λ" ("\C-c\\" "\C-c\C-\\") geiser-insert-lambda)
347 ("Callers" ((kbd "C-c <")) geiser-xref-callers
348 :enable (and (geiser-eval--supported-p 'callers)
349 (geiser--symbol-at-point)))
350 ("Callees" ((kbd "C-c >")) geiser-xref-callees
351 :enable (and (geiser-eval--supported-p 'callees)
352 (geiser--symbol-at-point)))
354 (mode "Smart TAB mode" nil geiser-smart-tab-mode)
356 (custom "Customize Geiser mode" geiser-mode))
358 (define-key geiser-mode-map [menu-bar scheme] 'undefined)
360 ;; (geiser-mode--triple-chord ?x ?m 'geiser-xref-generic-methods)
363 ;;; Reload support:
365 (defun geiser-mode--buffers ()
366 (let ((buffers))
367 (dolist (buffer (buffer-list))
368 (when (buffer-live-p buffer)
369 (set-buffer buffer)
370 (when geiser-mode
371 (push (cons buffer geiser-impl--implementation) buffers))))
372 buffers))
374 (defun geiser-mode--restore (buffers)
375 (dolist (b buffers)
376 (when (buffer-live-p (car b))
377 (set-buffer (car b))
378 (when (cdr b)
379 (geiser-impl--set-buffer-implementation (cdr b)))
380 (geiser-mode 1))))
382 (defun geiser-mode-unload-function ()
383 (dolist (b (geiser-mode--buffers))
384 (with-current-buffer (car b) (geiser-mode nil))))
387 (provide 'geiser-mode)