[jackhill/guix/guix.git] / emacs / guix-backend.el

;;; guix-backend.el --- Communication with Geiser

;; Copyright © 2014 Alex Kost <alezost@gmail.com>

;; This file is part of GNU Guix.

;; GNU Guix 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.

;; GNU Guix 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:

;; This file provides the code for interacting with Guile using Geiser.

;; By default (if `guix-use-guile-server' is non-nil) 2 Geiser REPLs are
;; started.  The main one (with "guile --listen" process) is used for
;; "interacting" with a user - for showing a progress of
;; installing/deleting Guix packages.  The second (internal) REPL is
;; used for synchronous evaluating, e.g. when information about
;; packages/generations should be received for a list/info buffer.
;;
;; This "2 REPLs concept" makes it possible to have a running process of
;; installing/deleting packages and to continue to search/list/get info
;; about other packages at the same time.  If you prefer to use a single
;; Guix REPL, do not try to receive any information while there is a
;; running code in the REPL (see
;; <https://github.com/jaor/geiser/issues/28>).
;;
;; If you need to use "guix.el" in another Emacs (i.e. when there is
;; a runnig "guile --listen..." REPL somewhere), you can either change
;; `guix-default-port' in that Emacs instance or set
;; `guix-use-guile-server' to t.
;;
;; Guix REPLs (unlike the usual Geiser REPLs) are not added to
;; `geiser-repl--repls' variable, and thus cannot be used for evaluating
;; while editing scm-files.  The only purpose of Guix REPLs is to be an
;; intermediate between "Guix/Guile level" and "Emacs interface level".
;; That being said you can still want to use a Guix REPL while hacking
;; auxiliary scheme-files for "guix.el".  You can just use "M-x
;; connect-to-guile" (connect to "localhost" and `guix-default-port') to
;; have a usual Geiser REPL with all stuff defined by "guix.el" package.

;;; Code:

(require 'geiser-mode)

(defvar guix-load-path
  (file-name-directory (or load-file-name
                           (locate-library "guix")))
  "Directory with scheme files for \"guix.el\" package.")

(defvar guix-helper-file
  (expand-file-name "guix-helper.scm" guix-load-path)
  "Auxiliary scheme file for loading.")

(defvar guix-guile-program (or geiser-guile-binary "guile")
  "Name of the guile executable used for Guix REPL.
May be either a string (the name of the executable) or a list of
strings of the form:

  (NAME . ARGS)

Where ARGS is a list of arguments to the guile program.")

\f
;;; REPL

(defgroup guix-repl nil
  "Settings for Guix REPLs."
  :prefix "guix-repl-"
  :group 'guix)

(defcustom guix-repl-startup-time 30000
  "Time, in milliseconds, to wait for Guix REPL to startup.
Same as `geiser-repl-startup-time' but is used for Guix REPL.
If you have a slow system, try to increase this time."
  :type 'integer
  :group 'guix-repl)

(defcustom guix-repl-buffer-name "*Guix REPL*"
  "Default name of a Geiser REPL buffer used for Guix."
  :type 'string
  :group 'guix-repl)

(defcustom guix-after-start-repl-hook ()
  "Hook called after Guix REPL is started."
  :type 'hook
  :group 'guix-repl)

(defcustom guix-use-guile-server t
  "If non-nil, start guile with '--listen' argument.
This allows to receive information about packages using an additional
REPL while some packages are being installed/removed in the main REPL."
  :type 'boolean
  :group 'guix-repl)

(defcustom guix-default-port 37246
  "Default port used if `guix-use-guile-server' is non-nil."
  :type 'integer
  :group 'guix-repl)

(defvar guix-repl-buffer nil
  "Main Geiser REPL buffer used for communicating with Guix.
This REPL is used for processing package actions and for
receiving information if `guix-use-guile-server' is nil.")

(defvar guix-internal-repl-buffer nil
  "Additional Geiser REPL buffer used for communicating with Guix.
This REPL is used for receiving information only if
`guix-use-guile-server' is non-nil.")

(defvar guix-internal-repl-buffer-name "*Guix Internal REPL*"
  "Default name of an internal Guix REPL buffer.")

(defun guix-get-guile-program (&optional internal)
  "Return a value suitable for `geiser-guile-binary'."
  (if (or internal
          (not guix-use-guile-server))
      guix-guile-program
    (append (if (listp guix-guile-program)
                guix-guile-program
              (list guix-guile-program))
            ;; Guile understands "--listen=..." but not "--listen ..."
            (list (concat "--listen="
                          (number-to-string guix-default-port))))))

(defun guix-start-process-maybe ()
  "Start Geiser REPL configured for Guix if needed."
  (guix-start-repl-maybe)
  (if guix-use-guile-server
      (guix-start-repl-maybe 'internal)
    (setq guix-internal-repl-buffer guix-repl-buffer)))

(defun guix-start-repl-maybe (&optional internal)
  "Start Guix REPL if needed.
If INTERNAL is non-nil, start an internal REPL."
  (let* ((repl-var (guix-get-repl-buffer-variable internal))
         (repl (symbol-value repl-var)))
    (unless (and (buffer-live-p repl)
                 (get-buffer-process repl))
      ;; Kill REPL buffer with a dead process
      (and (buffer-live-p repl) (kill-buffer repl))
      (or internal
          (message "Starting Geiser REPL for Guix ..."))
      (let ((geiser-guile-binary (guix-get-guile-program internal))
            (geiser-guile-init-file (or internal guix-helper-file))
            (repl (get-buffer-create
                   (guix-get-repl-buffer-name internal))))
        (condition-case err
            (guix-start-repl repl
                             (and internal
                                  (geiser-repl--read-address
                                   "localhost" guix-default-port)))
          (text-read-only
           (error (concat "Couldn't start Guix REPL.  Perhaps the port %s is busy.\n"
                          "See buffer '%s' for details")
                  guix-default-port (buffer-name repl))))
        (set repl-var repl)
        (unless internal
          (message "Guix REPL has been started.")
          (run-hooks 'guix-after-start-repl-hook))))))

(defun guix-start-repl (buffer &optional address)
  "Start Guix REPL in BUFFER.
If ADDRESS is non-nil, connect to a remote guile process using
this address (it should be defined by
`geiser-repl--read-address')."
  ;; A mix of the code from `geiser-repl--start-repl' and
  ;; `geiser-repl--to-repl-buffer'.
  (let ((impl 'guile)
        (geiser-guile-load-path (list guix-load-path))
        (geiser-repl-startup-time guix-repl-startup-time))
    (with-current-buffer buffer
      (geiser-repl-mode)
      (geiser-impl--set-buffer-implementation impl)
      (geiser-repl--autodoc-mode -1)
      (goto-char (point-max))
      (let* ((prompt-re (geiser-repl--prompt-regexp impl))
             (deb-prompt-re (geiser-repl--debugger-prompt-regexp impl))
             (prompt (geiser-con--combined-prompt prompt-re deb-prompt-re)))
        (or prompt-re
            (error "Oh no! Guix REPL in the buffer '%s' has not been started"
                   (buffer-name buffer)))
        (geiser-repl--save-remote-data address)
        (geiser-repl--start-scheme impl address prompt)
        (geiser-repl--quit-setup)
        (geiser-repl--history-setup)
        (setq-local geiser-repl--repls (list buffer))
        (geiser-repl--set-this-buffer-repl buffer)
        (setq geiser-repl--connection
              (geiser-con--make-connection
               (get-buffer-process (current-buffer))
               prompt-re
               deb-prompt-re))
        (geiser-repl--startup impl address)
        (geiser-repl--autodoc-mode 1)
        (geiser-company--setup geiser-repl-company-p)
        (add-hook 'comint-output-filter-functions
                  'geiser-repl--output-filter
                  nil t)
        (set-process-query-on-exit-flag
         (get-buffer-process (current-buffer))
         geiser-repl-query-on-kill-p)))))

(defun guix-get-repl-buffer (&optional internal)
  "Return Guix REPL buffer; start REPL if needed.
If INTERNAL is non-nil, return an additional internal REPL."
  (guix-start-process-maybe)
  (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
    ;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
    ;; be set to the new value in a Guix REPL, so set it back to a
    ;; proper value here.
    (with-current-buffer repl
      (geiser-repl--set-this-buffer-repl repl))
    repl))

(defun guix-get-repl-buffer-variable (&optional internal)
  "Return the name of a variable with a REPL buffer."
  (if internal
      'guix-internal-repl-buffer
    'guix-repl-buffer))

(defun guix-get-repl-buffer-name (&optional internal)
  "Return the name of a REPL buffer."
  (if internal
      guix-internal-repl-buffer-name
    guix-repl-buffer-name))

(defun guix-switch-to-repl (&optional internal)
  "Switch to Guix REPL.
If INTERNAL is non-nil (interactively with prefix), switch to the
additional internal REPL if it exists."
  (interactive "P")
  (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal)))

\f
;;; Evaluating expressions

(defun guix-make-guile-expression (fun &rest args)
  "Return string containing a guile expression for calling FUN with ARGS."
  (format "(%S %s)" fun
          (mapconcat
           (lambda (arg)
             (cond
              ((null arg) "'()")
              ((or (eq arg t)
                   ;; An ugly hack to separate 'false' from nil
                   (equal arg 'f)
                   (keywordp arg))
               (concat "#" (prin1-to-string arg t)))
              ((or (symbolp arg) (listp arg))
               (concat "'" (prin1-to-string arg)))
              (t (prin1-to-string arg))))
           args
           " ")))

(defun guix-eval (str &optional wrap)
  "Evaluate guile expression STR.
If WRAP is non-nil, wrap STR into (begin ...) form.
Return a list of strings with result values of evaluation."
  (with-current-buffer (guix-get-repl-buffer 'internal)
    (let* ((wrapped (if wrap (geiser-debug--wrap-region str) str))
           (code `(:eval (:scm ,wrapped)))
           (ret (geiser-eval--send/wait code)))
      (if (geiser-eval--retort-error ret)
          (error "Error in evaluating guile expression: %s"
                 (geiser-eval--retort-output ret))
        (cdr (assq 'result ret))))))

(defun guix-eval-read (str &optional wrap)
  "Evaluate guile expression STR.
For the meaning of WRAP, see `guix-eval'.
Return elisp expression of the first result value of evaluation."
  ;; Parsing scheme code with elisp `read' is probably not the best idea.
  (read (replace-regexp-in-string
         "#f\\|#<unspecified>" "nil"
         (replace-regexp-in-string
          "#t" "t" (car (guix-eval str wrap))))))

(defun guix-eval-in-repl (str)
  "Switch to Guix REPL and evaluate STR with guile expression there."
  (let ((repl (guix-get-repl-buffer)))
    (with-current-buffer repl
      (delete-region (geiser-repl--last-prompt-end) (point-max))
      (goto-char (point-max))
      (insert str)
      (geiser-repl--send-input))
    (geiser-repl--switch-to-buffer repl)))

(provide 'guix-backend)

;;; guix-backend.el ends here
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
124	(defun guix-get-guile-program (&optional internal)
125	"Return a value suitable for `geiser-guile-binary'."
126	(if (or internal
127	(not guix-use-guile-server))
128	guix-guile-program
129	(append (if (listp guix-guile-program)
130	guix-guile-program
131	(list guix-guile-program))
132	;; Guile understands "--listen=..." but not "--listen ..."
133	(list (concat "--listen="
134	(number-to-string guix-default-port))))))
135
136	(defun guix-start-process-maybe ()
137	"Start Geiser REPL configured for Guix if needed."
138	(guix-start-repl-maybe)
139	(if guix-use-guile-server
140	(guix-start-repl-maybe 'internal)
141	(setq guix-internal-repl-buffer guix-repl-buffer)))
142
143	(defun guix-start-repl-maybe (&optional internal)
144	"Start Guix REPL if needed.
145	If INTERNAL is non-nil, start an internal REPL."
146	(let* ((repl-var (guix-get-repl-buffer-variable internal))
147	(repl (symbol-value repl-var)))
148	(unless (and (buffer-live-p repl)
149	(get-buffer-process repl))
150	;; Kill REPL buffer with a dead process
151	(and (buffer-live-p repl) (kill-buffer repl))
152	(or internal
153	(message "Starting Geiser REPL for Guix ..."))
154	(let ((geiser-guile-binary (guix-get-guile-program internal))
155	(geiser-guile-init-file (or internal guix-helper-file))
156	(repl (get-buffer-create
157	(guix-get-repl-buffer-name internal))))
158	(condition-case err
159	(guix-start-repl repl
160	(and internal
161	(geiser-repl--read-address
162	"localhost" guix-default-port)))
163	(text-read-only
164	(error (concat "Couldn't start Guix REPL. Perhaps the port %s is busy.\n"
165	"See buffer '%s' for details")
166	guix-default-port (buffer-name repl))))
167	(set repl-var repl)
168	(unless internal
169	(message "Guix REPL has been started.")
170	(run-hooks 'guix-after-start-repl-hook))))))
171
172	(defun guix-start-repl (buffer &optional address)
173	"Start Guix REPL in BUFFER.
174	If ADDRESS is non-nil, connect to a remote guile process using
175	this address (it should be defined by
176	`geiser-repl--read-address')."
177	;; A mix of the code from `geiser-repl--start-repl' and
178	;; `geiser-repl--to-repl-buffer'.
179	(let ((impl 'guile)
180	(geiser-guile-load-path (list guix-load-path))
181	(geiser-repl-startup-time guix-repl-startup-time))
182	(with-current-buffer buffer
183	(geiser-repl-mode)
184	(geiser-impl--set-buffer-implementation impl)
185	(geiser-repl--autodoc-mode -1)
186	(goto-char (point-max))
187	(let* ((prompt-re (geiser-repl--prompt-regexp impl))
188	(deb-prompt-re (geiser-repl--debugger-prompt-regexp impl))
189	(prompt (geiser-con--combined-prompt prompt-re deb-prompt-re)))
190	(or prompt-re
191	(error "Oh no! Guix REPL in the buffer '%s' has not been started"
192	(buffer-name buffer)))
193	(geiser-repl--save-remote-data address)
194	(geiser-repl--start-scheme impl address prompt)
195	(geiser-repl--quit-setup)
196	(geiser-repl--history-setup)
197	(setq-local geiser-repl--repls (list buffer))
198	(geiser-repl--set-this-buffer-repl buffer)
199	(setq geiser-repl--connection
200	(geiser-con--make-connection
201	(get-buffer-process (current-buffer))
202	prompt-re
203	deb-prompt-re))
204	(geiser-repl--startup impl address)
205	(geiser-repl--autodoc-mode 1)
206	(geiser-company--setup geiser-repl-company-p)
207	(add-hook 'comint-output-filter-functions
208	'geiser-repl--output-filter
209	nil t)
210	(set-process-query-on-exit-flag
211	(get-buffer-process (current-buffer))
212	geiser-repl-query-on-kill-p)))))
213
214	(defun guix-get-repl-buffer (&optional internal)
215	"Return Guix REPL buffer; start REPL if needed.
216	If INTERNAL is non-nil, return an additional internal REPL."
217	(guix-start-process-maybe)
218	(let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
219	;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
220	;; be set to the new value in a Guix REPL, so set it back to a
221	;; proper value here.
222	(with-current-buffer repl
223	(geiser-repl--set-this-buffer-repl repl))
224	repl))
225
226	(defun guix-get-repl-buffer-variable (&optional internal)
227	"Return the name of a variable with a REPL buffer."
228	(if internal
229	'guix-internal-repl-buffer
230	'guix-repl-buffer))
231
232	(defun guix-get-repl-buffer-name (&optional internal)
233	"Return the name of a REPL buffer."
234	(if internal
235	guix-internal-repl-buffer-name
236	guix-repl-buffer-name))
237
238	(defun guix-switch-to-repl (&optional internal)
239	"Switch to Guix REPL.
240	If INTERNAL is non-nil (interactively with prefix), switch to the
241	additional internal REPL if it exists."
242	(interactive "P")
243	(geiser-repl--switch-to-buffer (guix-get-repl-buffer internal)))
244
245	\f
246	;;; Evaluating expressions
247
248	(defun guix-make-guile-expression (fun &rest args)
249	"Return string containing a guile expression for calling FUN with ARGS."
250	(format "(%S %s)" fun
251	(mapconcat
252	(lambda (arg)
253	(cond
254	((null arg) "'()")
255	((or (eq arg t)
256	;; An ugly hack to separate 'false' from nil
257	(equal arg 'f)
258	(keywordp arg))
259	(concat "#" (prin1-to-string arg t)))
260	((or (symbolp arg) (listp arg))
261	(concat "'" (prin1-to-string arg)))
262	(t (prin1-to-string arg))))
263	args
264	" ")))
265
266	(defun guix-eval (str &optional wrap)
267	"Evaluate guile expression STR.
268	If WRAP is non-nil, wrap STR into (begin ...) form.
269	Return a list of strings with result values of evaluation."
270	(with-current-buffer (guix-get-repl-buffer 'internal)
271	(let* ((wrapped (if wrap (geiser-debug--wrap-region str) str))
272	(code `(:eval (:scm ,wrapped)))
273	(ret (geiser-eval--send/wait code)))
274	(if (geiser-eval--retort-error ret)
275	(error "Error in evaluating guile expression: %s"
276	(geiser-eval--retort-output ret))
277	(cdr (assq 'result ret))))))
278
279	(defun guix-eval-read (str &optional wrap)
280	"Evaluate guile expression STR.
281	For the meaning of WRAP, see `guix-eval'.
282	Return elisp expression of the first result value of evaluation."
283	;; Parsing scheme code with elisp `read' is probably not the best idea.
284	(read (replace-regexp-in-string
285	"#f\\\|#<unspecified>" "nil"
286	(replace-regexp-in-string
287	"#t" "t" (car (guix-eval str wrap))))))
288
289	(defun guix-eval-in-repl (str)
290	"Switch to Guix REPL and evaluate STR with guile expression there."
291	(let ((repl (guix-get-repl-buffer)))
292	(with-current-buffer repl
293	(delete-region (geiser-repl--last-prompt-end) (point-max))
294	(goto-char (point-max))
295	(insert str)
296	(geiser-repl--send-input))
297	(geiser-repl--switch-to-buffer repl)))
298
299	(provide 'guix-backend)
300
301	;;; guix-backend.el ends here