summaryrefslogtreecommitdiff
path: root/elisp/geiser-repl.el
blob: 85b7ee8df6a43cd49c0cab05536e4e51923a0a5e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
;;; geiser-repl.el --- Geiser's REPL

;; Copyright (C) 2009  Jose Antonio Ortega Ruiz

;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Keywords: languages, tools

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Major mode (comint-based) to interact with a Scheme REPL.

;;; Code:

(require 'geiser-autodoc)
(require 'geiser-edit)
(require 'geiser-impl)
(require 'geiser-eval)
(require 'geiser-connection)
(require 'geiser-custom)
(require 'geiser-base)

(require 'comint)


;;; Customization:

(defgroup geiser-repl nil
  "Interacting with the Geiser REPL."
  :group 'geiser)

(defcustom geiser-repl-use-other-window t
  "Whether to Use a window other than the current buffer's when
switching to the Geiser REPL buffer."
  :type 'boolean
  :group 'geiser-repl)

(defcustom geiser-repl-window-allow-split t
  "Whether to allow window splitting when switching to the Geiser
REPL buffer."
  :type 'boolean
  :group 'geiser-repl)

(defcustom geiser-repl-history-filename (expand-file-name "~/.geiser_history")
  "File where REPL input history is saved, so that it persists between sessions.
This is actually the base name: the concrete Scheme
implementation name gets appended to it."
  :type 'filename
  :group 'geiser-repl)

(defcustom geiser-repl-history-size comint-input-ring-size
  "Maximum size of the saved REPL input history."
  :type 'integer
  :group 'geiser-repl)

(defcustom geiser-repl-autodoc-p t
  "Whether to enable `geiser-autodoc-mode' in the REPL by default."
  :type 'boolean
  :group 'geiser-repl)


;;; Geiser REPL buffers and processes:

(defvar geiser-repl--repls nil)
(defvar geiser-repl--closed-repls nil)

(make-variable-buffer-local
 (defvar geiser-repl--repl nil))

(defsubst geiser-repl--this-buffer-repl ()
  geiser-repl--repl)

(defsubst geiser-repl--set-this-buffer-repl (r)
  (setq geiser-repl--repl r))

(defun geiser-repl--repl/impl (impl &optional repls)
  (catch 'repl
    (dolist (repl (or repls geiser-repl--repls))
      (with-current-buffer repl
        (when (eq geiser-impl--implementation impl)
          (throw 'repl repl))))))

(defun geiser-repl--get-repl (&optional impl)
  (or (and (not impl) geiser-repl--repl)
      (setq geiser-repl--repl
            (let ((impl (or impl
                            geiser-impl--implementation
                            (geiser-impl--guess))))
              (when impl (geiser-repl--repl/impl impl))))))

(defun geiser-repl--active-impls ()
  (let ((act))
    (dolist (repl geiser-repl--repls act)
      (with-current-buffer repl
        (add-to-list 'act geiser-impl--implementation)))))

(defsubst geiser-repl--repl-name (impl)
  (format "%s REPL" (geiser-impl--impl-str impl)))

(defun geiser-repl--to-repl-buffer (impl)
  (unless (and (eq major-mode 'geiser-repl-mode)
               (not (get-buffer-process (current-buffer))))
    (let* ((old (geiser-repl--repl/impl impl geiser-repl--closed-repls))
           (old (and (buffer-live-p old) old)))
      (pop-to-buffer
       (or old
           (generate-new-buffer (format "* %s *"
                                        (geiser-repl--repl-name impl)))))))
  (geiser-repl-mode)
  (geiser-impl--set-buffer-implementation impl))

(defun geiser-repl--start-repl (impl)
  (message "Starting Geiser REPL for %s ..." impl)
  (geiser-repl--to-repl-buffer impl)
  (let ((binary (geiser-impl--binary impl))
        (args (geiser-impl--parameters impl))
        (prompt-rx (geiser-impl--prompt-regexp impl))
        (cname (geiser-repl--repl-name impl)))
    (unless (and binary prompt-rx)
      (error "Sorry, I don't know how to start a REPL for %s" impl))
    (set (make-local-variable 'comint-prompt-regexp) prompt-rx)
    (apply 'make-comint-in-buffer `(,cname ,(current-buffer) ,binary nil ,@args))
    (geiser-repl--wait-for-prompt 10000)
    (geiser-repl--history-setup)
    (geiser-con--setup-connection (current-buffer) prompt-rx)
    (add-to-list 'geiser-repl--repls (current-buffer))
    (geiser-impl--startup impl)
    (geiser-repl--set-this-buffer-repl (current-buffer))))

(defun geiser-repl--process ()
  (let ((buffer (geiser-repl--get-repl geiser-impl--implementation)))
    (or (and (buffer-live-p buffer) (get-buffer-process buffer))
        (error "No Geiser REPL for this buffer (try M-x run-geiser)"))))

(setq geiser-eval--default-proc-function 'geiser-repl--process)

(defun geiser-repl--wait-for-prompt (timeout)
  (let ((p (point)) (seen))
    (while (and (not seen) (> timeout 0))
      (sleep-for 0.1)
      (setq timeout (- timeout 100))
      (goto-char p)
      (setq seen (re-search-forward comint-prompt-regexp nil t)))
    (goto-char (point-max))
    (unless seen (error "No prompt found!"))))


;;; Interface: starting and interacting with geiser REPL:

(defun geiser-repl--read-impl (prompt &optional active)
  (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls))))

(defsubst geiser-repl--only-impl-p ()
  (and (null (cdr geiser-impl--impls))
       (car geiser-impl--impls)))

(defun run-geiser (impl)
  "Start a new Geiser REPL."
  (interactive
   (list (or (geiser-repl--only-impl-p)
             (geiser-repl--read-impl "Start Geiser for scheme implementation: "))))
   (geiser-repl--start-repl impl))

(defun switch-to-geiser (&optional ask impl)
  "Switch to running Geiser REPL.
With prefix argument, ask for which one if more than one is running.
If no REPL is running, execute `run-geiser' to start a fresh one."
  (interactive "P")
  (let* ((repl (cond ((and (not ask) (not impl)
                           (or (geiser-repl--this-buffer-repl)
                               (car geiser-repl--repls))))
                     ((and (not ask) impl (geiser-repl--repl/impl impl)))
                     ((= 1 (length geiser-repl--repls)) (car geiser-repl--repls))))
         (impl (or impl (and (not repl)
                             (or (and (not ask)
                                      (geiser-repl--only-impl-p))
                                 (geiser-repl--read-impl "Switch to scheme REPL: ")))))
         (pop-up-windows geiser-repl-window-allow-split))
    (if repl (pop-to-buffer repl) (run-geiser impl))))

(defalias 'geiser 'switch-to-geiser)

(defun geiser-repl-nuke ()
  "Try this command if the REPL becomes unresponsive."
  (interactive)
  (goto-char (point-max))
  (comint-kill-region comint-last-input-start (point))
  (comint-redirect-cleanup)
  (geiser-con--setup-connection (current-buffer)
                                comint-prompt-regexp))


;;; REPL history and clean-up:

(defsubst geiser-repl--history-file ()
  (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation))

(defun geiser-repl--on-quit ()
  (comint-write-input-ring)
  (let ((cb (current-buffer))
        (impl geiser-impl--implementation))
    (setq geiser-repl--repls (remove cb geiser-repl--repls))
    (dolist (buffer (buffer-list))
      (with-current-buffer buffer
        (when (and (eq geiser-impl--implementation impl)
                   (equal cb (geiser-repl--this-buffer-repl)))
          (geiser-repl--get-repl geiser-impl--implementation))))))

(defun geiser-repl--sentinel (proc event)
  (when (string= event "finished\n")
    (with-current-buffer (process-buffer proc)
      (let ((comint-prompt-read-only nil)
            (comint-input-ring-file-name (geiser-repl--history-file)))
        (geiser-repl--on-quit)
        (push (current-buffer) geiser-repl--closed-repls)
        (when (buffer-name (current-buffer))
          (insert "\nIt's been nice interacting with you!\n")
          (insert "Press C-cz to bring me back.\n" ))))))

(defun geiser-repl--on-kill ()
  (geiser-repl--on-quit)
  (setq geiser-repl--closed-repls
        (remove (current-buffer) geiser-repl--closed-repls)))

(defun geiser-repl--input-filter (str)
  (and (not (string-match "^\\s *$" str))
       (not (string-match "^,quit *$" str))))

(defun geiser-repl--history-setup ()
  (set (make-local-variable 'comint-input-ring-file-name)
       (geiser-repl--history-file))
  (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size)
  (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter)
  (add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t)
  (comint-read-input-ring t)
  (set-process-sentinel (get-buffer-process (current-buffer)) 'geiser-repl--sentinel))


;;; geiser-repl mode:

(defun geiser-repl--bol ()
  (interactive)
  (when (= (point) (comint-bol)) (beginning-of-line)))

(defun geiser-repl--beginning-of-defun ()
  (let ((p (point)))
    (comint-bol)
    (when (not (eq (char-after (point)) ?\())
      (skip-syntax-forward "^(" p))))

(defun geiser-repl--module-function (&optional ignore) :f)

(defun geiser-repl--doc-module ()
  (interactive)
  (let ((geiser-eval--get-module-function
         (geiser-impl--module-function geiser-impl--implementation)))
    (geiser-doc-module)))

(define-derived-mode geiser-repl-mode comint-mode "Geiser REPL"
  "Major mode for interacting with an inferior scheme repl process.
\\{geiser-repl-mode-map}"
  (set (make-local-variable 'mode-line-process) nil)
  (set (make-local-variable 'comint-use-prompt-regexp) t)
  (set (make-local-variable 'comint-prompt-read-only) t)
  (set (make-local-variable 'beginning-of-defun-function)
       'geiser-repl--beginning-of-defun)
  (set-syntax-table scheme-mode-syntax-table)
  (setq geiser-eval--get-module-function 'geiser-repl--module-function)
  (when geiser-repl-autodoc-p (geiser-autodoc-mode 1)))

(define-key geiser-repl-mode-map "\C-cz" 'run-geiser)
(define-key geiser-repl-mode-map "\C-c\C-z" 'run-geiser)
(define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol)
(define-key geiser-repl-mode-map "\C-ca" 'geiser-autodoc-mode)
(define-key geiser-repl-mode-map "\C-cd" 'geiser-doc-symbol-at-point)
(define-key geiser-repl-mode-map "\C-cm" 'geiser-repl--doc-module)
(define-key geiser-repl-mode-map "\C-ck" 'geiser-compile-file)
(define-key geiser-repl-mode-map "\C-cl" 'geiser-load-file)

(define-key geiser-repl-mode-map "\M-p" 'comint-previous-matching-input-from-input)
(define-key geiser-repl-mode-map "\M-n" 'comint-next-matching-input-from-input)
(define-key geiser-repl-mode-map "\C-c\M-p" 'comint-previous-input)
(define-key geiser-repl-mode-map "\C-c\M-n" 'comint-next-input)

(define-key geiser-repl-mode-map (kbd "TAB") 'geiser-completion--complete-symbol)
(define-key geiser-repl-mode-map (kbd "M-TAB") 'geiser-completion--complete-symbol)
(define-key geiser-repl-mode-map (kbd "M-`") 'geiser-completion--complete-module)
(define-key geiser-repl-mode-map (kbd "C-.") 'geiser-completion--complete-module)
(define-key geiser-repl-mode-map "\M-." 'geiser-edit-symbol-at-point)
(define-key geiser-repl-mode-map "\M-," 'geiser-edit-pop-edit-symbol-stack)


;;; Unload:

(defun geiser-repl--repl-list ()
  (let (lst)
    (dolist (repl geiser-repl--repls lst)
      (when (buffer-live-p repl)
        (with-current-buffer repl
          (push geiser-impl--implementation lst))))))

(defun geiser-repl--restore (impls)
  (dolist (impl impls)
    (when impl (geiser impl))))

(defun geiser-repl-unload-function ()
  (dolist (repl geiser-repl--repls)
    (when (buffer-live-p repl)
      (kill-buffer repl))))


(provide 'geiser-repl)
;;; geiser-repl.el ends here