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 (require 'guix-emacs)
  56
  57 (defvar guix-load-path
  58   (file-name-directory (or load-file-name
  59                            (locate-library "guix")))
  60   "Directory with scheme files for \"guix.el\" package.")
  61
  62 (defvar guix-helper-file
  63   (expand-file-name "guix-helper.scm" guix-load-path)
  64   "Auxiliary scheme file for loading.")
  65
  66 (defvar guix-guile-program (or geiser-guile-binary "guile")
  67   "Name of the guile executable used for Guix REPL.
  68 May be either a string (the name of the executable) or a list of
  69 strings of the form:
  70
  71   (NAME . ARGS)
  72
  73 Where ARGS is a list of arguments to the guile program.")
  74
  75 \f
  76 ;;; REPL
  77
  78 (defgroup guix-repl nil
  79   "Settings for Guix REPLs."
  80   :prefix "guix-repl-"
  81   :group 'guix)
  82
  83 (defcustom guix-repl-startup-time 30000
  84   "Time, in milliseconds, to wait for Guix REPL to startup.
  85 Same as `geiser-repl-startup-time' but is used for Guix REPL.
  86 If you have a slow system, try to increase this time."
  87   :type 'integer
  88   :group 'guix-repl)
  89
  90 (defcustom guix-repl-buffer-name "*Guix REPL*"
  91   "Default name of a Geiser REPL buffer used for Guix."
  92   :type 'string
  93   :group 'guix-repl)
  94
  95 (defcustom guix-after-start-repl-hook ()
  96   "Hook called after Guix REPL is started."
  97   :type 'hook
  98   :group 'guix-repl)
  99
 100 (defcustom guix-use-guile-server t
 101   "If non-nil, start guile with '--listen' argument.
 102 This allows to receive information about packages using an additional
 103 REPL while some packages are being installed/removed in the main REPL."
 104   :type 'boolean
 105   :group 'guix-repl)
 106
 107 (defcustom guix-default-port 37246
 108   "Default port used if `guix-use-guile-server' is non-nil."
 109   :type 'integer
 110   :group 'guix-repl)
 111
 112 (defvar guix-repl-buffer nil
 113   "Main Geiser REPL buffer used for communicating with Guix.
 114 This REPL is used for processing package actions and for
 115 receiving information if `guix-use-guile-server' is nil.")
 116
 117 (defvar guix-internal-repl-buffer nil
 118   "Additional Geiser REPL buffer used for communicating with Guix.
 119 This REPL is used for receiving information only if
 120 `guix-use-guile-server' is non-nil.")
 121
 122 (defvar guix-internal-repl-buffer-name "*Guix Internal REPL*"
 123   "Default name of an internal Guix REPL buffer.")
 124
 125 (defvar guix-before-repl-operation-hook nil
 126   "Hook run before executing an operation in Guix REPL.")
 127
 128 (defvar guix-after-repl-operation-hook
 129   '(guix-emacs-load-autoloads-maybe
 130     guix-repl-operation-success-message)
 131   "Hook run after executing successful operation in Guix REPL.")
 132
 133 (defvar guix-repl-operation-p nil
 134   "Non-nil, if current operation is performed by `guix-eval-in-repl'.
 135 This internal variable is used to distinguish Guix operations
 136 from operations performed in Guix REPL by a user.")
 137
 138 (defvar guix-repl-operation-type nil
 139   "Type of the current operation performed by `guix-eval-in-repl'.
 140 This internal variable is used to define what actions should be
 141 executed after the current operation succeeds.
 142 See `guix-eval-in-repl' for details.")
 143
 144 (defun guix-repl-operation-success-message ()
 145   "Message telling about successful Guix operation."
 146   (message "Guix operation has been performed."))
 147
 148 (defun guix-get-guile-program (&optional internal)
 149   "Return a value suitable for `geiser-guile-binary'."
 150   (if (or internal
 151           (not guix-use-guile-server))
 152       guix-guile-program
 153     (append (if (listp guix-guile-program)
 154                 guix-guile-program
 155               (list guix-guile-program))
 156             ;; Guile understands "--listen=..." but not "--listen ..."
 157             (list (concat "--listen="
 158                           (number-to-string guix-default-port))))))
 159
 160 (defun guix-start-process-maybe (&optional start-msg end-msg)
 161   "Start Geiser REPL configured for Guix if needed.
 162 START-MSG and END-MSG are strings displayed in the minibuffer in
 163 the beginning and in the end of the starting process.  If nil,
 164 display default messages."
 165   (guix-start-repl-maybe nil
 166                          (or start-msg "Starting Guix REPL ...")
 167                          (or end-msg "Guix REPL has been started."))
 168   (if guix-use-guile-server
 169       (guix-start-repl-maybe 'internal)
 170     (setq guix-internal-repl-buffer guix-repl-buffer)))
 171
 172 (defun guix-start-repl-maybe (&optional internal start-msg end-msg)
 173   "Start Guix REPL if needed.
 174 If INTERNAL is non-nil, start an internal REPL.
 175
 176 START-MSG and END-MSG are strings displayed in the minibuffer in
 177 the beginning and in the end of the process.  If nil, do not
 178 display messages."
 179   (let* ((repl-var (guix-get-repl-buffer-variable internal))
 180          (repl (symbol-value repl-var)))
 181     (unless (and (buffer-live-p repl)
 182                  (get-buffer-process repl))
 183       (and start-msg (message start-msg))
 184       (setq guix-repl-operation-p nil)
 185       (let ((geiser-guile-binary (guix-get-guile-program internal))
 186             (geiser-guile-init-file (or internal guix-helper-file))
 187             (repl (get-buffer-create
 188                    (guix-get-repl-buffer-name internal))))
 189         (condition-case err
 190             (guix-start-repl repl
 191                              (and internal
 192                                   (geiser-repl--read-address
 193                                    "localhost" guix-default-port)))
 194           (text-read-only
 195            (error (concat "Couldn't start Guix REPL.  Perhaps the port %s is busy.\n"
 196                           "See buffer '%s' for details")
 197                   guix-default-port (buffer-name repl))))
 198         (set repl-var repl)
 199         (and end-msg (message end-msg))
 200         (unless internal
 201           (run-hooks 'guix-after-start-repl-hook))))))
 202
 203 (defun guix-start-repl (buffer &optional address)
 204   "Start Guix REPL in BUFFER.
 205 If ADDRESS is non-nil, connect to a remote guile process using
 206 this address (it should be defined by
 207 `geiser-repl--read-address')."
 208   ;; A mix of the code from `geiser-repl--start-repl' and
 209   ;; `geiser-repl--to-repl-buffer'.
 210   (let ((impl 'guile)
 211         (geiser-guile-load-path (cons guix-load-path
 212                                       geiser-guile-load-path))
 213         (geiser-repl-startup-time guix-repl-startup-time))
 214     (with-current-buffer buffer
 215       (geiser-repl-mode)
 216       (geiser-impl--set-buffer-implementation impl)
 217       (geiser-repl--autodoc-mode -1)
 218       (goto-char (point-max))
 219       (let ((prompt (geiser-con--combined-prompt
 220                      geiser-guile--prompt-regexp
 221                      geiser-guile--debugger-prompt-regexp)))
 222         (geiser-repl--save-remote-data address)
 223         (geiser-repl--start-scheme impl address prompt)
 224         (geiser-repl--quit-setup)
 225         (geiser-repl--history-setup)
 226         (setq-local geiser-repl--repls (list buffer))
 227         (geiser-repl--set-this-buffer-repl buffer)
 228         (setq geiser-repl--connection
 229               (geiser-con--make-connection
 230                (get-buffer-process (current-buffer))
 231                geiser-guile--prompt-regexp
 232                geiser-guile--debugger-prompt-regexp))
 233         (geiser-repl--startup impl address)
 234         (geiser-repl--autodoc-mode 1)
 235         (geiser-company--setup geiser-repl-company-p)
 236         (add-hook 'comint-output-filter-functions
 237                   'guix-repl-output-filter
 238                   nil t)
 239         (set-process-query-on-exit-flag
 240          (get-buffer-process (current-buffer))
 241          geiser-repl-query-on-kill-p)))))
 242
 243 (defun guix-repl-output-filter (str)
 244   "Filter function suitable for `comint-output-filter-functions'.
 245 This is a replacement for `geiser-repl--output-filter'."
 246   (cond
 247    ((string-match-p geiser-guile--prompt-regexp str)
 248     (geiser-autodoc--disinhibit-autodoc)
 249     (when guix-repl-operation-p
 250       (setq guix-repl-operation-p nil)
 251       (run-hooks 'guix-after-repl-operation-hook)
 252       ;; Run hooks specific to the current operation type.
 253       (when guix-repl-operation-type
 254         (let ((type-hook (intern
 255                           (concat "guix-after-"
 256                                   (symbol-name guix-repl-operation-type)
 257                                   "-hook"))))
 258           (setq guix-repl-operation-type nil)
 259           (and (boundp type-hook)
 260                (run-hooks type-hook))))))
 261    ((string-match geiser-guile--debugger-prompt-regexp str)
 262     (setq guix-repl-operation-p nil)
 263     (geiser-con--connection-set-debugging geiser-repl--connection
 264                                           (match-beginning 0))
 265     (geiser-autodoc--disinhibit-autodoc))))
 266
 267 (defun guix-repl-exit (&optional internal no-wait)
 268   "Exit the current Guix REPL.
 269 If INTERNAL is non-nil, exit the internal REPL.
 270 If NO-WAIT is non-nil, do not wait for the REPL process to exit:
 271 send a kill signal to it and return immediately."
 272   (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
 273     (when (get-buffer-process repl)
 274       (with-current-buffer repl
 275         (geiser-con--connection-deactivate geiser-repl--connection t)
 276         (comint-kill-subjob)
 277         (unless no-wait
 278           (while (get-buffer-process repl)
 279             (sleep-for 0.1)))))))
 280
 281 (defun guix-get-repl-buffer (&optional internal)
 282   "Return Guix REPL buffer; start REPL if needed.
 283 If INTERNAL is non-nil, return an additional internal REPL."
 284   (guix-start-process-maybe)
 285   (let ((repl (symbol-value (guix-get-repl-buffer-variable internal))))
 286     ;; If a new Geiser REPL is started, `geiser-repl--repl' variable may
 287     ;; be set to the new value in a Guix REPL, so set it back to a
 288     ;; proper value here.
 289     (with-current-buffer repl
 290       (geiser-repl--set-this-buffer-repl repl))
 291     repl))
 292
 293 (defun guix-get-repl-buffer-variable (&optional internal)
 294   "Return the name of a variable with a REPL buffer."
 295   (if internal
 296       'guix-internal-repl-buffer
 297     'guix-repl-buffer))
 298
 299 (defun guix-get-repl-buffer-name (&optional internal)
 300   "Return the name of a REPL buffer."
 301   (if internal
 302       guix-internal-repl-buffer-name
 303     guix-repl-buffer-name))
 304
 305 (defun guix-switch-to-repl (&optional internal)
 306   "Switch to Guix REPL.
 307 If INTERNAL is non-nil (interactively with prefix), switch to the
 308 additional internal REPL if it exists."
 309   (interactive "P")
 310   (geiser-repl--switch-to-buffer (guix-get-repl-buffer internal)))
 311
 312 \f
 313 ;;; Evaluating expressions
 314
 315 (defvar guix-operation-buffer nil
 316   "Buffer from which the latest Guix operation was performed.")
 317
 318 (defun guix-make-guile-expression (fun &rest args)
 319   "Return string containing a guile expression for calling FUN with ARGS."
 320   (format "(%S %s)" fun
 321           (mapconcat
 322            (lambda (arg)
 323              (cond
 324               ((null arg) "'()")
 325               ((or (eq arg t)
 326                    ;; An ugly hack to separate 'false' from nil
 327                    (equal arg 'f)
 328                    (keywordp arg))
 329                (concat "#" (prin1-to-string arg t)))
 330               ((or (symbolp arg) (listp arg))
 331                (concat "'" (prin1-to-string arg)))
 332               (t (prin1-to-string arg))))
 333            args
 334            " ")))
 335
 336 (defun guix-eval (str &optional wrap)
 337   "Evaluate guile expression STR.
 338 If WRAP is non-nil, wrap STR into (begin ...) form.
 339 Return a list of strings with result values of evaluation."
 340   (with-current-buffer (guix-get-repl-buffer 'internal)
 341     (let* ((wrapped (if wrap (geiser-debug--wrap-region str) str))
 342            (code `(:eval (:scm ,wrapped)))
 343            (ret (geiser-eval--send/wait code)))
 344       (if (geiser-eval--retort-error ret)
 345           (error "Error in evaluating guile expression: %s"
 346                  (geiser-eval--retort-output ret))
 347         (cdr (assq 'result ret))))))
 348
 349 (defun guix-eval-read (str &optional wrap)
 350   "Evaluate guile expression STR.
 351 For the meaning of WRAP, see `guix-eval'.
 352 Return elisp expression of the first result value of evaluation."
 353   ;; Parsing scheme code with elisp `read' is probably not the best idea.
 354   (read (replace-regexp-in-string
 355          "#f\\|#<unspecified>" "nil"
 356          (replace-regexp-in-string
 357           "#t" "t" (car (guix-eval str wrap))))))
 358
 359 (defun guix-eval-in-repl (str &optional operation-buffer operation-type)
 360   "Switch to Guix REPL and evaluate STR with guile expression there.
 361 If OPERATION-BUFFER is non-nil, it should be a buffer from which
 362 the current operation was performed.
 363
 364 If OPERATION-TYPE is non-nil, it should be a symbol.  After
 365 successful executing of the current operation,
 366 `guix-after-OPERATION-TYPE-hook' is called."
 367   (run-hooks 'guix-before-repl-operation-hook)
 368   (setq guix-repl-operation-p t
 369         guix-repl-operation-type operation-type
 370         guix-operation-buffer operation-buffer)
 371   (let ((repl (guix-get-repl-buffer)))
 372     (with-current-buffer repl
 373       (geiser-repl--send str))
 374     (geiser-repl--switch-to-buffer repl)))
 375
 376 (provide 'guix-backend)
 377
 378 ;;; guix-backend.el ends here