1 ;; geiser-mode.el -- minor mode for scheme buffers
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: 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-impl
)
25 (require 'geiser-eval
)
26 (require 'geiser-popup
)
27 (require 'geiser-custom
)
28 (require 'geiser-base
)
33 (defgroup geiser-mode nil
34 "Mode enabling Geiser abilities in Scheme buffers &co.."
37 (geiser-custom--defcustom geiser-mode-autodoc-p t
38 "Whether `geiser-autodoc-mode' gets enabled by default in Scheme buffers."
40 :group
'geiser-autodoc
43 (geiser-custom--defcustom geiser-mode-company-p t
44 "Whether to use company-mode for completion, if available."
48 (geiser-custom--defcustom geiser-mode-smart-tab-p nil
49 "Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers."
55 ;;; Evaluation commands:
57 (defun geiser--go-to-repl ()
58 (switch-to-geiser nil nil
(current-buffer))
60 (goto-char (point-max)))
62 (defun geiser-eval-region (start end
&optional and-go raw
)
63 "Eval the current region in the Geiser REPL.
64 With prefix, goes to the REPL buffer afterwards (as
65 `geiser-eval-region-and-go')"
67 (geiser-debug--send-region nil
70 (and and-go
'geiser--go-to-repl
)
73 (defun geiser-eval-region-and-go (start end
)
74 "Eval the current region in the Geiser REPL and visit it afterwads."
76 (geiser-eval-region start end t
))
78 (defun geiser-eval-definition (&optional and-go
)
79 "Eval the current definition in the Geiser REPL.
80 With prefix, goes to the REPL buffer afterwards (as
81 `geiser-eval-definition-and-go')"
87 (geiser-eval-region (point) end and-go t
))))
89 (defun geiser-eval-definition-and-go ()
90 "Eval the current definition in the Geiser REPL and visit it afterwads."
92 (geiser-eval-definition t
))
94 (defun geiser-eval-last-sexp ()
95 "Eval the previous sexp in the Geiser REPL."
97 (geiser-eval-region (save-excursion (backward-sexp) (point))
102 (defun geiser-compile-definition (&optional and-go
)
103 "Compile the current definition in the Geiser REPL.
104 With prefix, goes to the REPL buffer afterwards (as
105 `geiser-eval-definition-and-go')"
111 (geiser-debug--send-region t
114 (and and-go
'geiser--go-to-repl
)
117 (defun geiser-compile-definition-and-go ()
118 "Compile the current definition in the Geiser REPL and visit it afterwads."
120 (geiser-compile-definition t
))
122 (defun geiser-expand-region (start end
&optional all raw
)
123 "Macro-expand the current region and display it in a buffer.
124 With prefix, recursively macro-expand the resulting expression."
126 (geiser-debug--expand-region start end all
(not raw
)))
128 (defun geiser-expand-definition (&optional all
)
129 "Macro-expand the current definition.
130 With prefix, recursively macro-expand the resulting expression."
136 (geiser-expand-region (point) end all t
))))
138 (defun geiser-expand-last-sexp (&optional all
)
139 "Macro-expand the previous sexp.
140 With prefix, recursively macro-expand the resulting expression."
142 (geiser-expand-region (save-excursion (backward-sexp) (point))
147 (defun geiser-set-scheme ()
148 "Associates current buffer with a given Scheme implementation."
150 (let ((impl (geiser-impl--read-impl)))
151 (geiser-impl--set-buffer-implementation impl
)
152 (geiser-repl--set-up-repl impl
)))
154 (defun geiser-mode-switch-to-repl (arg)
155 "Switches to Geiser REPL.
156 With prefix, try to enter the current's buffer module."
159 (switch-to-geiser-module (geiser-eval--get-module) (current-buffer))
160 (switch-to-geiser nil nil
(current-buffer))))
162 (defun geiser-mode-switch-to-repl-and-enter ()
163 "Switches to Geiser REPL and enters current's buffer module."
165 (geiser-mode-switch-to-repl t
))
167 (defun geiser-restart-repl ()
168 "Restarts the REPL associated with the current buffer."
170 (let ((b (current-buffer)))
171 (geiser-mode-switch-to-repl nil
)
173 (sit-for 0.1) ;; ugly hack; but i don't care enough to fix it
174 (call-interactively 'run-geiser
)
175 (sit-for 0.2) ;; ditto
176 (goto-char (point-max))
182 (make-variable-buffer-local
183 (defvar geiser-mode-string nil
184 "Modeline indicator for geiser-mode"))
186 (defun geiser-mode--lighter ()
187 (or geiser-mode-string
188 (format " %s" (or (geiser-impl--impl-str) "G"))))
190 (defvar geiser-mode-map
(make-sparse-keymap))
192 (define-minor-mode geiser-mode
193 "Toggle Geiser's mode.
194 With no argument, this command toggles the mode.
195 Non-null prefix argument turns on the mode.
196 Null prefix argument turns off the mode.
198 When Geiser mode is enabled, a host of nice utilities for
199 interacting with the Geiser REPL is at your disposal.
202 :lighter
(:eval
(geiser-mode--lighter))
204 :keymap geiser-mode-map
205 (when geiser-mode
(geiser-impl--set-buffer-implementation nil t
))
206 (setq geiser-autodoc-mode-string
"/A")
207 (setq geiser-smart-tab-mode-string
"/T")
208 (geiser-company--setup (and geiser-mode geiser-mode-company-p
))
209 (when geiser-mode-autodoc-p
210 (geiser-autodoc-mode (if geiser-mode
1 -
1)))
211 (when geiser-mode-smart-tab-p
212 (geiser-smart-tab-mode (if geiser-mode
1 -
1))))
214 (defun turn-on-geiser-mode ()
215 "Enable `geiser-mode' (in a Scheme buffer)."
219 (defun turn-off-geiser-mode ()
220 "Disable `geiser-mode' (in a Scheme buffer)."
227 (geiser-menu--defmenu geiserm geiser-mode-map
228 ("Eval sexp before point" "\C-x\C-e" geiser-eval-last-sexp
)
229 ("Eval definition" "\M-\C-x" geiser-eval-definition
)
230 ("Eval definition and go" "\C-c\M-e" geiser-eval-definition-and-go
)
231 ("Eval region" "\C-c\C-r" geiser-eval-region
:enable mark-active
)
232 ("Eval region and go" "\C-c\M-r" geiser-eval-region-and-go
233 geiser-eval-region
:enable mark-active
)
234 ;; ("Compile definition" "\C-c\M-c" geiser-compile-definition)
235 ;; ("Compile definition and go" "\C-c\C-c" geiser-compile-definition-and-go)
237 ("Sexp before point" ("\C-c\C-m\C-e" "\C-c\C-me")
238 geiser-expand-last-sexp
)
239 ("Region" ("\C-c\C-m\C-r" "\C-c\C-mr") geiser-expand-region
)
240 ("Definition" ("\C-c\C-m\C-x" "\C-c\C-mx") geiser-expand-definition
))
242 ("Symbol documentation" ("\C-c\C-d\C-d" "\C-c\C-dd")
243 geiser-doc-symbol-at-point
:enable
(symbol-at-point))
244 ("Module documentation" ("\C-c\C-d\C-m" "\C-c\C-dm") geiser-doc-module
)
245 (mode "Autodoc mode" ("\C-c\C-d\C-a" "\C-c\C-da") geiser-autodoc-mode
)
247 ("Compile buffer" "\C-c\C-k" geiser-compile-current-buffer
)
248 ("Switch to REPL" "\C-c\C-z" geiser-mode-switch-to-repl
)
249 ("Switch to REPL and enter module" "\C-c\C-Z"
250 geiser-mode-switch-to-repl-and-enter
)
251 ("Set Scheme..." "\C-c\C-s" geiser-set-scheme
)
253 ("Edit symbol at point" "\M-." geiser-edit-symbol-at-point
254 :enable
(symbol-at-point))
255 ("Go to previous definition" "\M-," geiser-pop-symbol-stack
)
256 ("Complete symbol" ((kbd "M-TAB")) geiser-completion--complete-symbol
257 :enable
(symbol-at-point))
258 ("Complete module name" ((kbd "M-`") (kbd "C-."))
259 geiser-completion--complete-module
)
260 ("Edit module" ("\C-c\C-e\C-m" "\C-c\C-em") geiser-edit-module
)
262 ("Callers" ((kbd "C-c <")) geiser-xref-callers
263 :enable
(and (geiser-eval--supported-p 'callers
) (symbol-at-point)))
264 ("Callees" ((kbd "C-c >")) geiser-xref-callees
265 :enable
(and (geiser-eval--supported-p 'callees
) (symbol-at-point)))
267 (mode "Smart TAB mode" nil geiser-smart-tab-mode
)
269 (custom "Customize Geiser mode" geiser-mode
))
271 (define-key geiser-mode-map
[menu-bar scheme
] 'undefined
)
273 ;; (geiser-mode--triple-chord ?x ?m 'geiser-xref-generic-methods)
278 (defun geiser-mode--buffers ()
280 (dolist (buffer (buffer-list))
281 (when (buffer-live-p buffer
)
284 (push (cons buffer geiser-impl--implementation
) buffers
))))
287 (defun geiser-mode--restore (buffers)
289 (when (buffer-live-p (car b
))
292 (geiser-impl--set-buffer-implementation (cdr b
)))
295 (defun geiser-mode-unload-function ()
296 (dolist (b (geiser-mode--buffers))
297 (with-current-buffer (car b
) (geiser-mode nil
))))
300 (provide 'geiser-mode
)
301 ;;; geiser-mode.el ends here