emacs/guix-backend.el

   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