1 ;;; geiser-mode.el -- minor mode for scheme buffers
3 ;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2020 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
15 (require 'geiser-repl
)
16 (require 'geiser-menu
)
18 (require 'geiser-compile
)
19 (require 'geiser-completion
)
20 (require 'geiser-company
)
21 (require 'geiser-xref
)
22 (require 'geiser-edit
)
23 (require 'geiser-autodoc
)
24 (require 'geiser-debug
)
25 (require 'geiser-syntax
)
26 (require 'geiser-impl
)
27 (require 'geiser-eval
)
28 (require 'geiser-popup
)
29 (require 'geiser-custom
)
30 (require 'geiser-base
)
35 (defgroup geiser-mode nil
36 "Mode enabling Geiser abilities in Scheme buffers &co.."
39 (geiser-custom--defcustom geiser-mode-auto-p t
40 "Whether `geiser-mode' should be active by default in all scheme buffers."
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."
50 (geiser-custom--defcustom geiser-mode-autodoc-p t
51 "Whether `geiser-autodoc-mode' gets enabled by default in Scheme buffers."
53 :group
'geiser-autodoc
56 (geiser-custom--defcustom geiser-mode-company-p t
57 "Whether to use company-mode for completion, if available."
61 (geiser-custom--defcustom geiser-mode-smart-tab-p nil
62 "Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers."
66 (geiser-custom--defcustom geiser-mode-eval-last-sexp-to-buffer nil
67 "Whether `eval-last-sexp' prints results to buffer"
71 (geiser-custom--defcustom geiser-mode-eval-to-buffer-prefix
" "
72 "When `geiser-mode-eval-last-sexp-to-buffer', the prefix string
73 which will be prepended to results."
77 (geiser-custom--defcustom geiser-mode-eval-to-buffer-transformer nil
78 "Transformer for results inserted in debug buffer.
80 When `geiser-mode-eval-last-sexp-to-buffer', the result will be
81 transformed using this function default behavior is just prepend
82 with `geiser-mode-eval-to-buffer-prefix' takes two arguments:
83 `msg' and `is-error?' `msg' is the result string going to be
84 transformed, `is-error?' is a boolean indicating whether the
85 result is an error msg."
91 ;;; Evaluation commands:
93 (defun geiser--go-to-repl ()
94 (switch-to-geiser nil nil
(current-buffer))
96 (goto-char (point-max)))
98 (defun geiser-eval-region (start end
&optional and-go raw nomsg
)
99 "Eval the current region in the Geiser REPL.
101 With prefix, goes to the REPL buffer afterwards (as
102 `geiser-eval-region-and-go')"
105 (narrow-to-region start end
)
107 (geiser-debug--send-region nil
110 (and and-go
'geiser--go-to-repl
)
114 (defun geiser-eval-region-and-go (start end
)
115 "Eval the current region in the Geiser REPL and visit it afterwads."
117 (geiser-eval-region start end t
))
119 (geiser-impl--define-caller geiser-eval--bounds eval-bounds
()
120 "A pair with the bounds of a buffer to be evaluated, defaulting
121 to (cons (point-min) . (point-max)).")
123 (defun geiser-eval-buffer (&optional and-go raw nomsg
)
124 "Eval the current buffer in the Geiser REPL.
126 With prefix, goes to the REPL buffer afterwards (as
127 `geiser-eval-buffer-and-go')"
129 (let* ((bounds (geiser-eval--bounds geiser-impl--implementation
))
130 (from (or (car bounds
) (point-min)))
131 (to (or (cdr bounds
) (point-max))))
132 (geiser-eval-region from to and-go raw nomsg
)))
134 (defun geiser-eval-buffer-and-go ()
135 "Eval the current buffer in the Geiser REPL and visit it afterwads."
137 (geiser-eval-buffer t
))
139 (defun geiser-eval-definition (&optional and-go
)
140 "Eval the current definition in the Geiser REPL.
142 With prefix, goes to the REPL buffer afterwards (as
143 `geiser-eval-definition-and-go')"
149 (geiser-eval-region (point) end and-go t
))))
151 (defun geiser-eval-definition-and-go ()
152 "Eval the current definition in the Geiser REPL and visit it afterwads."
154 (geiser-eval-definition t
))
156 (defun geiser-eval-last-sexp (print-to-buffer-p)
157 "Eval the previous sexp in the Geiser REPL.
159 With a prefix, revert the effect of `geiser-mode-eval-last-sexp-to-buffer' "
162 (eosexp (save-excursion (backward-sexp)
163 (setq bosexp
(point))
166 (ret-transformer (or geiser-mode-eval-to-buffer-transformer
167 (lambda (msg is-error?
)
169 geiser-mode-eval-to-buffer-prefix
170 (if is-error?
"ERROR" "")
173 (geiser-eval-region bosexp
;beginning of sexp
178 (err (geiser-eval--retort-error ret
))
179 (will-eval-to-buffer (if print-to-buffer-p
180 (not geiser-mode-eval-last-sexp-to-buffer
)
181 geiser-mode-eval-last-sexp-to-buffer
))
182 (str (geiser-eval--retort-result-str ret
183 (when will-eval-to-buffer
""))))
184 (cond ((not will-eval-to-buffer
) str
)
185 (err (insert (funcall ret-transformer
186 (geiser-eval--error-str err
) t
)))
189 (insert (funcall ret-transformer str nil
))))))
191 (defun geiser-compile-definition (&optional and-go
)
192 "Compile the current definition in the Geiser REPL.
194 With prefix, goes to the REPL buffer afterwards (as
195 `geiser-eval-definition-and-go')"
201 (geiser-debug--send-region t
204 (and and-go
'geiser--go-to-repl
)
207 (defun geiser-compile-definition-and-go ()
208 "Compile the current definition in the Geiser REPL and visit it afterwads."
210 (geiser-compile-definition t
))
212 (defun geiser-expand-region (start end
&optional all raw
)
213 "Macro-expand the current region and display it in a buffer.
214 With prefix, recursively macro-expand the resulting expression."
216 (geiser-debug--expand-region start end all
(not raw
)))
218 (defun geiser-expand-definition (&optional all
)
219 "Macro-expand the current definition.
221 With prefix, recursively macro-expand the resulting expression."
227 (geiser-expand-region (point) end all t
))))
229 (defun geiser-expand-last-sexp (&optional all
)
230 "Macro-expand the previous sexp.
232 With prefix, recursively macro-expand the resulting expression."
234 (geiser-expand-region (save-excursion (backward-sexp) (point))
239 (defun geiser-set-scheme ()
240 "Associates current buffer with a given Scheme implementation."
243 (geiser-syntax--remove-kws)
244 (let ((impl (geiser-impl--read-impl)))
245 (geiser-impl--set-buffer-implementation impl
)
246 (geiser-repl--set-up-repl impl
)
247 (geiser-syntax--add-kws)
248 (geiser-syntax--fontify))))
250 (defun geiser-mode-switch-to-repl (arg)
251 "Switches to Geiser REPL.
253 With prefix, try to enter the current buffer's module."
256 (switch-to-geiser-module (geiser-eval--get-module) (current-buffer))
257 (switch-to-geiser nil nil
(current-buffer))))
259 (defun geiser-mode-switch-to-repl-and-enter ()
260 "Switches to Geiser REPL and enters current buffer's module."
262 (geiser-mode-switch-to-repl t
))
264 (defun geiser-restart-repl ()
265 "Restarts the REPL associated with the current buffer."
267 (let ((b (current-buffer)))
268 (geiser-mode-switch-to-repl nil
)
270 (sit-for 0.1) ;; ugly hack; but i don't care enough to fix it
271 (call-interactively 'run-geiser
)
272 (sit-for 0.2) ;; ditto
273 (goto-char (point-max))
279 (defvar geiser-mode-map
280 (let ((map (make-sparse-keymap)))
281 (define-key map
[menu-bar scheme
] 'undefined
)
282 ;; (geiser-mode--triple-chord ?x ?m 'geiser-xref-generic-methods)
284 (geiser-menu--defmenu geiserm map
285 ("Eval sexp before point" "\C-x\C-e" geiser-eval-last-sexp
)
286 ("Eval definition" ("\M-\C-x" "\C-c\C-c") geiser-eval-definition
)
287 ("Eval definition and go" ("\C-c\M-e" "\C-c\M-e")
288 geiser-eval-definition-and-go
)
289 ("Eval region" "\C-c\C-r" geiser-eval-region
:enable mark-active
)
290 ("Eval region and go" "\C-c\M-r" geiser-eval-region-and-go
291 geiser-eval-region
:enable mark-active
)
292 ("Eval buffer" "\C-c\C-b" geiser-eval-buffer
)
293 ("Eval buffer and go" "\C-c\M-b" geiser-eval-buffer-and-go
)
294 ("Load scheme file..." "\C-c\C-l" geiser-load-file
)
296 ("Sexp before point" ("\C-c\C-m\C-e" "\C-c\C-me")
297 geiser-expand-last-sexp
)
298 ("Region" ("\C-c\C-m\C-r" "\C-c\C-mr") geiser-expand-region
)
299 ("Definition" ("\C-c\C-m\C-x" "\C-c\C-mx") geiser-expand-definition
))
301 ("Symbol documentation" ("\C-c\C-d\C-d" "\C-c\C-dd")
302 geiser-doc-symbol-at-point
:enable
(geiser--symbol-at-point))
303 ("Short symbol documentation" ("\C-c\C-d\C-s" "\C-c\C-ds")
304 geiser-autodoc-show
:enable
(geiser--symbol-at-point))
305 ("Module documentation" ("\C-c\C-d\C-m" "\C-c\C-dm") geiser-doc-module
)
306 ("Symbol manual lookup" ("\C-c\C-d\C-i" "\C-c\C-di")
307 geiser-doc-look-up-manual
:enable
(geiser-doc--manual-available-p))
308 (mode "Autodoc mode" ("\C-c\C-d\C-a" "\C-c\C-da") geiser-autodoc-mode
)
310 ("Compile buffer" "\C-c\C-k" geiser-compile-current-buffer
)
311 ("Switch to REPL" "\C-c\C-z" geiser-mode-switch-to-repl
)
312 ("Switch to REPL and enter module" "\C-c\C-a"
313 geiser-mode-switch-to-repl-and-enter
)
314 ("Set Scheme..." "\C-c\C-s" geiser-set-scheme
)
316 ("Edit symbol at point" "\M-." geiser-edit-symbol-at-point
317 :enable
(geiser--symbol-at-point))
318 ("Go to previous definition" "\M-," geiser-pop-symbol-stack
)
319 ("Complete symbol" ((kbd "M-TAB")) completion-at-point
320 :enable
(geiser--symbol-at-point))
321 ("Complete module name" ((kbd "M-`") (kbd "C-."))
322 geiser-completion--complete-module
)
323 ("Edit module" ("\C-c\C-e\C-m" "\C-c\C-em") geiser-edit-module
)
324 ("Add to load path..." ("\C-c\C-e\C-l" "\C-c\C-el") geiser-add-to-load-path
)
325 ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify
)
326 ("Insert λ" ("\C-c\\" "\C-c\C-\\") geiser-insert-lambda
)
328 ("Callers" ((kbd "C-c <")) geiser-xref-callers
329 :enable
(and (geiser-eval--supported-p 'callers
)
330 (geiser--symbol-at-point)))
331 ("Callees" ((kbd "C-c >")) geiser-xref-callees
332 :enable
(and (geiser-eval--supported-p 'callees
)
333 (geiser--symbol-at-point)))
335 (mode "Smart TAB mode" nil geiser-smart-tab-mode
)
337 (custom "Customize Geiser mode" geiser-mode
))
343 (make-variable-buffer-local
344 (defvar geiser-mode-string nil
345 "Modeline indicator for geiser-mode"))
347 (defun geiser-mode--lighter ()
348 (or geiser-mode-string
349 (format " %s" (or (geiser-impl--impl-str) "G"))))
351 (define-minor-mode geiser-mode
352 "Toggle Geiser's mode.
354 With no argument, this command toggles the mode.
355 Non-null prefix argument turns on the mode.
356 Null prefix argument turns off the mode.
358 When Geiser mode is enabled, a host of nice utilities for
359 interacting with the Geiser REPL is at your disposal.
362 :lighter
(:eval
(geiser-mode--lighter))
364 (when geiser-mode
(geiser-impl--set-buffer-implementation nil t
))
365 (setq geiser-autodoc-mode-string
"/A")
366 (setq geiser-smart-tab-mode-string
"/T")
367 (geiser-company--setup (and geiser-mode geiser-mode-company-p
))
368 (geiser-completion--setup geiser-mode
)
369 (when geiser-mode-autodoc-p
370 (geiser-autodoc-mode (if geiser-mode
1 -
1)))
371 (when geiser-mode-smart-tab-p
372 (geiser-smart-tab-mode (if geiser-mode
1 -
1)))
373 (geiser-syntax--add-kws)
374 (when (and geiser-mode
375 geiser-mode-start-repl-p
376 (not (geiser-syntax--font-lock-buffer-p))
377 (not (geiser-repl--connection*)))
378 (save-window-excursion (run-geiser geiser-impl--implementation
))))
380 (defun turn-on-geiser-mode ()
381 "Enable `geiser-mode' (in a Scheme buffer)."
385 (defun turn-off-geiser-mode ()
386 "Disable `geiser-mode' (in a Scheme buffer)."
390 (defun geiser-mode--maybe-activate ()
391 (when (and geiser-mode-auto-p
(eq major-mode
'scheme-mode
))
392 (turn-on-geiser-mode)))
397 (defun geiser-mode--buffers ()
399 (dolist (buffer (buffer-list))
400 (when (buffer-live-p buffer
)
403 (push (cons buffer geiser-impl--implementation
) buffers
))))
406 (defun geiser-mode--restore (buffers)
408 (when (buffer-live-p (car b
))
411 (geiser-impl--set-buffer-implementation (cdr b
)))
414 (defun geiser-mode-unload-function ()
415 (dolist (b (geiser-mode--buffers))
416 (with-current-buffer (car b
) (geiser-mode nil
))))
419 (provide 'geiser-mode
)