1 files changed, 301 insertions, 0 deletions
diff --git a/emacs/guix-backend.el b/emacs/guix-backend.el
new file mode 100644
index 0000000000..46d0f06778
--- /dev/null
+++ b/emacs/guix-backend.el
@@ -0,0 +1,301 @@
+;;; 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.")
+
+
+;;; 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)))
+
+
+;;; 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