Commit | Line | Data |
---|---|---|
457f60fa AK |
1 | ;;; guix-backend.el --- Communication with Geiser |
2 | ||
3 | ;; Copyright © 2014 Alex Kost <alezost@gmail.com> | |
4 | ||
5 | ;; This file is part of GNU Guix. | |
6 | ||
7 | ;; GNU Guix is free software; you can redistribute it and/or modify | |
8 | ;; it under the terms of the GNU General Public License as published by | |
9 | ;; the Free Software Foundation, either version 3 of the License, or | |
10 | ;; (at your option) any later version. | |
11 | ||
12 | ;; GNU Guix is distributed in the hope that it will be useful, | |
13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;; GNU General Public License for more details. | |
16 | ||
17 | ;; You should have received a copy of the GNU General Public License | |
18 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | ;;; Commentary: | |
21 | ||
22 | ;; This file provides the code for interacting with Guile using Geiser. | |
23 | ||
24 | ;; By default (if `guix-use-guile-server' is non-nil) 2 Geiser REPLs are | |
25 | ;; started. The main one (with "guile --listen" process) is used for | |
26 | ;; "interacting" with a user - for showing a progress of | |
27 | ;; installing/deleting Guix packages. The second (internal) REPL is | |
28 | ;; used for synchronous evaluating, e.g. when information about | |
29 | ;; packages/generations should be received for a list/info buffer. | |
30 | ;; | |
31 | ;; This "2 REPLs concept" makes it possible to have a running process of | |
32 | ;; installing/deleting packages and to continue to search/list/get info | |
33 | ;; about other packages at the same time. If you prefer to use a single | |
34 | ;; Guix REPL, do not try to receive any information while there is a | |
35 | ;; running code in the REPL (see | |
36 | ;; <https://github.com/jaor/geiser/issues/28>). | |
37 | ;; | |
38 | ;; If you need to use "guix.el" in another Emacs (i.e. when there is | |
39 | ;; a runnig "guile --listen..." REPL somewhere), you can either change | |
40 | ;; `guix-default-port' in that Emacs instance or set | |
41 | ;; `guix-use-guile-server' to t. | |
42 | ;; | |
43 | ;; Guix REPLs (unlike the usual Geiser REPLs) are not added to | |
44 | ;; `geiser-repl--repls' variable, and thus cannot be used for evaluating | |
45 | ;; while editing scm-files. The only purpose of Guix REPLs is to be an | |
46 | ;; intermediate between "Guix/Guile level" and "Emacs interface level". | |
47 | ;; That being said you can still want to use a Guix REPL while hacking | |
48 | ;; auxiliary scheme-files for "guix.el". You can just use "M-x | |
49 | ;; connect-to-guile" (connect to "localhost" and `guix-default-port') to | |
50 | ;; have a usual Geiser REPL with all stuff defined by "guix.el" package. | |
51 | ||
52 | ;;; Code: | |
53 | ||
54 | (require 'geiser-mode) | |
55 | ||
56 | (defvar guix-load-path | |
57 | (file-name-directory (or load-file-name | |
58 | (locate-library "guix"))) | |
59 | "Directory with scheme files for \"guix.el\" package.") | |
60 | ||
61 | (defvar guix-helper-file | |
62 | (expand-file-name "guix-helper.scm" guix-load-path) | |
63 | "Auxiliary scheme file for loading.") | |
64 | ||
65 | (defvar guix-guile-program (or geiser-guile-binary "guile") | |
66 | "Name of the guile executable used for Guix REPL. | |
67 | May be either a string (the name of the executable) or a list of | |
68 | strings of the form: | |
69 | ||
70 | (NAME . ARGS) | |
71 | ||
72 | Where ARGS is a list of arguments to the guile program.") | |
73 | ||
74 | \f | |
75 | ;;; REPL | |
76 | ||
77 | (defgroup guix-repl nil | |
78 | "Settings for Guix REPLs." | |
79 | :prefix "guix-repl-" | |
80 | :group 'guix) | |
81 | ||
82 | (defcustom guix-repl-startup-time 30000 | |
83 | "Time, in milliseconds, to wait for Guix REPL to startup. | |
84 | Same as `geiser-repl-startup-time' but is used for Guix REPL. | |
85 | If you have a slow system, try to increase this time." | |
86 | :type 'integer | |
87 | :group 'guix-repl) | |
88 | ||
89 | (defcustom guix-repl-buffer-name "*Guix REPL*" | |
90 | "Default name of a Geiser REPL buffer used for Guix." | |
91 | :type 'string | |
92 | :group 'guix-repl) | |
93 | ||
94 | (defcustom guix-after-start-repl-hook () | |
95 | "Hook called after Guix REPL is started." | |
96 | :type 'hook | |
97 | :group 'guix-repl) | |
98 | ||
99 | (defcustom guix-use-guile-server t | |
100 | "If non-nil, start guile with '--listen' argument. | |
101 | This allows to receive information about packages using an additional | |
102 | REPL while some packages are being installed/removed in the main REPL." | |
103 | :type 'boolean | |
104 | :group 'guix-repl) | |
105 | ||
106 | (defcustom guix-default-port 37246 | |
107 | "Default port used if `guix-use-guile-server' is non-nil." | |
108 | :type 'integer | |
109 | :group 'guix-repl) | |
110 | ||
111 | (defvar guix-repl-buffer nil | |
112 | "Main Geiser REPL buffer used for communicating with Guix. | |
113 | This REPL is used for processing package actions and for | |
114 | receiving information if `guix-use-guile-server' is nil.") | |
115 | ||
116 | (defvar guix-internal-repl-buffer nil | |
117 | "Additional Geiser REPL buffer used for communicating with Guix. | |
118 | This REPL is used for receiving information only if | |
119 | `guix-use-guile-server' is non-nil.") | |
120 | ||
121 | (defvar guix-internal-repl-buffer-name "*Guix Internal REPL*" | |
122 | "Default name of an internal Guix REPL buffer.") | |
123 | ||
063b60be AK |
124 | (defvar guix-before-repl-operation-hook nil |
125 | "Hook run before executing an operation in Guix REPL.") | |
126 | ||
127 | (defvar guix-after-repl-operation-hook | |
128 | '(guix-repl-operation-success-message) | |
129 | "Hook run after executing successful operation in Guix REPL.") | |
130 | ||
131 | (defvar guix-repl-operation-p nil | |
132 | "Non-nil, if current operation is performed by `guix-eval-in-repl'. | |
133 | This internal variable is used to distinguish Guix operations | |
134 | from operations performed in Guix REPL by a user.") | |
135 | ||
ce2e4e39 AK |
136 | (defvar guix-repl-operation-type nil |
137 | "Type of the current operation performed by `guix-eval-in-repl'. | |
138 | This internal variable is used to define what actions should be | |
139 | executed after the current operation succeeds. | |
140 | See `guix-eval-in-repl' for details.") | |
141 | ||
063b60be AK |
142 | (defun guix-repl-operation-success-message () |
143 | "Message telling about successful Guix operation." | |
144 | (message "Guix operation has been performed.")) | |
145 | ||
457f60fa AK |
146 | (defun guix-get-guile-program (&optional internal) |
147 | "Return a value suitable for `geiser-guile-binary'." | |
148 | (if (or internal | |
149 | (not guix-use-guile-server)) | |
150 | guix-guile-program | |
151 | (append (if (listp guix-guile-program) | |
152 | guix-guile-program | |
153 | (list guix-guile-program)) | |
154 | ;; Guile understands "--listen=..." but not "--listen ..." | |
155 | (list (concat "--listen=" | |
156 | (number-to-string guix-default-port)))))) | |
157 | ||
158 | (defun guix-start-process-maybe () | |
159 | "Start Geiser REPL configured for Guix if needed." | |
160 | (guix-start-repl-maybe) | |
161 | (if guix-use-guile-server | |
162 | (guix-start-repl-maybe 'internal) | |
163 | (setq guix-internal-repl-buffer guix-repl-buffer))) | |
164 | ||
165 | (defun guix-start-repl-maybe (&optional internal) | |
166 | "Start Guix REPL if needed. | |
167 | If INTERNAL is non-nil, start an internal REPL." | |
168 | (let* ((repl-var (guix-get-repl-buffer-variable internal)) | |
169 | (repl (symbol-value repl-var))) | |
170 | (unless (and (buffer-live-p repl) | |
171 | (get-buffer-process repl)) | |
172 | ;; Kill REPL buffer with a dead process | |
173 | (and (buffer-live-p repl) (kill-buffer repl)) | |
174 | (or internal | |
175 | (message "Starting Geiser REPL for Guix ...")) | |
176 | (let ((geiser-guile-binary (guix-get-guile-program internal)) | |
177 | (geiser-guile-init-file (or internal guix-helper-file)) | |
178 | (repl (get-buffer-create | |
179 | (guix-get-repl-buffer-name internal)))) | |
180 | (condition-case err | |
181 | (guix-start-repl repl | |
182 | (and internal | |
183 | (geiser-repl--read-address | |
184 | "localhost" guix-default-port))) | |
185 | (text-read-only | |
186 | (error (concat "Couldn't start Guix REPL. Perhaps the port %s is busy.\n" | |
187 | "See buffer '%s' for details") | |
188 | guix-default-port (buffer-name repl)))) | |
189 | (set repl-var repl) | |
190 | (unless internal | |
191 | (message "Guix REPL has been started.") | |
192 | (run-hooks 'guix-after-start-repl-hook)))))) | |
193 | ||
194 | (defun guix-start-repl (buffer &optional address) | |
195 | "Start Guix REPL in BUFFER. | |
196 | If ADDRESS is non-nil, connect to a remote guile process using | |
197 | this address (it should be defined by | |
198 | `geiser-repl--read-address')." | |
199 | ;; A mix of the code from `geiser-repl--start-repl' and | |
200 | ;; `geiser-repl--to-repl-buffer'. | |
201 | (let ((impl 'guile) | |
202 | (geiser-guile-load-path (list guix-load-path)) | |
203 | (geiser-repl-startup-time guix-repl-startup-time)) | |
204 | (with-current-buffer buffer | |
205 | (geiser-repl-mode) | |
206 | (geiser-impl--set-buffer-implementation impl) | |
207 | (geiser-repl--autodoc-mode -1) | |
208 | (goto-char (point-max)) | |
063b60be AK |
209 | (let ((prompt (geiser-con--combined-prompt |
210 | geiser-guile--prompt-regexp | |
211 | geiser-guile--debugger-prompt-regexp))) | |
457f60fa AK |
212 | (geiser-repl--save-remote-data address) |
213 | (geiser-repl--start-scheme impl address prompt) | |
214 | (geiser-repl--quit-setup) | |
215 | (geiser-repl--history-setup) | |
216 | (setq-local geiser-repl--repls (list buffer)) | |
217 | (geiser-repl--set-this-buffer-repl buffer) | |
218 | (setq geiser-repl--connection | |
219 | (geiser-con--make-connection | |
220 | (get-buffer-process (current-buffer)) | |
063b60be AK |
221 | geiser-guile--prompt-regexp |
222 | geiser-guile--debugger-prompt-regexp)) | |
457f60fa AK |
223 | (geiser-repl--startup impl address) |
224 | (geiser-repl--autodoc-mode 1) | |
225 | (geiser-company--setup geiser-repl-company-p) | |
226 | (add-hook 'comint-output-filter-functions | |
063b60be | 227 | 'guix-repl-output-filter |
457f60fa AK |
228 | nil t) |
229 | (set-process-query-on-exit-flag | |
230 | (get-buffer-process (current-buffer)) | |
231 | geiser-repl-query-on-kill-p))))) | |
232 | ||
063b60be AK |
233 | (defun guix-repl-output-filter (str) |
234 | "Filter function suitable for `comint-output-filter-functions'. | |
235 | This is a replacement for `geiser-repl--output-filter'." | |
236 | (cond | |
237 | ((string-match-p geiser-guile--prompt-regexp str) | |
238 | (geiser-autodoc--disinhibit-autodoc) | |
239 | (when guix-repl-operation-p | |
240 | (setq guix-repl-operation-p nil) | |
ce2e4e39 AK |
241 | (run-hooks 'guix-after-repl-operation-hook) |
242 | ;; Run hooks specific to the current operation type. | |
243 | (when guix-repl-operation-type | |
244 | (let ((type-hook (intern | |
245 | (concat "guix-after-" | |
246 | (symbol-name guix-repl-operation-type) | |
247 | "-hook")))) | |
248 | (setq guix-repl-operation-type nil) | |
249 | (and (boundp type-hook) | |
250 | (run-hooks type-hook)))))) | |
063b60be | 251 | ((string-match geiser-guile--debugger-prompt-regexp str) |
49d758d2 | 252 | (setq guix-repl-operation-p nil) |
063b60be AK |
253 | (geiser-con--connection-set-debugging geiser-repl--connection |
254 | (match-beginning 0)) | |
255 | (geiser-autodoc--disinhibit-autodoc)))) | |
256 | ||
457f60fa AK |
257 | (defun guix-get-repl-buffer (&optional internal) |
258 | "Return Guix REPL buffer; start REPL if needed. | |
259 | If INTERNAL is non-nil, return an additional internal REPL." | |
260 | (guix-start-process-maybe) | |
261 | (let ((repl (symbol-value (guix-get-repl-buffer-variable internal)))) | |
262 | ;; If a new Geiser REPL is started, `geiser-repl--repl' variable may | |
263 | ;; be set to the new value in a Guix REPL, so set it back to a | |
264 | ;; proper value here. | |
265 | (with-current-buffer repl | |
266 | (geiser-repl--set-this-buffer-repl repl)) | |
267 | repl)) | |
268 | ||
269 | (defun guix-get-repl-buffer-variable (&optional internal) | |
270 | "Return the name of a variable with a REPL buffer." | |
271 | (if internal | |
272 | 'guix-internal-repl-buffer | |
273 | 'guix-repl-buffer)) | |
274 | ||
275 | (defun guix-get-repl-buffer-name (&optional internal) | |
276 | "Return the name of a REPL buffer." | |
277 | (if internal | |
278 | guix-internal-repl-buffer-name | |
279 | guix-repl-buffer-name)) | |
280 | ||
281 | (defun guix-switch-to-repl (&optional internal) | |
282 | "Switch to Guix REPL. | |
283 | If INTERNAL is non-nil (interactively with prefix), switch to the | |
284 | additional internal REPL if it exists." | |
285 | (interactive "P") | |
286 | (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal))) | |
287 | ||
288 | \f | |
289 | ;;; Evaluating expressions | |
290 | ||
49d758d2 AK |
291 | (defvar guix-operation-buffer nil |
292 | "Buffer from which the latest Guix operation was performed.") | |
293 | ||
457f60fa AK |
294 | (defun guix-make-guile-expression (fun &rest args) |
295 | "Return string containing a guile expression for calling FUN with ARGS." | |
296 | (format "(%S %s)" fun | |
297 | (mapconcat | |
298 | (lambda (arg) | |
299 | (cond | |
300 | ((null arg) "'()") | |
301 | ((or (eq arg t) | |
302 | ;; An ugly hack to separate 'false' from nil | |
303 | (equal arg 'f) | |
304 | (keywordp arg)) | |
305 | (concat "#" (prin1-to-string arg t))) | |
306 | ((or (symbolp arg) (listp arg)) | |
307 | (concat "'" (prin1-to-string arg))) | |
308 | (t (prin1-to-string arg)))) | |
309 | args | |
310 | " "))) | |
311 | ||
312 | (defun guix-eval (str &optional wrap) | |
313 | "Evaluate guile expression STR. | |
314 | If WRAP is non-nil, wrap STR into (begin ...) form. | |
315 | Return a list of strings with result values of evaluation." | |
316 | (with-current-buffer (guix-get-repl-buffer 'internal) | |
317 | (let* ((wrapped (if wrap (geiser-debug--wrap-region str) str)) | |
318 | (code `(:eval (:scm ,wrapped))) | |
319 | (ret (geiser-eval--send/wait code))) | |
320 | (if (geiser-eval--retort-error ret) | |
321 | (error "Error in evaluating guile expression: %s" | |
322 | (geiser-eval--retort-output ret)) | |
323 | (cdr (assq 'result ret)))))) | |
324 | ||
325 | (defun guix-eval-read (str &optional wrap) | |
326 | "Evaluate guile expression STR. | |
327 | For the meaning of WRAP, see `guix-eval'. | |
328 | Return elisp expression of the first result value of evaluation." | |
329 | ;; Parsing scheme code with elisp `read' is probably not the best idea. | |
330 | (read (replace-regexp-in-string | |
331 | "#f\\|#<unspecified>" "nil" | |
332 | (replace-regexp-in-string | |
333 | "#t" "t" (car (guix-eval str wrap)))))) | |
334 | ||
ce2e4e39 | 335 | (defun guix-eval-in-repl (str &optional operation-buffer operation-type) |
49d758d2 AK |
336 | "Switch to Guix REPL and evaluate STR with guile expression there. |
337 | If OPERATION-BUFFER is non-nil, it should be a buffer from which | |
ce2e4e39 AK |
338 | the current operation was performed. |
339 | ||
340 | If OPERATION-TYPE is non-nil, it should be a symbol. After | |
341 | successful executing of the current operation, | |
342 | `guix-after-OPERATION-TYPE-hook' is called." | |
063b60be | 343 | (run-hooks 'guix-before-repl-operation-hook) |
49d758d2 | 344 | (setq guix-repl-operation-p t |
ce2e4e39 | 345 | guix-repl-operation-type operation-type |
49d758d2 | 346 | guix-operation-buffer operation-buffer) |
457f60fa AK |
347 | (let ((repl (guix-get-repl-buffer))) |
348 | (with-current-buffer repl | |
349 | (delete-region (geiser-repl--last-prompt-end) (point-max)) | |
350 | (goto-char (point-max)) | |
351 | (insert str) | |
352 | (geiser-repl--send-input)) | |
353 | (geiser-repl--switch-to-buffer repl))) | |
354 | ||
355 | (provide 'guix-backend) | |
356 | ||
357 | ;;; guix-backend.el ends here |