1 ;;; guix-backend.el --- Making and using Guix REPL
3 ;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
5 ;; This file is part of GNU Guix.
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.
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.
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/>.
22 ;; This file provides the code for interacting with Guile using Guix REPL
23 ;; (Geiser REPL with some guix-specific additions).
25 ;; By default (if `guix-use-guile-server' is non-nil) 2 Guix REPLs are
26 ;; started. The main one (with "guile --listen" process) is used for
27 ;; "interacting" with a user - for showing a progress of
28 ;; installing/deleting Guix packages. The second (internal) REPL is
29 ;; used for synchronous evaluating, e.g. when information about
30 ;; packages/generations should be received for a list/info buffer.
32 ;; This "2 REPLs concept" makes it possible to have a running process of
33 ;; installing/deleting packages and to continue to search/list/get info
34 ;; about other packages at the same time. If you prefer to use a single
35 ;; Guix REPL, do not try to receive any information while there is a
36 ;; running code in the REPL (see
37 ;; <https://github.com/jaor/geiser/issues/28>).
39 ;; Guix REPLs (unlike the usual Geiser REPLs) are not added to
40 ;; `geiser-repl--repls' variable, and thus cannot be used for evaluating
41 ;; while editing scm-files. The only purpose of Guix REPLs is to be an
42 ;; intermediate between "Guix/Guile level" and "Emacs interface level".
43 ;; That being said you can still want to use a Guix REPL while hacking
44 ;; auxiliary scheme-files for "guix.el". You can just use
45 ;; `geiser-connect-local' command with `guix-repl-current-socket' to
46 ;; have a usual Geiser REPL with all stuff defined by "guix.el" package.
50 (require 'geiser-mode
)
51 (require 'geiser-guile
)
52 (require 'guix-geiser
)
53 (require 'guix-config
)
54 (require 'guix-external
)
56 (require 'guix-profiles
)
58 (defvar guix-load-path guix-config-emacs-interface-directory
59 "Directory with scheme files for \"guix.el\" package.")
61 (defvar guix-helper-file
62 (expand-file-name "guix-helper.scm" guix-load-path
)
63 "Auxiliary scheme file for loading.")
68 (defgroup guix-repl nil
69 "Settings for Guix REPLs."
73 (defcustom guix-repl-startup-time
30000
74 "Time, in milliseconds, to wait for Guix REPL to startup.
75 Same as `geiser-repl-startup-time' but is used for Guix REPL.
76 If you have a slow system, try to increase this time."
80 (defcustom guix-repl-buffer-name
"*Guix REPL*"
81 "Default name of a Geiser REPL buffer used for Guix."
85 (defcustom guix-after-start-repl-hook
'(guix-set-directory)
86 "Hook called after Guix REPL is started."
90 (defcustom guix-use-guile-server t
91 "If non-nil, start guile with '--listen' argument.
92 This allows to receive information about packages using an additional
93 REPL while some packages are being installed/removed in the main REPL."
97 (defcustom guix-repl-socket-file-name-function
98 #'guix-repl-socket-file-name
99 "Function used to define a socket file name used by Guix REPL.
100 The function is called without arguments."
101 :type
'(choice (function-item guix-repl-socket-file-name
)
102 (function :tag
"Other function"))
105 (defcustom guix-emacs-activate-after-operation t
106 "Activate Emacs packages after installing.
107 If nil, do not load autoloads of the Emacs packages after
108 they are successfully installed."
112 (defvar guix-repl-current-socket nil
113 "Name of a socket file used by the current Guix REPL.")
115 (defvar guix-repl-buffer nil
116 "Main Geiser REPL buffer used for communicating with Guix.
117 This REPL is used for processing package actions and for
118 receiving information if `guix-use-guile-server' is nil.")
120 (defvar guix-internal-repl-buffer nil
121 "Additional Geiser REPL buffer used for communicating with Guix.
122 This REPL is used for receiving information only if
123 `guix-use-guile-server' is non-nil.")
125 (defvar guix-internal-repl-buffer-name
"*Guix Internal REPL*"
126 "Default name of an internal Guix REPL buffer.")
128 (defvar guix-before-repl-operation-hook nil
129 "Hook run before executing an operation in Guix REPL.")
131 (defvar guix-after-repl-operation-hook
132 '(guix-repl-autoload-emacs-packages-maybe
133 guix-repl-operation-success-message
)
134 "Hook run after executing successful operation in Guix REPL.")
136 (defvar guix-repl-operation-p nil
137 "Non-nil, if current operation is performed by `guix-eval-in-repl'.
138 This internal variable is used to distinguish Guix operations
139 from operations performed in Guix REPL by a user.")
141 (defvar guix-repl-operation-type nil
142 "Type of the current operation performed by `guix-eval-in-repl'.
143 This internal variable is used to define what actions should be
144 executed after the current operation succeeds.
145 See `guix-eval-in-repl' for details.")
147 (defun guix-repl-autoload-emacs-packages-maybe ()
148 "Load autoloads for Emacs packages if needed.
149 See `guix-emacs-activate-after-operation' for details."
150 (and guix-emacs-activate-after-operation
151 ;; FIXME Since a user can work with a non-current profile (using
152 ;; C-u before `guix-search-by-name' and other commands), emacs
153 ;; packages can be installed to another profile, and the
154 ;; following code will not work (i.e., the autoloads for this
155 ;; profile will not be loaded).
156 (guix-emacs-autoload-packages guix-current-profile
)))
158 (defun guix-repl-operation-success-message ()
159 "Message telling about successful Guix operation."
160 (message "Guix operation has been performed."))
162 (defun guix-get-guile-program (&optional socket
)
163 "Return a value suitable for `geiser-guile-binary'."
166 (append (if (listp guix-guile-program
)
168 (list guix-guile-program
))
169 (list (concat "--listen=" socket
)))))
171 (defun guix-repl-socket-file-name ()
172 "Return a name of a socket file used by Guix REPL."
174 (concat (file-name-as-directory temporary-file-directory
)
177 (defun guix-repl-delete-socket-maybe ()
178 "Delete `guix-repl-current-socket' file if it exists."
179 (and guix-repl-current-socket
180 (file-exists-p guix-repl-current-socket
)
181 (delete-file guix-repl-current-socket
)))
183 (add-hook 'kill-emacs-hook
'guix-repl-delete-socket-maybe
)
185 (defun guix-start-process-maybe (&optional start-msg end-msg
)
186 "Start Geiser REPL configured for Guix if needed.
187 START-MSG and END-MSG are strings displayed in the minibuffer in
188 the beginning and in the end of the starting process. If nil,
189 display default messages."
190 (guix-start-repl-maybe nil
191 (or start-msg
"Starting Guix REPL ...")
192 (or end-msg
"Guix REPL has been started."))
193 (if guix-use-guile-server
194 (guix-start-repl-maybe 'internal
)
195 (setq guix-internal-repl-buffer guix-repl-buffer
)))
197 (defun guix-start-repl-maybe (&optional internal start-msg end-msg
)
198 "Start Guix REPL if needed.
199 If INTERNAL is non-nil, start an internal REPL.
201 START-MSG and END-MSG are strings displayed in the minibuffer in
202 the beginning and in the end of the process. If nil, do not
204 (let* ((repl-var (guix-get-repl-buffer-variable internal
))
205 (repl (symbol-value repl-var
)))
206 (unless (and (buffer-live-p repl
)
207 (get-buffer-process repl
))
208 (and start-msg
(message start-msg
))
209 (setq guix-repl-operation-p nil
)
211 ;; Guile leaves socket file after exit, so remove it if it
212 ;; exists (after the REPL restart).
213 (guix-repl-delete-socket-maybe)
214 (setq guix-repl-current-socket
215 (and guix-use-guile-server
216 (or guix-repl-current-socket
217 (funcall guix-repl-socket-file-name-function
)))))
218 (let ((geiser-guile-binary (guix-get-guile-program
220 guix-repl-current-socket
)))
221 (geiser-guile-init-file (unless internal guix-helper-file
))
222 (repl (get-buffer-create
223 (guix-get-repl-buffer-name internal
))))
224 (guix-start-repl repl
(and internal guix-repl-current-socket
))
226 (and end-msg
(message end-msg
))
228 (run-hooks 'guix-after-start-repl-hook
))))))
230 (defun guix-start-repl (buffer &optional address
)
231 "Start Guix REPL in BUFFER.
232 If ADDRESS is non-nil, connect to a remote guile process using
233 this address (it should be defined by
234 `geiser-repl--read-address')."
235 ;; A mix of the code from `geiser-repl--start-repl' and
236 ;; `geiser-repl--to-repl-buffer'.
238 (geiser-guile-load-path (cons (expand-file-name guix-load-path
)
239 geiser-guile-load-path
))
240 (geiser-repl-startup-time guix-repl-startup-time
))
241 (with-current-buffer buffer
243 (geiser-impl--set-buffer-implementation impl
)
244 (geiser-repl--autodoc-mode -
1)
245 (goto-char (point-max))
246 (let ((prompt (geiser-con--combined-prompt
247 geiser-guile--prompt-regexp
248 geiser-guile--debugger-prompt-regexp
)))
249 (geiser-repl--save-remote-data address
)
250 (geiser-repl--start-scheme impl address prompt
)
251 (geiser-repl--quit-setup)
252 (geiser-repl--history-setup)
253 (setq-local geiser-repl--repls
(list buffer
))
254 (geiser-repl--set-this-buffer-repl buffer
)
255 (setq geiser-repl--connection
256 (geiser-con--make-connection
257 (get-buffer-process (current-buffer))
258 geiser-guile--prompt-regexp
259 geiser-guile--debugger-prompt-regexp
))
260 (geiser-repl--startup impl address
)
261 (geiser-repl--autodoc-mode 1)
262 (geiser-company--setup geiser-repl-company-p
)
263 (add-hook 'comint-output-filter-functions
264 'guix-repl-output-filter
266 (set-process-query-on-exit-flag
267 (get-buffer-process (current-buffer))
268 geiser-repl-query-on-kill-p
)))))
270 (defun guix-repl-output-filter (str)
271 "Filter function suitable for `comint-output-filter-functions'.
272 This is a replacement for `geiser-repl--output-filter'."
274 ((string-match-p geiser-guile--prompt-regexp str
)
275 (geiser-autodoc--disinhibit-autodoc)
276 (when guix-repl-operation-p
277 (setq guix-repl-operation-p nil
)
278 (run-hooks 'guix-after-repl-operation-hook
)
279 ;; Run hooks specific to the current operation type.
280 (when guix-repl-operation-type
281 (let ((type-hook (intern
282 (concat "guix-after-"
283 (symbol-name guix-repl-operation-type
)
285 (setq guix-repl-operation-type nil
)
286 (and (boundp type-hook
)
287 (run-hooks type-hook
))))))
288 ((string-match geiser-guile--debugger-prompt-regexp str
)
289 (setq guix-repl-operation-p nil
)
290 (geiser-con--connection-set-debugging geiser-repl--connection
292 (geiser-autodoc--disinhibit-autodoc))))
294 (defun guix-repl-exit (&optional internal no-wait
)
295 "Exit the current Guix REPL.
296 If INTERNAL is non-nil, exit the internal REPL.
297 If NO-WAIT is non-nil, do not wait for the REPL process to exit:
298 send a kill signal to it and return immediately."
299 (let ((repl (symbol-value (guix-get-repl-buffer-variable internal
))))
300 (when (get-buffer-process repl
)
301 (with-current-buffer repl
302 (geiser-con--connection-deactivate geiser-repl--connection t
)
305 (while (get-buffer-process repl
)
306 (sleep-for 0.1)))))))
308 (defun guix-get-repl-buffer (&optional internal
)
309 "Return Guix REPL buffer; start REPL if needed.
310 If INTERNAL is non-nil, return an additional internal REPL."
311 (guix-start-process-maybe)
312 (let ((repl (symbol-value (guix-get-repl-buffer-variable internal
))))
313 ;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
314 ;; be set to the new value in a Guix REPL, so set it back to a
315 ;; proper value here.
316 (with-current-buffer repl
317 (geiser-repl--set-this-buffer-repl repl
))
320 (defun guix-get-repl-buffer-variable (&optional internal
)
321 "Return the name of a variable with a REPL buffer."
323 'guix-internal-repl-buffer
326 (defun guix-get-repl-buffer-name (&optional internal
)
327 "Return the name of a REPL buffer."
329 guix-internal-repl-buffer-name
330 guix-repl-buffer-name
))
332 (defun guix-switch-to-repl (&optional internal
)
333 "Switch to Guix REPL.
334 If INTERNAL is non-nil (interactively with prefix), switch to the
335 additional internal REPL if it exists."
337 (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal
)))
342 (defvar guix-directory nil
343 "Default directory with Guix source.
344 If it is not set by a user, it is set after starting Guile REPL.
345 This directory is used to define package locations.")
347 (defun guix-read-directory ()
348 "Return `guix-directory' or prompt for it.
349 This function is intended for using in `interactive' forms."
350 (if current-prefix-arg
351 (read-directory-name "Directory with Guix modules: "
355 (defun guix-set-directory ()
356 "Set `guix-directory' if needed."
359 (guix-eval-read "%guix-dir"))))
362 ;;; Evaluating expressions
364 (defvar guix-operation-buffer nil
365 "Buffer from which the latest Guix operation was performed.")
367 (defun guix-eval (str)
368 "Evaluate STR with guile expression using Guix REPL.
369 See `guix-geiser-eval' for details."
370 (guix-geiser-eval str
(guix-get-repl-buffer 'internal
)))
372 (defun guix-eval-read (str)
373 "Evaluate STR with guile expression using Guix REPL.
374 See `guix-geiser-eval-read' for details."
375 (guix-geiser-eval-read str
(guix-get-repl-buffer 'internal
)))
377 (defun guix-eval-in-repl (str &optional operation-buffer operation-type
)
378 "Switch to Guix REPL and evaluate STR with guile expression there.
379 If OPERATION-BUFFER is non-nil, it should be a buffer from which
380 the current operation was performed.
382 If OPERATION-TYPE is non-nil, it should be a symbol. After
383 successful executing of the current operation,
384 `guix-after-OPERATION-TYPE-hook' is called."
385 (run-hooks 'guix-before-repl-operation-hook
)
386 (setq guix-repl-operation-p t
387 guix-repl-operation-type operation-type
388 guix-operation-buffer operation-buffer
)
389 (guix-geiser-eval-in-repl str
(guix-get-repl-buffer)))
391 (provide 'guix-backend
)
393 ;;; guix-backend.el ends here